blob: caa71119c4b0c9580f0e6d66be363c1775a8ca5a (
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
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
|
type Index = Integer
data Namegen a = Namegen (Index -> (a, Index))
runNameGen :: Index -> Namegen a -> a
runNameGen i (Namegen f) = fst (f i)
supply :: Namegen Integer
supply = Namegen $ \i -> (i, i + 1)
makeName :: String -> Namegen String
makeName base = supply >>= \i -> return $ base ++ show i
makeTempName :: Namegen String
makeTempName = makeName "t"
instance Functor Namegen where
fmap f (Namegen g) = Namegen $ \i -> let (x, i2) = g i in (f x, i2)
instance Applicative Namegen where
pure x = Namegen $ \i -> (x, i)
(Namegen fg) <*> (Namegen xg) =
Namegen $ \i -> let (f, i2) = fg i
(x, i3) = xg i2
in (f x, i3)
instance Monad Namegen where
(Namegen xg) >>= f =
Namegen $ \i -> let (x, i2) = xg i
(Namegen resg) = f x
in resg i2
funString :: Int -> Namegen String
funString i = do
n1 <- makeTempName
n2 <- makeTempName
return $ "Fun String " ++ show i ++ ", made with '" ++ n1 ++ "' and '" ++ n2 ++ "'"
main :: IO ()
main = do
putStrLn $ runNameGen 1 $ do
n1 <- makeName "xyz"
s <- funString 42
n2 <- makeName "abc"
return $ s ++ "\nGenerated names " ++ n1 ++ " and " ++ n2
|
