summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authortomsmeding <tom.smeding@gmail.com>2017-01-23 20:39:32 +0100
committertomsmeding <tom.smeding@gmail.com>2017-01-23 20:39:32 +0100
commit02f7721474e67e13677e3fd4dee5a78514a1b55f (patch)
tree36f19a157af1e2899d3f00a93ee75efac4ba026e
parent919de5d00aead7b0d2655ba2bb9c415c073a1fc3 (diff)
Name generator monad test code
-rw-r--r--namegen/test.hs47
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