ghci> [1,2,3] `mplus` [4,5,6]
[1,2,3,4,5,6]

ghci> Just 1 `mplus` Just 2
Just 1

-- file: ch15/MonadPlus.hs
        mzero >>= f == mzero

-- file: ch15/MonadPlus.hs
        v >> mzero == mzero

-- file: ch15/MonadPlus.hs
guard        :: (MonadPlus m) => Bool -> m ()
guard True   =  return ()
guard False  =  mzero

-- file: ch15/MonadPlus.hs
x `zeroMod` n = guard ((x `mod` n) == 0) >> return x

-- file: ch15/RandomSupply.hs
import Supply
import System.Random hiding (next)

randomsIO :: Random a => IO [a]
randomsIO =
        getStdRandom $ \g ->
                let (a, b) = split g
                in (randoms a, b)

ghci> :load RandomSupply
[1 of 2] Compiling Supply           ( Supply.hs, interpreted )
[2 of 2] Compiling RandomSupply     ( RandomSupply.hs, interpreted )
Ok, modules loaded: RandomSupply, Supply.
ghci> (fst . runSupply next) `fmap` randomsIO

<interactive>:1:17:
        Ambiguous occurrence `next'
        It could refer to either `Supply.next', imported from Supply at RandomSupply.hs:4:0-12
                                                                                          (defined at Supply.hs:32:0)
                                                  or `System.Random.next', imported from System.Random
ghci> (fst . runSupply next) `fmap` randomsIO

<interactive>:1:17:
        Ambiguous occurrence `next'
        It could refer to either `Supply.next', imported from Supply at RandomSupply.hs:4:0-12
                                                                                          (defined at Supply.hs:32:0)
                                                  or `System.Random.next', imported from System.Random

ghci> :m +Control.Arrow
ghci> first (+3) (1,2)
(4,2)
ghci> second odd ('a',1)
('a',True)

-- file: ch15/RandomGolf.hs
import Control.Arrow (first)

randomsIO_golfed :: Random a => IO [a]
randomsIO_golfed = getStdRandom (first randoms . split)

-- file: ch15/SupplyClass.hs
import qualified Supply as S

instance MonadSupply s (S.Supply s) where
        next = S.next

-- file: ch15/SupplyClass.hs
{-# LANGUAGE FlexibleInstances, FunctionalDependencies,
                         MultiParamTypeClasses #-}

module SupplyClass
        (
          MonadSupply(..)
        , S.Supply
        , S.runSupply
        ) where

-- file: ch15/Supply.hs
showTwo :: (Show s) => Supply s String
showTwo = do
  a <- next
  b <- next
  return (show "a: " ++ show a ++ ", b: " ++ show b)

-- file: ch15/SupplyClass.hs
showTwo_class :: (Show s, Monad m, MonadSupply s m) => m String
showTwo_class = do
  a <- next
  b <- next
  return (show "a: " ++ show a ++ ", b: " ++ show b)

-- file: ch15/HandleIO.hs
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module HandleIO
        (
          HandleIO
        , Handle
        , IOMode(..)
        , runHandleIO
        , openFile
        , hClose
        , hPutStrLn
        ) where

import System.IO (Handle, IOMode(..))
import qualified System.IO

-- file: ch15/HandleIO.hs
newtype HandleIO a = HandleIO { runHandleIO :: IO a }
        deriving (Monad)

-- file: ch15/HandleIO.hs
openFile :: FilePath -> IOMode -> HandleIO Handle
openFile path mode = HandleIO (System.IO.openFile path mode)

hClose :: Handle -> HandleIO ()
hClose = HandleIO . System.IO.hClose

hPutStrLn :: Handle -> String -> HandleIO ()
hPutStrLn h s = HandleIO (System.IO.hPutStrLn h s)

-- file: ch15/HandleIO.hs
safeHello :: FilePath -> HandleIO ()
safeHello path = do
  h <- openFile path WriteMode
  hPutStrLn h "hello world"
  hClose h

ghci> :load HandleIO
[1 of 1] Compiling HandleIO         ( HandleIO.hs, interpreted )
Ok, modules loaded: HandleIO.
ghci> runHandleIO (safeHello "hello_world_101.txt")
Loading package old-locale-1.0.0.0 ... linking ... done.
Loading package old-time-1.0.0.0 ... linking ... done.
Loading package filepath-1.1.0.0 ... linking ... done.
Loading package directory-1.0.0.0 ... linking ... done.
Loading package mtl-1.1.0.0 ... linking ... done.
ghci> :m +System.Directory
ghci> removeFile "hello_world_101.txt"

ghci> runHandleIO (safeHello "goodbye" >> removeFile "goodbye")

<interactive>:1:36:
        Couldn't match expected type `HandleIO a'
                   against inferred type `IO ()'
        In the second argument of `(>>)', namely `removeFile "goodbye"'
        In the first argument of `runHandleIO', namely
                `(safeHello "goodbye" >> removeFile "goodbye")'
        In the expression:
                runHandleIO (safeHello "goodbye" >> removeFile "goodbye")

ghci> :m +Control.Monad.Trans
ghci> :info MonadIO
class (Monad m) => MonadIO m where liftIO :: IO a -> m a
        -- Defined in Control.Monad.Trans
instance MonadIO IO -- Defined in Control.Monad.Trans

-- file: ch15/HandleIO.hs
import Control.Monad.Trans (MonadIO(..))

instance MonadIO HandleIO where
        liftIO = HandleIO

-- file: ch15/HandleIO.hs
tidyHello :: FilePath -> HandleIO ()
tidyHello path = do
  safeHello path
  liftIO (removeFile path)

-- file: ch15/MonadHandle.hs
{-# LANGUAGE FunctionalDependencies, MultiParamTypeClasses #-}

module MonadHandle (MonadHandle(..)) where

import System.IO (IOMode(..))

class Monad m => MonadHandle h m | m -> h where
        openFile :: FilePath -> IOMode -> m h
        hPutStr :: h -> String -> m ()
        hClose :: h -> m ()
        hGetContents :: h -> m String

        hPutStrLn :: h -> String -> m ()
        hPutStrLn h s = hPutStr h s >> hPutStr h "\n"

-- file: ch15/MonadHandleIO.hs
{-# LANGUAGE FunctionalDependencies, MultiParamTypeClasses #-}

import MonadHandle
import qualified System.IO

import System.IO (IOMode(..))
import Control.Monad.Trans (MonadIO(..), MonadTrans(..))
import System.Directory (removeFile)

import SafeHello

instance MonadHandle System.IO.Handle IO where
        openFile = System.IO.openFile
        hPutStr = System.IO.hPutStr
        hClose = System.IO.hClose
        hGetContents = System.IO.hGetContents
        hPutStrLn = System.IO.hPutStrLn

-- file: ch15/SafeHello.hs
safeHello :: MonadHandle h m => FilePath -> m ()
safeHello path = do
  h <- openFile path WriteMode
  hPutStrLn h "hello world"
  hClose h

ghci> safeHello "hello to my fans in domestic surveillance"
Loading package old-locale-1.0.0.0 ... linking ... done.
Loading package old-time-1.0.0.0 ... linking ... done.
Loading package filepath-1.1.0.0 ... linking ... done.
Loading package directory-1.0.0.0 ... linking ... done.
Loading package mtl-1.1.0.0 ... linking ... done.
ghci> removeFile "hello to my fans in domestic surveillance"

-- file: ch15/WriterIO.hs
data Event = Open FilePath IOMode
                   | Put String String
                   | Close String
                   | GetContents String
                         deriving (Show)

ghci> :m +Control.Monad.Writer
ghci> :type tell
tell :: (MonadWriter w m) => w -> m ()

-- file: ch15/WriterIO.hs
newtype WriterIO a = W { runW :: Writer [Event] a }
        deriving (Monad, MonadWriter [Event])

-- file: ch15/WriterIO.hs
runWriterIO :: WriterIO a -> (a, [Event])
runWriterIO = runWriter . runW

ghci> :load WriterIO
[1 of 3] Compiling MonadHandle      ( MonadHandle.hs, interpreted )
[2 of 3] Compiling SafeHello        ( SafeHello.hs, interpreted )
[3 of 3] Compiling WriterIO         ( WriterIO.hs, interpreted )
Ok, modules loaded: SafeHello, MonadHandle, WriterIO.
ghci> runWriterIO (safeHello "foo")
((),[Open "foo" WriteMode,Put "foo" "hello world",Put "foo" "\n",Close "foo"])

-- file: ch15/MonadHandleIO.hs
class (MonadHandle h m, MonadIO m) => MonadHandleIO h m | m -> h

instance MonadHandleIO System.IO.Handle IO

tidierHello :: (MonadHandleIO h m) => FilePath -> m ()
tidierHello path = do
  safeHello path
  liftIO (removeFile path)

-- file: ch15/MonadHandleIO.hs
tidyHello :: (MonadIO m, MonadHandle h m) => FilePath -> m ()
tidyHello path = do
  safeHello path
  liftIO (removeFile path)