aboutsummaryrefslogtreecommitdiff
path: root/utils/CC/IdSupply.hs
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))