From 02f7721474e67e13677e3fd4dee5a78514a1b55f Mon Sep 17 00:00:00 2001 From: tomsmeding Date: Mon, 23 Jan 2017 20:39:32 +0100 Subject: Name generator monad test code --- namegen/test.hs | 47 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 47 insertions(+) create mode 100644 namegen/test.hs 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 -- cgit v1.2.3-54-g00ecf