monadic ants

Ant.hs

module Ant
where

import Prelude hiding (log)
import Control.Monad ((>=>))
import Data.List ((\\))


-- | A Simple logging Monad that logs items of type e
data Logging e a = Logging { unLog :: [e] -> ([e], a) }

instance Monad (Logging e) where
    return a = Logging $ \w -> (w, a)
    l >>= f  = Logging $ \w -> let (w', a) = unLog l w in unLog (f a) w'
    l >>  m  = Logging $ \w -> let (w', _) = unLog l w in unLog  m    w'

-- | Log an item in the Logging monad
log :: e -> Logging e ()
log e = logs [e]

-- | Log items in the Logging monad
logs :: [e] -> Logging e ()
logs es = Logging $ \w -> (w ++ es, ())

-- | Run a Logging, and return both the result and the accumulated log.
-- Note: In the pair, the log is returned first.
runLogging :: Logging e a -> ([e], a)
runLogging l = unLog l []


data Ant = Ant { antName :: String }
    deriving (Eq)
data Order = Order { ordAnt :: Ant, ordVerb :: String }

-- | Given a function to generate orders, turn it into a function taking
-- [Ant] and returning remaining [Ant] in the Logging Order monad (thus
-- logging the Orders). Note that arguments are flipped from the original
-- ~>> function.
doOrders :: ([Ant] -> [Order]) -> [Ant] -> Logging Order [Ant]
doOrders fao as = logs applied >> return remaining
  where
    applied = fao as
    remaining = as \\ map ordAnt applied

-- written perhaps more idomatically in do notation
doOrders' :: ([Ant] -> [Order]) -> [Ant] -> Logging Order [Ant]
doOrders' fao as = do
    let applied = fao as
    logs applied
    return $ as \\ map ordAnt applied

-- | Some Order generating functions...
phase1 :: [Ant] -> [Order]
phase1 = undefined

phase2 :: [Ant] -> [Order]
phase2 = undefined

phase3 :: [Ant] -> [Order]
phase3 = undefined

-- | Compose doing some of these together. This is where the monadic machinery
-- comes into play. Note the use of >>= to chain the [Ant] results along, while
-- the Logging Order monad accumulates the Orders "in the background". This
-- code is the reason that doOrders's arguments are flipped from ~>>'s.
commandChain :: [Ant] -> Logging Order [Ant]
commandChain as = doOrders phase1 as >>= doOrders phase2 >>= doOrders phase3

-- | A somewhat nicer version using >=>
commandChain' :: [Ant] -> Logging Order [Ant]
commandChain' = doOrders phase1 >=> doOrders phase2 >=> doOrders phase3

-- | Applying the commandChain to some [Ant] to get the [Orders] and remaining
-- [Ant]
runCommandChain :: [Ant] -> ([Order], [Ant])
runCommandChain = runLogging . commandChain