Refactor and add tutorial to README.md

This commit is contained in:
Benno Fünfstück 2013-12-23 16:32:13 +01:00
parent 14fa49762b
commit c129f0625c
7 changed files with 188 additions and 63 deletions

101
README.md
View File

@ -1,6 +1,105 @@
haskell-generate haskell-generate
==================== ================
[![Build Status](https://secure.travis-ci.org/bennofs/haskell-generate.png?branch=master)](http://travis-ci.org/bennofs/haskell-generate) [![Build Status](https://secure.travis-ci.org/bennofs/haskell-generate.png?branch=master)](http://travis-ci.org/bennofs/haskell-generate)
## Introduction
If you want to generate haskell source code, you could build up haskell-src-exts AST and then pretty print it. But that's easy to screw up, because haskell-src-exts doesn't include tag it's AST with a type. This library aims to fill the gap, adding type information to haskell-src-exts expressions and also managing imports for you.
## Getting started
First, you need to import this library:
```haskell
import Language.Haskell.Generate
```
This module reexports `Language.Haskell.Exts.Syntax`, because haskell-generate builds on top of that.
There are two main types in haskell-generate. The first is the monad `Generate` and the type alias `ExpG`. The `Generate` monad is used to track required imports. It also allows to generate unique names. `ExpG t` is just an action in the `Generate` monad that returns an expression of type `t`.
How do you build expressions? There is a number of predefined expressions for the functions in the
Prelude. This allows you to just use these and combine them to new expressions. For example, let's define a expression that reads a file called "names":
```haskell
readNamesFile' :: ExpG (IO String)
readNamesFile' = readFile' <>$ expr "names"
```
Here we use `(<>$)` to apply the `readFile'` expression to the string `names`. `readFile'` is one of the expressions already provided by haskell-generate. All expressions that are provided by haskell-generate end with an apostrophe. You can find more of them in the module `Language.Haskell.Generate.PreludeDef`. The `expr` function is used to lift the string `names` into an expression of type `ExpG String`.
Now that we have an expression, we need to bind it to a name in a module. For this job, we use another monad, the `ModuleM` monad. It allows you to bind expressions to names and then generate
a module with those names.
Here's how we generate our module:
```haskell
myModule :: ModuleG
myModule = do
d <- addDecl (Ident "main") $ applyE2 bind' readNamesFile' putStrLn'
return $ Just [exportFun d]
```
`ModuleG` is again a type synonym for an action in the `ModuleM` monad. It must either return Nothing (which omits the export list) or an export list. In this case, we export the "main" function, which we previously defined using `addDecl`.
The only thing left to do is to generate the actual source code for the module, for which we
use the `generateModule` function, which takes the module name as an argument:
```haskell
main :: IO ()
main = putStrLn $ generateModule myModule "Main"
```
If you run the program, you'll get the following output:
```haskell
module Main (main) where
import qualified GHC.Base
import qualified System.IO
main
= (GHC.Base.>>=) (System.IO.readFile ['n', 'a', 'm', 'e', 's'])
System.IO.putStrLn
```
If you run this code, you'll get the contents of the "names" file. The code is a bit ugly and uses
qualified imports to avoid name clashes, but it works.
## Importing functions
Until now, we've only used the predefined expressions from `Language.Haskell.Generate.PreludeDef`, but often you'll want to use definitions from other modules that you might want to use.
You can do that using the `useValue` from haskell-generate. Let's look at the type of `useValue`:
```haskell
useValue :: String -> Name -> ExpG t
```
`useValue` takes a module name in which the function is defined and the name of the function. It returns an expression of any type you which. This function is unsafe, because it cannot check that the returned type is actually the type of the function. That's why you usually given `useValue` an explicit type signature.
For example, suppose we want to use the function `permutations` from Data.List. We write the following definition for it:
```haskell
permutations' :: ExpG ([a] -> [[a]]) -- Here we given an explicit type for permutations'. This is not checked, so make sure it's actually right!
permutations' = useValue "Data.List" (Ident "permutations") -- "permutations" is an identifier, not a symbol, so we use the "Ident" constructor.
```
## Using TH to automagically import functions
If the function you want to import is already available at compile time, you can use the template haskell code from `Language.Haskell.Generate.TH` to generate the expression definitions. This is the approach we use for the Prelude, as an example.
Using the example from the previous section, we could also import the `permutations` function like this:
```haskell
-- at the top of the file:
{-# LANGUAGE TemplateHaskell #-} -- Enable template haskell
import Data.List (permutations) -- The function needs to be available at compile time
declareFunction 'permutations -- This generates the same code as above, but is more type-safe because you don't have to specify the type yourself.
```
## Contributing
If you have an idea, a question or a bug report, open an issue on github. You can also find me on freenode in the #haskell channel, my nick is bennofs.

View File

@ -37,7 +37,8 @@ library
, template-haskell , template-haskell
exposed-modules: exposed-modules:
Language.Haskell.Generate Language.Haskell.Generate
Language.Haskell.Generate.Base Language.Haskell.Generate.Monad
Language.Haskell.Generate.Expression
Language.Haskell.Generate.TH Language.Haskell.Generate.TH
Language.Haskell.Generate.PreludeDef Language.Haskell.Generate.PreludeDef

View File

@ -2,5 +2,6 @@ module Language.Haskell.Generate
( module X ( module X
) where ) where
import Language.Haskell.Generate.Base as X import Language.Haskell.Exts.Syntax as X
import Language.Haskell.Generate.Monad as X
import Language.Haskell.Generate.PreludeDef as X import Language.Haskell.Generate.PreludeDef as X

View File

@ -0,0 +1,12 @@
module Language.Haskell.Generate.Expression
( Expression(..)
, app
) where
import Language.Haskell.Exts.Syntax
newtype Expression t = Expression { runExpression :: Exp }
app :: Expression (a -> b) -> Expression a -> Expression b
app (Expression a) (Expression b) = Expression $ App a b

View File

@ -3,9 +3,10 @@
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
module Language.Haskell.Generate.Base module Language.Haskell.Generate.Monad
( ExpM(..), ExpG, ExpType ( Generate(..), ExpG
, runExpM, newName , runGenerate, newName
, returnE
, useValue, useCon, useVar , useValue, useCon, useVar
, caseE , caseE
, applyE, applyE2, applyE3, applyE4, applyE5, applyE6 , applyE, applyE2, applyE3, applyE4, applyE5, applyE6
@ -19,6 +20,7 @@ module Language.Haskell.Generate.Base
, addDecl , addDecl
, runModuleM , runModuleM
, generateModule , generateModule
, generateExp
) )
where where
@ -31,32 +33,30 @@ import qualified Data.Set as S
import Language.Haskell.Exts.Pretty import Language.Haskell.Exts.Pretty
import Language.Haskell.Exts.SrcLoc import Language.Haskell.Exts.SrcLoc
import Language.Haskell.Exts.Syntax import Language.Haskell.Exts.Syntax
import Language.Haskell.Generate.Expression
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Generate expressions -- Generate expressions
-- | A ExpM is a monad used to track the imports that are needed for a given expression. Usually, you don't have to use newtype Generate a = Generate { unGenerate :: StateT Integer (Writer (S.Set ModuleName)) a } deriving (Functor, Applicative, Monad)
-- this type directly, but use combinators to combine several ExpM into bigger expressions. The t type parameter tracks
-- the type of the expression, so you don't accidently build expression that don't type check.
newtype ExpM t a = ExpM { unExpM :: StateT Integer (Writer (S.Set ModuleName)) a } deriving (Functor, Applicative, Monad)
-- | The ExpG type is a ExpM computation that returns an expression. Usually, this is the end result of a function generating runGenerate :: Generate a -> (a, S.Set ModuleName)
-- a haskell expression runGenerate (Generate a) = runWriter $ evalStateT a 0
type ExpG t = ExpM t Exp
-- | Evaluate a ExpM action, returning the needed modules and the value. type ExpG t = Generate (Expression t)
runExpM :: ExpM t a -> (a, S.Set ModuleName)
runExpM (ExpM expt) = runWriter $ evalStateT expt 0
unsafeCoerceE :: ExpM t a -> ExpM t' a returnE :: Exp -> ExpG t
unsafeCoerceE (ExpM x) = ExpM x returnE = return . Expression
generateExp :: ExpG t -> String
generateExp = prettyPrint . runExpression . fst . runGenerate
-- | Generate a case expression. -- | Generate a case expression.
caseE :: ExpG x -> [(Pat, ExpG t)] -> ExpG t caseE :: ExpG x -> [(Pat, ExpG t)] -> ExpG t
caseE v alt = do caseE v alt = do
v' <- unsafeCoerceE v v' <- v
alt' <- mapM (\(p,a) -> fmap (\a' -> Alt noLoc p (UnGuardedAlt a') (BDecls [])) a) alt alt' <- mapM (\(p,a) -> fmap (\a' -> Alt noLoc p (UnGuardedAlt $ runExpression a') (BDecls [])) a) alt
return $ Case v' alt' return $ Expression $ Case (runExpression v') alt'
-- | Import a function from a module. This function is polymorphic in the type of the resulting expression, -- | Import a function from a module. This function is polymorphic in the type of the resulting expression,
-- you should probably only use this function to define type-restricted specializations. -- you should probably only use this function to define type-restricted specializations.
@ -67,31 +67,27 @@ caseE v alt = do
-- > addInt = useValue "Prelude" $ Symbol "+" -- > addInt = useValue "Prelude" $ Symbol "+"
-- --
useValue :: String -> Name -> ExpG a useValue :: String -> Name -> ExpG a
useValue md name = ExpM $ do useValue md name = Generate $ do
lift $ tell $ S.singleton $ ModuleName md lift $ tell $ S.singleton $ ModuleName md
return $ Var $ Qual (ModuleName md) name return $ Expression $ Var $ Qual (ModuleName md) name
-- | Import a value constructor from a module. Returns the qualified name of the constructor. -- | Import a value constructor from a module. Returns the qualified name of the constructor.
useCon :: String -> Name -> ExpM t QName useCon :: String -> Name -> Generate QName
useCon md name = ExpM $ do useCon md name = Generate $ do
lift $ tell $ S.singleton $ ModuleName md lift $ tell $ S.singleton $ ModuleName md
return $ Qual (ModuleName md) name return $ Qual (ModuleName md) name
-- | Use the value of a variable with the given name. -- | Use the value of a variable with the given name.
useVar :: Name -> ExpG t useVar :: Name -> ExpG t
useVar name = return $ Var $ UnQual name useVar name = return $ Expression $ Var $ UnQual name
-- | Generate a new unique variable name with the given prefix. Note that this new variable name -- | Generate a new unique variable name with the given prefix. Note that this new variable name
-- is only unique relative to other variable names generated by this function. -- is only unique relative to other variable names generated by this function.
newName :: String -> ExpM t Name newName :: String -> Generate Name
newName pref = ExpM $ do newName pref = Generate $ do
i <- get <* modify succ i <- get <* modify succ
return $ Ident $ pref ++ show i return $ Ident $ pref ++ show i
-- | This type family can be used to get the type associated with some expression.
type family ExpType a :: *
type instance ExpType (ExpM t a) = t
-- | Generate a expression from a haskell value. -- | Generate a expression from a haskell value.
class GenExp t where class GenExp t where
type GenExpType t :: * type GenExpType t :: *
@ -103,36 +99,43 @@ instance GenExp (ExpG a) where
type GenExpType (ExpG a) = a type GenExpType (ExpG a) = a
expr = id expr = id
instance GenExp (Expression t) where
type GenExpType (Expression t) = t
expr = return
instance GenExp Char where instance GenExp Char where
type GenExpType Char = Char type GenExpType Char = Char
expr = return . Lit . Char expr = return . Expression . Lit . Char
instance GenExp Integer where instance GenExp Integer where
type GenExpType Integer = Integer type GenExpType Integer = Integer
expr = return . Lit . Int expr = return . Expression . Lit . Int
instance GenExp Rational where instance GenExp Rational where
type GenExpType Rational = Rational type GenExpType Rational = Rational
expr = return . Lit . Frac expr = return . Expression . Lit . Frac
instance GenExp a => GenExp [a] where instance GenExp a => GenExp [a] where
type GenExpType [a] = [GenExpType a] type GenExpType [a] = [GenExpType a]
expr = ExpM . fmap List . mapM (unExpM . expr) expr = Generate . fmap (Expression . List . map runExpression) . mapM (unGenerate . expr)
instance GenExp x => GenExp (ExpG a -> x) where instance GenExp x => GenExp (ExpG a -> x) where
type GenExpType (ExpG a -> x) = a -> GenExpType x type GenExpType (ExpG a -> x) = a -> GenExpType x
expr f = do expr f = do
pvarName <- newName "pvar_" pvarName <- newName "pvar_"
body <- unsafeCoerceE $ expr $ f $ return $ Var $ UnQual pvarName body <- expr $ f $ return $ Expression $ Var $ UnQual pvarName
return $ Lambda noLoc [PVar pvarName] body return $ Expression $ Lambda noLoc [PVar pvarName] $ runExpression body
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Apply functions -- Apply functions
-- | Apply a function in a haskell expression to a value. -- | Apply a function in a haskell expression to a value.
applyE :: ExpG (a -> b) -> ExpG a -> ExpG b applyE :: ExpG (a -> b) -> ExpG a -> ExpG b
applyE a b = unsafeCoerceE $ liftM (foldl1 App) $ sequence [ce a,ce b] applyE a b = wrap $ liftM (foldl1 App) $ sequence [unwrap a, unwrap b]
where ce = unsafeCoerceE where wrap = fmap Expression
unwrap = fmap runExpression
-- | Operator for 'applyE'. -- | Operator for 'applyE'.
(<>$) :: ExpG (a -> b) -> ExpG a -> ExpG b (<>$) :: ExpG (a -> b) -> ExpG a -> ExpG b
@ -142,28 +145,33 @@ infixl 1 <>$
-- | ApplyE for 2 arguments -- | ApplyE for 2 arguments
applyE2 :: ExpG (a -> b -> c) -> ExpG a -> ExpG b -> ExpG c applyE2 :: ExpG (a -> b -> c) -> ExpG a -> ExpG b -> ExpG c
applyE2 a b c = unsafeCoerceE $ liftM (foldl1 App) $ sequence [ce a,ce b,ce c] applyE2 a b c = wrap $ liftM (foldl1 App) $ sequence [unwrap a,unwrap b,unwrap c]
where ce = unsafeCoerceE where wrap = fmap Expression
unwrap = fmap runExpression
-- | Apply a function to 3 arguments -- | Apply a function to 3 arguments
applyE3 :: ExpG (a -> b -> c -> d) -> ExpG a -> ExpG b -> ExpG c -> ExpG d applyE3 :: ExpG (a -> b -> c -> d) -> ExpG a -> ExpG b -> ExpG c -> ExpG d
applyE3 a b c d = unsafeCoerceE $ liftM (foldl1 App) $ sequence [ce a,ce b,ce c,ce d] applyE3 a b c d = wrap $ liftM (foldl1 App) $ sequence [unwrap a,unwrap b,unwrap c,unwrap d]
where ce = unsafeCoerceE where wrap = fmap Expression
unwrap = fmap runExpression
-- | Apply a function to 4 arguments -- | Apply a function to 4 arguments
applyE4 :: ExpG (a -> b -> c -> d -> e) -> ExpG a -> ExpG b -> ExpG c -> ExpG d -> ExpG e applyE4 :: ExpG (a -> b -> c -> d -> e) -> ExpG a -> ExpG b -> ExpG c -> ExpG d -> ExpG e
applyE4 a b c d e = unsafeCoerceE $ liftM (foldl1 App) $ sequence [ce a,ce b,ce c,ce d,ce e] applyE4 a b c d e = wrap $ liftM (foldl1 App) $ sequence [unwrap a,unwrap b,unwrap c,unwrap d,unwrap e]
where ce = unsafeCoerceE where wrap = fmap Expression
unwrap = fmap runExpression
-- | Apply a function to 5 arguments -- | Apply a function to 5 arguments
applyE5 :: ExpG (a -> b -> c -> d -> e -> f) -> ExpG a -> ExpG b -> ExpG c -> ExpG d -> ExpG e -> ExpG f applyE5 :: ExpG (a -> b -> c -> d -> e -> f) -> ExpG a -> ExpG b -> ExpG c -> ExpG d -> ExpG e -> ExpG f
applyE5 a b c d e f = unsafeCoerceE $ liftM (foldl1 App) $ sequence [ce a,ce b,ce c,ce d,ce e,ce f] applyE5 a b c d e f = wrap $ liftM (foldl1 App) $ sequence [unwrap a,unwrap b,unwrap c,unwrap d,unwrap e,unwrap f]
where ce = unsafeCoerceE where wrap = fmap Expression
unwrap = fmap runExpression
-- | Apply a function to 6 arguments -- | Apply a function to 6 arguments
applyE6 :: ExpG (a -> b -> c -> d -> e -> f -> g) -> ExpG a -> ExpG b -> ExpG c -> ExpG d -> ExpG e -> ExpG f -> ExpG g applyE6 :: ExpG (a -> b -> c -> d -> e -> f -> g) -> ExpG a -> ExpG b -> ExpG c -> ExpG d -> ExpG e -> ExpG f -> ExpG g
applyE6 a b c d e f g = unsafeCoerceE $ liftM (foldl1 App) $ sequence [ce a,ce b,ce c,ce d,ce e,ce f,ce g] applyE6 a b c d e f g = wrap $ liftM (foldl1 App) $ sequence [unwrap a,unwrap b,unwrap c,unwrap d,unwrap e,unwrap f,unwrap g]
where ce = unsafeCoerceE where wrap = fmap Expression
unwrap = fmap runExpression
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Generate modules -- Generate modules
@ -180,7 +188,7 @@ data FunRef t = FunRef Name
instance GenExp (FunRef t) where instance GenExp (FunRef t) where
type GenExpType (FunRef t) = t type GenExpType (FunRef t) = t
expr (FunRef n) = return $ Var $ UnQual n expr (FunRef n) = return $ Expression $ Var $ UnQual n
-- | Generate a ExportSpec for a given function item. -- | Generate a ExportSpec for a given function item.
exportFun :: FunRef t -> ExportSpec exportFun :: FunRef t -> ExportSpec
@ -189,8 +197,8 @@ exportFun (FunRef name) = EVar (UnQual name)
-- | 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. -- | 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.
addDecl :: Name -> ExpG t -> ModuleM (FunRef t) addDecl :: Name -> ExpG t -> ModuleM (FunRef t)
addDecl name e = ModuleM $ do addDecl name e = ModuleM $ do
let (body, mods) = runExpM e let (body, mods) = runGenerate e
tell (mods, [FunBind [Match noLoc name [] Nothing (UnGuardedRhs body) $ BDecls []]]) tell (mods, [FunBind [Match noLoc name [] Nothing (UnGuardedRhs $ runExpression body) $ BDecls []]])
return $ FunRef name return $ FunRef name
-- | Extract the Module from a module generator. -- | Extract the Module from a module generator.

View File

@ -6,7 +6,7 @@
module Language.Haskell.Generate.PreludeDef where module Language.Haskell.Generate.PreludeDef where
import Language.Haskell.Exts.Syntax import Language.Haskell.Exts.Syntax
import Language.Haskell.Generate.Base import Language.Haskell.Generate.Monad
import Language.Haskell.Generate.TH import Language.Haskell.Generate.TH
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -66,22 +66,22 @@ fmap concat $ mapM declareNamedSymbol
(<>.) a b = dot' <>$ a <>$ b (<>.) a b = dot' <>$ a <>$ b
tuple0 :: ExpG () tuple0 :: ExpG ()
tuple0 = return $ Var $ Special UnitCon tuple0 = returnE $ Var $ Special UnitCon
tuple2 :: ExpG (a -> b -> (a,b)) tuple2 :: ExpG (a -> b -> (a,b))
tuple2 = return $ Var $ Special $ TupleCon Boxed 2 tuple2 = returnE $ Var $ Special $ TupleCon Boxed 2
tuple3 :: ExpG (a -> b -> c -> (a,b,c)) tuple3 :: ExpG (a -> b -> c -> (a,b,c))
tuple3 = return $ Var $ Special $ TupleCon Boxed 3 tuple3 = returnE $ Var $ Special $ TupleCon Boxed 3
tuple4 :: ExpG (a -> b -> c -> d -> (a,b,c,d)) tuple4 :: ExpG (a -> b -> c -> d -> (a,b,c,d))
tuple4 = return $ Var $ Special $ TupleCon Boxed 4 tuple4 = returnE $ Var $ Special $ TupleCon Boxed 4
tuple5 :: ExpG (a -> b -> c -> d -> (a,b,c,d,e)) tuple5 :: ExpG (a -> b -> c -> d -> (a,b,c,d,e))
tuple5 = return $ Var $ Special $ TupleCon Boxed 5 tuple5 = returnE $ Var $ Special $ TupleCon Boxed 5
cons :: ExpG (a -> [a] -> [a]) cons :: ExpG (a -> [a] -> [a])
cons = return $ Var $ Special Cons cons = returnE $ Var $ Special Cons
instance Num t => Num (ExpG t) where instance Num t => Num (ExpG t) where
a + b = add' <>$ a <>$ b a + b = add' <>$ a <>$ b
@ -89,6 +89,6 @@ instance Num t => Num (ExpG t) where
a * b = mult' <>$ a <>$ b a * b = mult' <>$ a <>$ b
negate a = negate' <>$ a negate a = negate' <>$ a
abs a = abs' <>$ a abs a = abs' <>$ a
fromInteger a = return $ Lit $ Int a fromInteger a = returnE $ Lit $ Int a
signum a = signum' <>$ a signum a = signum' <>$ a

View File

@ -10,7 +10,7 @@ module Language.Haskell.Generate.TH
import Data.Char import Data.Char
import Language.Haskell.Exts.Syntax hiding (Name) import Language.Haskell.Exts.Syntax hiding (Name)
import Language.Haskell.Generate.Base hiding (Name) import Language.Haskell.Generate.Monad hiding (Name)
import Language.Haskell.TH import Language.Haskell.TH
import Language.Haskell.TH.Syntax import Language.Haskell.TH.Syntax
@ -36,9 +36,13 @@ declareNamedThing (thing, name, thingClass) = do
[| useValue $(lift md) $ $(conE thingClass) $(lift $ nameBase thing) |] [| useValue $(lift md) $ $(conE thingClass) $(lift $ nameBase thing) |]
] ]
where overQuantifiedType f (ForallT bnds ctx t) = ForallT bnds ctx $ overQuantifiedType f t where overQuantifiedType f (ForallT bnds ctx t) = ForallT (map removeKind bnds) ctx $ overQuantifiedType f t
overQuantifiedType f x = f x overQuantifiedType f x = f x
removeKind :: TyVarBndr -> TyVarBndr
removeKind (KindedTV n _) = PlainTV n
removeKind x = x
-- | Declare a symbol, using the given name for the definition. -- | Declare a symbol, using the given name for the definition.
declareNamedSymbol :: (Name, String) -> DecsQ declareNamedSymbol :: (Name, String) -> DecsQ
declareNamedSymbol (func, name) = declareNamedThing (func, name, 'Symbol) declareNamedSymbol (func, name) = declareNamedThing (func, name, 'Symbol)