-- A custom state monad
data MS s a = St (s -> (a, s))
instance Monad (MS s) where
return x = St $ \s -> (x, s)
St h >>= f = St $ \s -> let (a, s') = h s
St k = f a
in k s'
tick :: Num a => MS a a
tick = St $ \s -> (s, s+1)
runS :: MS s a -> s -> a
runS (St h) s = fst $ h s
-- and how to use it to implement dfn
data Tree a = T a [Tree a]
deriving Show
dfn :: Tree a -> Tree (a, Int)
dfn t = runS (aux t) 1
where aux :: Tree a -> MS Int (Tree (a, Int))
aux (T x ts) = do
n <- tick
ts' <- auxs ts
return $ T (x, n) ts'
auxs :: [Tree a] -> MS Int [Tree (a, Int)]
auxs [] = return []
auxs (t : ts) = do
t' <- aux t
ts' <- auxs ts
return $ t' : ts'
t = T 'a' [ T 'b' []
, T 'c' [ T 'e' []
, T 'f' []
]
, T 'd' []
]
main = print $ dfn t