-- Monad example using parents of sheep.  Original by:

{- Author:     Jeff Newbern
   Maintainer: Jeff Newbern <jnewbern@nomaware.com>
   Time-stamp: <Mon Nov 10 11:59:14 2003>
   License:    GPL
-}

-- Modified by Scot Drysdale on 2/29/08

import Monad   -- to get mplus

-- everything you need to know about sheep
data Sheep = Sheep {name::String, mother::Maybe Sheep, father::Maybe Sheep}

-- we show sheep by name
instance Show Sheep where
  show s = show (name s)

-- comb is a combinator for sequencing operations that return Maybe
comb :: Maybe a -> (a -> Maybe b) -> Maybe b
comb Nothing  _ = Nothing
comb (Just x) f = f x

-- now we can use `comb` to build complicated sequences
maternalGrandfatherC :: Sheep -> Maybe Sheep
maternalGrandfatherC s = (Just s) `comb` mother `comb` father

fathersMaternalGrandmotherC :: Sheep -> Maybe Sheep
fathersMaternalGrandmotherC s = (Just s) `comb` father `comb` mother `comb` mother 

mothersPaternalGrandfatherC :: Sheep -> Maybe Sheep
mothersPaternalGrandfatherC s = (Just s) `comb` mother `comb` father `comb` father 

-- Our sheep family tree
adam   = Sheep "Adam" Nothing Nothing
eve    = Sheep "Eve" Nothing Nothing
uranus = Sheep "Uranus" Nothing Nothing
gaea   = Sheep "Gaea" Nothing Nothing
kronos = Sheep "Kronos" (Just gaea) (Just uranus)
holly  = Sheep "Holly" (Just eve) (Just adam)
roger  = Sheep "Roger" (Just eve) (Just kronos)
molly  = Sheep "Molly" (Just holly) (Just roger)
dolly  = Sheep "Dolly" (Just molly) Nothing

-- print Dolly's maternal grandfather

main1 = do print (maternalGrandfatherC dolly)
           print (fathersMaternalGrandmotherC dolly)
           print (mothersPaternalGrandfatherC dolly)
		   
		   
---- Use monads instead of `comb`

-- the Maybe type is already declared as an instance of the Monad class
-- in the standard prelude, so we don't actually need to define it here.
-- just remember that it looks something like this:
-- instance Monad Maybe where
--    Nothing  >>= f = Nothing
--    (Just x) >>= f = f x
--    return         = Just
--    fail s         = Nothing

-- now we can use monad operations to build complicated sequences
-- Note that "return" has nothing to do with ending the function call!

maternalGrandfatherM :: Sheep -> Maybe Sheep
maternalGrandfatherM s = return s >>=  mother >>= father

fathersMaternalGrandmotherM :: Sheep -> Maybe Sheep
fathersMaternalGrandmotherM s = return s >>= father >>= mother >>= mother 

mothersPaternalGrandfatherM :: Sheep -> Maybe Sheep
mothersPaternalGrandfatherM s = return s >>= mother >>= father >>= father 

main2 = do print (maternalGrandfatherM dolly)
           print (fathersMaternalGrandmotherM dolly)
           print (mothersPaternalGrandfatherM dolly)
		
		
-- we can also use do-notation to build complicated sequences
maternalGrandfather :: Sheep -> Maybe Sheep
maternalGrandfather s = do m <- mother s
                           father m

fathersMaternalGrandmother :: Sheep -> Maybe Sheep
fathersMaternalGrandmother s = do f  <- father s
                                  gm <- mother f
                                  mother gm

mothersPaternalGrandfather :: Sheep -> Maybe Sheep
mothersPaternalGrandfather s = do m  <- mother s
                                  gf <- father m
                                  father gf

main3 = do print (maternalGrandfather dolly)
           print (fathersMaternalGrandmother dolly)
           print (mothersPaternalGrandfather dolly)
           

-- Also demonstrate MonadPlus, define in Monad as:

--class (Monad m) => MonadPlus m where
--    mzero :: m a
--    mplus :: m a -> m a -> m a

--instance MonadPlus Maybe where
--    mzero             = Nothing
--    Nothing `mplus` x = x
--    x `mplus` _       = x

-- Can be used to create parent function and grandparent functions:

-- returns a parent, if one exists
parent  :: Sheep -> Maybe Sheep
parent s = (mother s) `mplus` (father s)

-- returns a grandparent, if one exists.
-- Why does "return s >>= parent >>= parent" sometimes fail?
grandparent  :: Sheep -> Maybe Sheep
grandparent s = (mother s >>= parent) `mplus` (father s >>= parent)