@@ -3,7 +3,6 @@
33{-# LANGUAGE ScopedTypeVariables #-}
44{-# LANGUAGE UndecidableInstances #-}
55{-# LANGUAGE FlexibleInstances #-}
6−{-# LANGUAGE CPP #-}
76module Language.Haskell.Generate.Monad
87 ( Generate(..), ExpG
98 , runGenerate, newName
@@ -36,27 +35,19 @@ import Language.Haskell.Exts.SrcLoc
3635import Language.Haskell.Exts.Syntax
3736import Language.Haskell.Generate.Expression
3837
39−import Prelude
40−
4138--------------------------------------------------------------------------------
4239-- Generate expressions
4340
44−-- | This monad keeps track of a counter for generating unique names and the set of modules
45−-- that are needed for the expression.
4641newtype Generate a = Generate { unGenerate :: StateT Integer (Writer (S.Set ModuleName)) a } deriving (Functor, Applicative, Monad)
4742
48−-- | Extract the set of modules and the value from a Generate action.
4943runGenerate :: Generate a -> (a, S.Set ModuleName)
5044runGenerate (Generate a) = runWriter $ evalStateT a 0
5145
52−-- | This is a type alias for a Generate action that returns an expression of type 't'.
5346type ExpG t = Generate (Expression t)
5447
55−-- | Use a haskell-src-exts Exp as the result of a Generate action.
5648returnE :: Exp -> ExpG t
5749returnE = return . Expression
5850
59−-- | Pretty print the expression generated by a given action.
6051generateExp :: ExpG t -> String
6152generateExp = prettyPrint . runExpression . fst . runGenerate
6253
@@ -64,13 +55,7 @@ generateExp = prettyPrint . runExpression . fst . runGenerate
6455caseE :: ExpG x -> [(Pat, ExpG t)] -> ExpG t
6556caseE v alt = do
6657 v' <- v
67−#if MIN_VERSION_haskell_src_exts(1,17,0)
68− alt' <- mapM (\(p,a) -> fmap (\a' -> Alt noLoc p (UnGuardedRhs $ runExpression a') Nothing) a) alt
69−#elif MIN_VERSION_haskell_src_exts(1,16,0)
70− alt' <- mapM (\(p,a) -> fmap (\a' -> Alt noLoc p (UnGuardedRhs $ runExpression a') (BDecls [])) a) alt
71−#else
7258 alt' <- mapM (\(p,a) -> fmap (\a' -> Alt noLoc p (UnGuardedAlt $ runExpression a') (BDecls [])) a) alt
73−#endif
7459 return $ Expression $ Case (runExpression v') alt'
7560
7661-- | Import a function from a module. This function is polymorphic in the type of the resulting expression,
@@ -103,16 +88,7 @@ newName pref = Generate $ do
10388 i <- get <* modify succ
10489 return $ Ident $ pref ++ show i
10590
106−-- | Generate a expression from a haskell value. This can for example be used to create lambdas:
107−--
108−-- >>> putStrLn $ generateExp $ expr (\x f -> f <>$ x)
109−-- \ pvar_0 -> \ pvar_1 -> pvar_1 pvar_0
110−--
111−-- Or string literals:
112−--
113−-- >>> putStrLn $ generateExp $ expr "I'm a string!"
114−-- ['I', '\'', 'm', ' ', 'a', ' ', 's', 't', 'r', 'i', 'n', 'g', '!']
115−--
91+-- | Generate a expression from a haskell value.
11692class GenExp t where
11793 type GenExpType t :: *
11894
@@ -153,12 +129,14 @@ instance GenExp x => GenExp (ExpG a -> x) where
153129--------------------------------------------------------------------------------
154130-- Apply functions
155131
132+
156133-- | Apply a function in a haskell expression to a value.
157134applyE :: ExpG (a -> b) -> ExpG a -> ExpG b
158135applyE a b = wrap $ liftM (foldl1 App) $ sequence [unwrap a, unwrap b]
159136 where wrap = fmap Expression
160137 unwrap = fmap runExpression
161138
139+
162140-- | Operator for 'applyE'.
163141(<>$) :: ExpG (a -> b) -> ExpG a -> ExpG b
164142(<>$) = applyE
@@ -214,31 +192,19 @@ instance GenExp (FunRef t) where
214192
215193-- | Generate a ExportSpec for a given function item.
216194exportFun :: FunRef t -> ExportSpec
217−#if MIN_VERSION_haskell_src_exts(1,16,0) && !MIN_VERSION_haskell_src_exts(1,17,0)
218−exportFun (FunRef name) = EVar NoNamespace (UnQual name)
219−#else
220195exportFun (FunRef name) = EVar (UnQual name)
221−#endif
222196
223197-- | Add a declaration to the module. Return a reference to it that can be used to either apply the function to some values or export it.
224198addDecl :: Name -> ExpG t -> ModuleM (FunRef t)
225199addDecl name e = ModuleM $ do
226200 let (body, mods) = runGenerate e
227−#if MIN_VERSION_haskell_src_exts(1,17,0)
228− tell (mods, [FunBind [Match noLoc name [] Nothing (UnGuardedRhs $ runExpression body) Nothing]])
229−#else
230201 tell (mods, [FunBind [Match noLoc name [] Nothing (UnGuardedRhs $ runExpression body) $ BDecls []]])
231−#endif
232202 return $ FunRef name
233203
234204-- | Extract the Module from a module generator.
235205runModuleM :: ModuleG -> String -> Module
236206runModuleM (ModuleM act) name =
237−#if MIN_VERSION_haskell_src_exts(1,16,0)
238− Module noLoc (ModuleName name) [] Nothing export (map (\md -> ImportDecl noLoc md True False False Nothing Nothing Nothing) $ S.toList imps) decls
239−#else
240207 Module noLoc (ModuleName name) [] Nothing export (map (\md -> ImportDecl noLoc md True False Nothing Nothing Nothing) $ S.toList imps) decls
241−#endif
242208 where (export, (imps, decls)) = runWriter act
243209
244210-- | Generate the source code for a module.