blob: 234f6cc1490be9a61aa1bf181557662a0325830e (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
|
module CC.IdSupply(IdSupply, runIdSupply, genId) where
import Control.Monad.Trans
data IdSupply a = IdSupply (Int -> (Int, a))
instance Functor IdSupply where
fmap f (IdSupply act) = IdSupply (fmap f . act)
instance Applicative IdSupply where
pure x = IdSupply (\idval -> (idval, x))
IdSupply f <*> IdSupply x =
IdSupply (\idval -> let (idval', f') = f idval
in f' <$> x idval')
instance Monad IdSupply where
IdSupply x >>= f =
IdSupply (\idval -> let (idval', x') = x idval
IdSupply res = f x'
in res idval')
instance MonadTrans
runIdSupply :: Int -> IdSupply a -> a
runIdSupply startid (IdSupply f) = snd (f startid)
genId :: IdSupply Int
genId = IdSupply (\idval -> (idval + 1, idval))
|