diff options
author | tomsmeding <tom.smeding@gmail.com> | 2017-01-23 20:39:32 +0100 |
---|---|---|
committer | tomsmeding <tom.smeding@gmail.com> | 2017-01-23 20:39:32 +0100 |
commit | 02f7721474e67e13677e3fd4dee5a78514a1b55f (patch) | |
tree | 36f19a157af1e2899d3f00a93ee75efac4ba026e | |
parent | 919de5d00aead7b0d2655ba2bb9c415c073a1fc3 (diff) |
Name generator monad test code
-rw-r--r-- | namegen/test.hs | 47 |
1 files changed, 47 insertions, 0 deletions
diff --git a/namegen/test.hs b/namegen/test.hs new file mode 100644 index 0000000..caa7111 --- /dev/null +++ b/namegen/test.hs @@ -0,0 +1,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 |