MonadPrimer

#!/usr/bin/env runhaskell
module Main where
import Control.Applicative
import Control.Monad
 
-- A crib of common monads, their behavior, and how helper functions
-- behave when operating on them.
-- Includes functions from Monad, Applicative and Functor.
main = do
    -- Maybe a
    -- optional a value.
    putStrLn "----- Maybe a -----"
    print (return 3 :: Maybe Int)                 -- Just 3
    print (pure 3 :: Maybe Int)                   -- Just 3
    print (Just 3 >>= \n -> Just (n+1))           -- Just 4
    print (Just 3 >>= return.(+1))                -- Just 4
    print (Nothing >>= return.(+1))               -- Nothing
    print (return.(+1) =<< Just 3)                -- Just 4
    print (join (Just (Just 3)))                  -- Just 3
    print (join (Just Nothing) :: Maybe Int)      -- Nothing
    print (liftM (+1) (Just 3))                   -- Just 4
    print (liftA (+1) (Just 3))                   -- Just 4
    print ((+1) `fmap` Just 3)                    -- Just 4
    print ((+1) `fmap` Nothing)                   -- Nothing
    print (return (+ 1) `ap` Just 3)              -- Just 4
    print (Just (+ 1) `ap` Just 3)                -- Just 4
    print (Nothing `ap` Just 3 :: Maybe Int)      -- Nothing
    print ((+ 1) <$> Just 3)                      -- Just 4
    print ((+ 1) <$> Nothing :: Maybe Int)        -- Nothing
    print (liftM2 (+) (Just 3) (Just 4))          -- Just 7
    print (liftA2 (+) (Just 3) (Just 4))          -- Just 7
    print (return (+) `ap` Just 3 `ap` Just 4)    -- Just 7
    print ((+) `fmap` Just 3 `ap` Just 4)         -- Just 7
    print ((+) <$> Just 3 <*> Just 4)             -- Just 7
    print ((+) <$> Nothing <*> Just 4)            -- Nothing
    print ((+) <$> Just 3 <*> Nothing)            -- Nothing
    print (guard True >> Just 3)                  -- Just 3
    print (guard False >> Just 3)                 -- Nothing
    print (mapM (\n -> guard (n<10) >> Just (n+2)) [2..4])  -- Just [4,5,6]
    print (mapM (\n -> guard (n<10) >> Just (n+2)) [8..14]) -- Nothing
    print (forM [2..4] (\n -> guard (n<10) >> Just (n+2)) ) -- Just [4,5,6]
    print (foldM (\n m -> guard (n<10) >> Just (n+m)) 1 [2..4]) -- Just 10
    print (foldM (\n m -> guard (n<10) >> Just (n+m)) 5 [2..4]) -- Nothing
    print (sequence [Just 5, Just 6, Just 7])     -- Just [5,6,7]
    print (sequence [Just 5, Nothing, Just 7])    -- Nothing
 
    -- [a]
    -- lists of a.
    putStrLn "----- [a] -----"
    print (return 3 :: [Int])                     -- [3]
    print (pure 3 :: [Int])                       -- [3]
    print ([3] >>= \n -> [n+1])                   -- [4]
    print ([3] >>= return.(+1))                   -- [4]
    print ([] >>= return.(+1))                    -- []
    print ([3] >>= \n -> [n+1,n+10])              -- [4,13]
    print ([3,5] >>= \n -> [n+1,n+10])            -- [4,13,6,15]
    print (return.(+1) =<< [3])                   -- [4]
    print (join [[3]])                            -- [3]
    print (join [[3],[4,5],[6,7,8]])              -- [3,4,5,6,7,8]
    print (join [[]] :: [Int])                    -- []
    print (join [] :: [Int])                      -- []
    print (liftM (+1) [3])                        -- [4]
    print (liftA (+1) [3])                        -- [4]
    print ((+1) `fmap` [3])                       -- [4]
    print ((+1) `fmap` [])                        -- []
    print ((+1) `fmap` [3,30,300])                -- [4,31,301]
    print (return (+1) `ap` [3])                  -- [4]
    print ([(+1)] `ap` [3])                       -- [4]
    print ([] `ap` [3] :: [Int])                  -- []
    print ([(+1),(+10)] `ap` [3])                 -- [4,13]
    print ((+ 1) <$> [3])                         -- [4]
    print ((+ 1) <$> [3,10,20])                   -- [4,11,21]
    print ((+ 1) <$> [] :: [Int])                 -- []
    print (liftM2 (+) [3] [4])                    -- [7]
    print (liftA2 (+) [3] [4])                    -- [7]
    print (return (+) `ap` [3] `ap` [4])          -- [7]
    print ((+) `fmap` [3] `ap` [4])               -- [7]
    print ((+) <$> [3] <*> [4])                   -- [7]
    print ((+) <$> [3,10] <*> [4,20])             -- [7,23,14,30]
    print ((+) <$> [] <*> [4,20])                 -- []
    print ((+) <$> [3,10] <*> [])                 -- []
    print (guard True >> [1,2,3])                 -- [1,2,3]
    print (guard False >> [1,2,3])                -- []
    print (mapM (\n -> [n+1,n+2]) [10,20])        -- [[11,21],[11,22],[12,21],[12,22]]
    print (forM [10,20] (\n -> [n+1,n+2]))        -- [[11,21],[11,22],[12,21],[12,22]]
    print (foldM (\n m -> [n+m,m+1]) 5 [10])      -- [15,11]
    print (foldM (\n m -> [n+m,m+1]) 5 [10,100])  -- [115,101,111,101]
    print (sequence [[5], [6,7,8], [9]])          -- [[5,6,9],[5,7,9],[5,8,9]]
    print (sequence [[5], [], [9]])               -- []
    -- XXX foldM
 
    -- XXX Error/(Either String) a?
 
    -- ((->) a)
    -- functions which take an argument of type a.
    putStrLn "----- ((->) a) -----"
    let testEnv f = print (f 100)
    testEnv (const 3)                         -- 3
    testEnv (return 3)                        -- const 3 -> 3
    testEnv (pure 3)                          -- const 3 -> 3
    testEnv (const 3 >>= \n -> (+n))          -- (+3) -> 103
    testEnv (*2)                              -- 200
    testEnv ((*2) >>= \n -> (+n))             -- (\n -> n*2 + n) -> 300
    testEnv ((\n -> (+n)) =<< const 3)        -- (+3) -> 103
    -- join :: (a->a-> ...) -> (a -> ...)
    testEnv (join (+))                        -- (\n -> n+n) -> 200
    testEnv (join (*))                        -- (\n -> n*n) -> 10000
    testEnv (join (const (const 3)))          -- const 3 -> 3
    testEnv (liftM (+1) (const 3))            -- (+1).(const3) -> 4
    testEnv (liftA (+1) (const 3))            -- (+1).(const3) -> 4
    testEnv ((+1) `fmap` const 3)             -- (+1).(const 3) -> 4
    testEnv ((+1) `fmap` (*2))                -- (+1).(*2) -> 201
    testEnv (return (+1) `ap` const 3)        -- (+1).(const3) -> 4
    testEnv ((+1) <$> const 3)                -- (+1).(const3) -> 4
    testEnv (liftM2 (+) (*2) (*3))            -- (\n -> n*2 + n*3) -> 500
    testEnv (liftA2 (+) (*2) (*3))            -- (\n -> n*2 + n*3) -> 500
    testEnv (return (+) `ap` (*2) `ap` (*3))  -- (\n -> n*2 + n*3) -> 500
    testEnv ((+) `fmap` (*2) `ap` (*3))       -- (\n -> n*2 + n*3) -> 500
    testEnv ((+) <$> (*2) <*> (*3))           -- (\n -> n*2 + n*3) -> 500
    -- no guard
    testEnv (sequence [(*2),(+1),(`div`2)])   -- (\n -> [n*2, n+1, n `div` 2] -> [200,101,50]
    testEnv (mapM (\n -> (+n)) [3,4,5])       -- (\n -> [n+3, n+4, n+5) -> [103,104,105]
    testEnv (forM [3,4,5] (\n -> (+n)))       -- (\n -> [n+3, n+4, n+5) -> [103,104,105]
    -- XXX foldM
 
    -- XXX (State s) a
    -- Stateful computations.
 
    -- IO a
    -- IO operations with results of type a.
    putStrLn "----- IO a -----"
    -- Two example IO actions returning integers.
    -- Assumes /tmp/val1 contains "5" and /tmp/val2 contains "10"
    let ex1 :: IO Int
        ex1 = liftM read (readFile "/tmp/val1")
        ex2 :: Int -> IO Int
        ex2 n = liftM ((+n).read) (readFile "/tmp/val2")
        testIO :: Show a => IO a -> IO ()
        testIO = (>>= print)
    testIO (return 3)                          -- 3
    testIO (pure 3)                            -- 3
    testIO (ex1)                               -- 5
    testIO (ex1 >>= ex2)                       -- 15
    testIO (ex2 =<< ex1)                       -- 15
    -- somewhat contrived
    --  join :: IO (IO a) -> IO a
    testIO (join (return ex1))                 -- 5
    testIO (liftM (+1) ex1)                    -- 6
    testIO (liftA (+1) ex1)                    -- 6
    testIO ((+1) `fmap` ex1)                   -- 6
    testIO ((+1) `fmap` ex2 1)                 -- 12
    testIO (return (+1) `ap` ex1)              -- 6
    testIO ((+1) <$> ex1)                      -- 6
    testIO (liftM2 (+) ex1 (ex2 1))            -- 16
    testIO (liftA2 (+) ex1 (ex2 1))            -- 16
    testIO (return (+) `ap` ex1 `ap` ex2 1)    -- 16
    testIO ((+) `fmap` ex1 `ap` ex2 1)         -- 16
    testIO ((+) <$> ex1 <*> ex2 1)             -- 16
    -- no guard
    testIO (mapM ex2 [3,4,5])                  -- [13,14,15]
    testIO (forM [3,4,5] ex2)                  -- [13,14,15]
    testIO (sequence [ex1, ex2 0])             -- [5,10]
    -- XXX foldM