Quick and cheesy fresh id generator

Main.hs

module Main where

main :: IO ()
main = let strings = evalSupply examples 0
        -- will print
        -- got: 0
        -- got: 1
        in mapM_ putStrLn strings

data Cnt a  = Cnt (Int -> (Int, a))

instance Functor Cnt where
  fmap f (Cnt k) = Cnt $ \s ->
    let (s', a) = k s
     in (s', f a)

instance Applicative Cnt where
  pure a = Cnt $ \s -> (s, a)
  Cnt kf <*> Cnt km = Cnt $ \s ->
    let (s', f) = kf s
        (s'', m) = km s'
     in (s'', f m)

instance Monad Cnt where
  return = pure
  Cnt k >>= f = Cnt $ \s ->
    let (s', a) = k s
        Cnt k' = f a
     in k' s'

supply :: Cnt Int
supply = Cnt $ \s -> (s + 1, s)

evalSupply :: Cnt a -> Int -> a
evalSupply (Cnt k) s = snd $ k s

example :: Cnt String
example = do
  i <- supply
  return $ "got: " ++ show i

examples :: Cnt [String]
examples = do
  a <- example
  b <- example
  return [a, b]