Name generator monad test code

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