content: {- Author:     Jeff Newbern
     Maintainer: Jeff Newbern <jnewbern@nomaware.com>
     Time-stamp: <Mon Aug 18 14:51:56 2003>
     License:    GPL
  -}
  
  {- DESCRIPTION
  
  Example 26 - Managing a complex transformer stack.
  
  Usage: Compile the code (with -fglasgow-exts) and run it.
         It will print a series of (value,log) pairs.
         The output isn't very interesting, but you should try to understand
         in detail how the different monadic computations in the source
         below interact to produce the values.
  
  Try: ./ex26
  -}
  
  import IO
  import Monad
  import Char (digitToInt)
  import Control.Monad.State
  import Control.Monad.Writer
  
  -- this is our combined monad type for this problem
  type NDS a = StateT Int (WriterT [String] []) a
  
  {- Here is a computation on lists -}
  
  -- return the digits of a number as a list
  getDigits :: Int -> [Int]
  getDigits n = let s = (show n)
                in map digitToInt s
  
  {- Here are some computations in MonadWriter -}
  
  -- write a value to a log and return that value
  logVal :: (MonadWriter [String] m) => Int -> m Int
  logVal n = do tell ["logVal: " ++ (show n)]
                return n
  
  -- do a logging computation and return the length of the log it wrote
  getLogLength :: (MonadWriter [[a]] m) => m b -> m Int
  getLogLength c = do (_,l) <- listen $ c
                      return (length (concat l))
  
  -- log a string value and return 0
  logString :: (MonadWriter [String] m) => String -> m Int
  logString s = do tell ["logString: " ++ s]
                   return 0
  
  {- Here is a computation that requires a WriterT [String] [] -}
  
  -- "Fork" the computation and log each list item in a different branch.
  logEach :: (Show a) => [a] -> WriterT [String] [] a
  logEach xs = do x <- lift xs
                  tell ["logEach: " ++ (show x)]
                  return x
  		
  {- Here is a computation in MonadState -}
  
  -- increment the state by a specified value
  addVal :: (MonadState Int m) => Int -> m ()
  addVal n = do x <- get
                put (x+n)
  
  {- Here are some computations in the combined monad -}
  
  -- set the state to a given value, and log that value
  setVal :: Int -> NDS ()
  setVal n = do x <- lift $ logVal n
                put x
  
  -- "Fork" the computation, adding a different digit to the state in each branch.
  -- Because setVal is used, the new values are logged as well.
  addDigits :: Int -> NDS ()
  addDigits n = do x  <- get
                   y <- lift . lift $ getDigits n
                   setVal (x+y)
  
  {- an equivalent construction is:
  addDigits :: Int -> NDS ()
  addDigits n = do x <- get
                   msum (map (\i->setVal (x+i)) (getDigits n))
  -}
  
  {- This is an example of a helper function that can be used to put all of the lifting logic
     in one location and provide more informative names.  This has the advantage that if the
     transformer stack changes in the future (say, to add ErrorT) the changes to the existing
     lifting logic are confined to a small number of functions.
  -}
  liftListToNDS :: [a] -> NDS a
  liftListToNDS = lift . lift
  
  -- perform a series of computations in the combined monad, lifting computations from other
  -- monads as necessary.
  main :: IO ()
  main = do mapM_ print $ runWriterT $ (`evalStateT` 0) $ do x <- lift $ getLogLength $ logString "hello"
                                                             addDigits x
                                                             x <- lift $ logEach [1,3,5]
                                                             lift $ logVal x
                                                             liftListToNDS $ getDigits 287
  
  -- END OF FILE
  