summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-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