----------------------------------------------------------------------- -- -- Haskell: The Craft of Functional Programming -- Simon Thompson -- (c) Addison-Wesley, 1996-2011. -- -- Chapter 18 -- ----------------------------------------------------------------------- module Chapter18 where import Prelude hiding (lookup) import System.IO import Control.Monad.Identity import Chapter8 (getInt) import Data.Time import System.Locale import System.IO.Unsafe (unsafePerformIO) -- Programming with monads -- ^^^^^^^^^^^^^^^^^^^^^^^ -- The basics of input/output -- ^^^^^^^^^^^^^^^^^^^^^^^^^^ -- Reading input is done by getLine and getChar: see Prelude for details. -- getLine :: IO String -- getChar :: IO Char -- Text strings are written using -- -- putStr :: String -> IO () -- putStrLn :: String -> IO () -- A hello, world program helloWorld :: IO () helloWorld = putStr "Hello, World!" -- Simple examples readWrite :: IO () readWrite = do getLine putStrLn "one line read" readEcho :: IO () readEcho = do line <-getLine putStrLn ("line read: " ++ line) -- Adding a sequence of integers from the input sumInts :: Integer -> IO Integer sumInts s = do n <- getInt if n==0 then return s else sumInts (s+n) -- Adding a list of integers, using an accumulator sumAcc :: Integer -> [Integer] -> Integer sumAcc s [] = s sumAcc s (n:ns) = if n==0 then s else sumAcc (s+n) ns -- Addiing a sequence of integers, courteously. sumInteract :: IO () sumInteract = do putStrLn "Enter integers one per line" putStrLn "These will be summed until zero is entered" sum <- sumInts 0 putStr "The sum is " print sum -- Further I/O -- ^^^^^^^^^^^ -- Interaction at the terminal copyInteract :: IO () copyInteract = do hSetBuffering stdin LineBuffering copyEOF hSetBuffering stdin NoBuffering copyEOF :: IO () copyEOF = do eof <- isEOF if eof then return () else do line <- getLine putStrLn line copyEOF -- Input and output as lazy lists -- Reverse all the lines in the input. listIOprog :: String -> String listIOprog = unlines . map reverse . lines -- Generating random numbers randomInt :: Integer -> IO Integer randomInt n = do time <- getCurrentTime return ( (`rem` n) $ read $ take 6 $ formatTime defaultTimeLocale "%q" time) randInt :: Integer -> Integer randInt = unsafePerformIO . randomInt -- The calculator -- ^^^^^^^^^^^^^^ -- This is available separately in the Calculator directory. -- The do notation revisited -- ^^^^^^^^^^^^^^^^^^^^^^^^^ addOneInt :: IO () addOneInt = do line <- getLine putStrLn (show (1 + read line :: Int)) addOneInt' = getLine >>= \line -> putStrLn (show (1 + read line :: Int)) -- Monads for Functional Programming -- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -- The definition of the Monad class -- class Monad m where -- (>>=) :: m a -> (a -> m b) -> m b -- return :: a -> m a -- fail :: String -> m a -- Kelisli composition for monadic functions. -- (>@>) :: Monad m => (a -> m b) -> -- (b -> m c) -> -- (a -> m c) -- f >@> g = \ x -> (f x) >>= g -- Some examples of monads -- ^^^^^^^^^^^^^^^^^^^^^^^ -- Some examples from the standard prelude. -- The list monad -- instance Monad [] where -- xs >>= f = concat (map f xs) -- return x = [x] -- zero = [] -- The Maybe monad -- instance Monad Maybe where -- (Just x) >>= k = k x -- Nothing >>= k = Nothing -- return = Just -- The parsing monad -- data SParse a b = SParse (Parse a b) -- instance Monad (SParse a) where -- return x = SParse (succeed x) -- zero = SParse fail -- (SParse pr) >>= f -- = SParse (\s -> concat [ sparse (f x) rest | (x,rest) <- pr st ]) -- sparse :: SParse a b -> Parse a b -- sparse (SParse pr) = pr -- A state monad (the state need not be a table; this example is designed -- to support the example discussed below.) type Table a = [a] data State a b = State (Table a -> (Table a , b)) instance Monad (State a) where return x = State (\tab -> (tab,x)) (State st) >>= f = State (\tab -> let (newTab,y) = st tab (State trans) = f y in trans newTab) -- Example: Monadic computation over trees -- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -- A type of binary trees. data Tree a = Nil | Node a (Tree a) (Tree a) deriving (Eq,Ord,Show) -- Summing a tree of integers -- A direct solution: sTree :: Tree Integer -> Integer sTree Nil = 0 sTree (Node n t1 t2) = n + sTree t1 + sTree t2 -- A monadic solution: first giving a value of type Identity Int ... sumTree :: Tree Integer -> Identity Integer sumTree Nil = return 0 sumTree (Node n t1 t2) = do num <- return n s1 <- sumTree t1 s2 <- sumTree t2 return (num + s1 + s2) -- ... then adapted to give an Int solution sTree' :: Tree Integer -> Integer sTree' = identity . sumTree identity :: Identity a -> a identity (Identity x) = x -- Using a state monad in a tree calculation -- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -- The top level function ... numTree :: Eq a => Tree a -> Tree Integer -- ... and the function which does all the work: numberTree :: Eq a => Tree a -> State a (Tree Integer) -- Its structure mirrors exactly the structure of the earlier program to -- sum the tree. numberTree Nil = return Nil numberTree (Node x t1 t2) = do num <- numberNode x nt1 <- numberTree t1 nt2 <- numberTree t2 return (Node num nt1 nt2) -- The work of the algorithm is done node by node, hence the function numberNode :: Eq a => a -> State a Integer numberNode x = State (nNode x) -- -- Looking up a value in the table; will side-effect the table if the value -- is not present. nNode :: Eq a => a -> (Table a -> (Table a , Integer)) nNode x table | elem x table = (table , lookup x table) | otherwise = (table++[x] , integerLength table) where integerLength = toInteger.length -- Looking up a value in the table when known to be present lookup :: Eq a => a -> Table a -> Integer lookup x tab = locate 0 tab where locate n (y:ys) = if x==y then n else locate (n+1) ys -- Extracting a value froma state monad. runST :: State a b -> b runST (State st) = snd (st []) -- The top-level function defined eventually. numTree = runST . numberTree -- Example tree egTree :: Tree String egTree = Node "Moon" (Node "Ahmet" Nil Nil) (Node "Dweezil" (Node "Ahmet" Nil Nil) (Node "Moon" Nil Nil))