state monad

snippet.hs

listDirs :: FilePath -> IO [String]
listDirs = liftM (filter notDots) . getDirectoryContents
  where notDots p = p /= "." && p /= ".."

countEntries :: FilePath -> WriterT [(FilePath, Int)]  IO ()
countEntries path = do
  contents <- liftIO . listDirs $ path
  tell [(path, length contents)]
  forM_ contents $ \name -> do
    let newName = path </> name
    isDir <- liftIO . doesDirectoryExist $ newName
    when isDir $ countEntries newName


type Log = [String]
newtype Logger a = Logger { execLogger :: (a, Log) } deriving (Show)

record :: String -> Logger ()
record s = Logger ((), [s])

instance Functor Logger where
  fmap f (Logger (a, xs)) = Logger (f a, xs)

instance Applicative Logger where
  pure a = Logger (a, [])
  Logger (f, xs) <*> Logger (a, ys) = Logger (f a, xs ++ ys)

instance Monad Logger where
  return = pure
  -- (>>=) :: Logger a -> (a -> Logger b) -> Logger b
  m >>= k = let (a, w) = execLogger m
                n      = k a
                (b, x) = execLogger n
            in Logger (b, w ++ x)


newtype MyState s a = S { runMyState :: s -> (a, s) }

instance Functor (MyState s) where
  fmap f (S rs) = S $ \s ->
    let (a, s') = rs s
    in (f a, s')

instance Applicative (MyState s) where
  pure a = S $ \s -> (a, s)
  (S st) <*> (S af) = S $ \s ->
    let (f, s')  = st s
        (a, s'') = af s'
    in (f a, s'')


instance Monad (MyState s) where
  return = pure
  m >>= f = S $ \s ->
    let (a, s') = runMyState m s
    in runMyState (f a) s'


get :: MyState s s
get = S $ \s -> (s, s)


put :: s -> MyState s ()
put s = S $ \_ -> ((), s)



type RandomState a = MyState StdGen a

getRandom :: Random a => RandomState a
getRandom = do
  g <- get
  let (v, g') = random g
  put g'
  return v



{-
functor laws:
> fmap id       ===  id
> fmap (f . g)  ===  fmap f . fmap g


monad laws:
> return x >>= f            ===     f x                 left identity
> m >>= return              ===     m                   right identity
> m >>= (f >>= g)           ===     (m >>= f) >>= g     associativity

-}