1-----------------------------------------------------------------------------
2-- |
3-- Module      :  Language.Haskell.Exts.Build
4-- Copyright   :  (c) The GHC Team, 1997-2000,
5--                (c) Niklas Broberg 2004
6-- License     :  BSD-style (see the file LICENSE.txt)
7--
8-- Maintainer  :  Niklas Broberg, d00nibro@chalmers.se
9-- Stability   :  experimental
10-- Portability :  portable
11--
12-- This module contains combinators to use when building
13-- Haskell source trees programmatically, as opposed to
14-- parsing them from a string. The contents here are quite
15-- experimental and will likely receive a lot of attention
16-- when the rest has stabilised.
17--
18-----------------------------------------------------------------------------
19
20module Language.Haskell.Exts.Build (
21
22    -- * Syntax building functions
23    name,       -- :: String -> Name ()
24    sym,        -- :: String -> Name ()
25    var,        -- :: Name () -> Exp ()
26    op,         -- :: Name () -> QOp
27    qvar,       -- :: Module -> Name () -> Exp ()
28    pvar,       -- :: Name () -> Pat ()
29    app,        -- :: Exp () -> Exp () -> Exp ()
30    infixApp,   -- :: Exp () -> QOp -> Exp () -> Exp ()
31    appFun,     -- :: Exp () -> [Exp] -> Exp ()
32    pApp,       -- :: Name () -> [Pat] -> Pat ()
33    tuple,      -- :: [Exp] -> Exp ()
34    pTuple,     -- :: [Pat] -> Pat ()
35    varTuple,   -- :: [Name] -> Exp ()
36    pvarTuple,  -- :: [Name] -> Pat ()
37    function,   -- :: String -> Exp ()
38    strE,       -- :: String -> Exp ()
39    charE,      -- :: Char -> Exp ()
40    intE,       -- :: Integer -> Exp ()
41    strP,       -- :: String -> Pat ()
42    charP,      -- :: Char -> Pat ()
43    intP,       -- :: Integer -> Pat ()
44    doE,        -- :: [Stmt] -> Exp ()
45    lamE,       -- :: SrcLoc -> [Pat] -> Exp () -> Exp ()
46    letE,       -- :: [Decl] -> Exp () -> Exp ()
47    caseE,      -- :: Exp () -> [Alt] -> Exp ()
48    alt,        -- :: SrcLoc -> Pat () -> Exp () -> Alt
49    altGW,      -- :: SrcLoc -> Pat () -> [Stmt] -> Exp () -> Binds -> Alt
50    listE,      -- :: [Exp] -> Exp ()
51    eList,      -- :: Exp ()
52    peList,     -- :: Pat ()
53    paren,      -- :: Exp () -> Exp ()
54    pParen,     -- :: Pat () -> Pat ()
55    qualStmt,   -- :: Exp () -> Stmt
56    genStmt,    -- :: SrcLoc -> Pat () -> Exp () -> Stmt
57    letStmt,    -- :: [Decl] -> Stmt
58    binds,      -- :: [Decl] -> Binds
59    noBinds,    -- :: Binds
60    wildcard,   -- :: Pat ()
61    genNames,   -- :: String -> Int -> [Name]
62
63    -- * More advanced building
64    sfun,           -- :: SrcLoc -> Name () -> [Name] -> Rhs -> Binds -> Decl ()
65    simpleFun,      -- :: SrcLoc -> Name () -> Name () -> Exp () -> Decl ()
66    patBind,        -- :: SrcLoc -> Pat () -> Exp () -> Decl ()
67    patBindWhere,   -- :: SrcLoc -> Pat () -> Exp () -> [Decl] -> Decl ()
68    nameBind,       -- :: SrcLoc -> Name () -> Exp () -> Decl ()
69    metaFunction,   -- :: String -> [Exp] -> Exp ()
70    metaConPat      -- :: String -> [Pat] -> Pat ()
71  ) where
72
73import Language.Haskell.Exts.Syntax
74
75-----------------------------------------------------------------------------
76-- Help functions for Abstract syntax
77
78-- | An identifier with the given string as its name.
79--   The string should be a valid Haskell identifier.
80name :: String -> Name ()
81name = Ident ()
82
83-- | A symbol identifier. The string should be a valid
84--   Haskell symbol identifier.
85sym :: String -> Name ()
86sym = Symbol ()
87
88-- | A local variable as expression.
89var :: Name () -> Exp ()
90var = Var () . UnQual ()
91
92-- | Use the given identifier as an operator.
93op :: Name () -> QOp ()
94op = QVarOp () . UnQual ()
95
96-- | A qualified variable as expression.
97qvar :: ModuleName () -> Name () -> Exp ()
98qvar m n = Var () $ Qual () m n
99
100-- | A pattern variable.
101pvar :: Name () -> Pat ()
102pvar = PVar ()
103
104-- | Application of expressions by juxtaposition.
105app :: Exp () -> Exp () -> Exp ()
106app = App ()
107
108-- | Apply an operator infix.
109infixApp :: Exp () -> QOp () -> Exp () -> Exp ()
110infixApp = InfixApp ()
111
112-- | Apply a function to a list of arguments.
113appFun :: Exp () -> [Exp ()] -> Exp ()
114appFun f [] = f
115appFun f (a:as) = appFun (app f a) as
116
117-- | A constructor pattern, with argument patterns.
118pApp :: Name () -> [Pat ()] -> Pat ()
119pApp n ps = PApp () (UnQual () n) ps
120
121-- | A tuple expression.
122tuple :: [Exp ()] -> Exp ()
123tuple = Tuple () Boxed
124
125-- | A tuple pattern.
126pTuple :: [Pat ()] -> Pat ()
127pTuple = PTuple () Boxed
128
129-- | A tuple expression consisting of variables only.
130varTuple :: [Name ()] -> Exp ()
131varTuple ns = tuple $ map var ns
132
133-- | A tuple pattern consisting of variables only.
134pvarTuple :: [Name ()] -> Pat ()
135pvarTuple ns = pTuple $ map pvar ns
136
137-- | A function with a given name.
138function :: String -> Exp ()
139function = var . Ident ()
140
141-- | A literal string expression.
142strE :: String -> Exp ()
143strE s = Lit () (String () s s)
144
145-- | A literal character expression.
146charE :: Char -> Exp ()
147charE c = Lit () (Char () c [c])
148
149-- | A literal integer expression.
150intE :: Integer -> Exp ()
151intE n = Lit () (Int () n (show n))
152
153-- | A literal string pattern.
154strP :: String -> Pat ()
155strP s = PLit () (Signless ()) (String () s s)
156
157-- | A literal character pattern.
158charP :: Char -> Pat ()
159charP x = PLit () (Signless ()) (Char () x [x])
160
161-- | A literal integer pattern.
162intP :: Integer -> Pat ()
163intP x = PLit ()
164          (if x >= 0 then Signless () else Negative ())
165          (Int () (abs x) (show x))
166
167-- | A do block formed by the given statements.
168--   The last statement in the list should be
169--   a 'Qualifier' expression.
170doE :: [Stmt ()] -> Exp ()
171doE = Do ()
172
173-- | Lambda abstraction, given a list of argument
174--   patterns and an expression body.
175lamE :: [Pat ()] -> Exp () -> Exp ()
176lamE = Lambda ()
177
178-- | A @let@ ... @in@ block.
179letE :: [Decl ()] -> Exp () -> Exp ()
180letE ds e = Let () (binds ds) e
181
182-- | A @case@ expression.
183caseE :: Exp () -> [Alt ()] -> Exp ()
184caseE = Case ()
185
186-- | An unguarded alternative in a @case@ expression.
187alt :: Pat () -> Exp () -> Alt ()
188alt p e = Alt () p (unGAlt e) noBinds
189
190-- | An alternative with a single guard in a @case@ expression.
191altGW :: Pat () -> [Stmt ()] -> Exp () -> Binds () -> Alt ()
192altGW p gs e w = Alt () p (gAlt gs e) (Just w)
193
194-- | An unguarded righthand side of a @case@ alternative.
195unGAlt :: Exp () -> Rhs ()
196unGAlt = UnGuardedRhs ()
197
198-- | An list of guarded righthand sides for a @case@ alternative.
199gAlts :: [([Stmt ()],Exp ())] -> Rhs ()
200gAlts as = GuardedRhss () $ map (\(gs,e) -> GuardedRhs () gs e) as
201
202-- | A single guarded righthand side for a @case@ alternative.
203gAlt :: [Stmt ()] -> Exp () -> Rhs ()
204gAlt gs e = gAlts [(gs,e)]
205
206-- | A list expression.
207listE :: [Exp ()] -> Exp ()
208listE = List ()
209
210-- | The empty list expression.
211eList :: Exp ()
212eList = List () []
213
214-- | The empty list pattern.
215peList :: Pat ()
216peList = PList () []
217
218-- | Put parentheses around an expression.
219paren :: Exp () -> Exp ()
220paren = Paren ()
221
222-- | Put parentheses around a pattern.
223pParen :: Pat () -> Pat ()
224pParen = PParen ()
225
226-- | A qualifier expression statement.
227qualStmt :: Exp () -> Stmt ()
228qualStmt = Qualifier ()
229
230-- | A generator statement: /pat/ @<-@ /exp/
231genStmt :: Pat () -> Exp () -> Stmt ()
232genStmt = Generator ()
233
234-- | A @let@ binding group as a statement.
235letStmt :: [Decl ()] -> Stmt ()
236letStmt ds = LetStmt () $ binds ds
237
238-- | Hoist a set of declarations to a binding group.
239binds :: [Decl ()] -> Binds ()
240binds = BDecls ()
241
242-- | An empty binding group.
243noBinds :: Maybe (Binds ())
244noBinds = Nothing
245
246-- | The wildcard pattern: @_@
247wildcard :: Pat ()
248wildcard = PWildCard ()
249
250-- | Generate k names by appending numbers 1 through k to a given string.
251genNames :: String -> Int -> [Name ()]
252genNames s k = [ Ident () $ s ++ show i | i <- [1..k] ]
253
254-------------------------------------------------------------------------------
255-- Some more specialised help functions
256
257-- | A function with a single clause
258sfun :: Name () -> [Name ()] -> (Rhs ()) -> Maybe (Binds ()) -> Decl ()
259sfun f pvs rhs bs = FunBind () [Match () f (map pvar pvs) rhs bs]
260
261-- | A function with a single clause, a single argument, no guards
262-- and no where declarations
263simpleFun :: Name () -> Name () -> Exp () -> Decl ()
264simpleFun f a e = let rhs = UnGuardedRhs () e
265             in sfun f [a] rhs noBinds
266
267-- | A pattern bind where the pattern is a variable, and where
268-- there are no guards and no 'where' clause.
269patBind :: Pat () -> Exp () -> Decl ()
270patBind p e = let rhs = UnGuardedRhs () e
271         in PatBind () p rhs noBinds
272
273-- | A pattern bind where the pattern is a variable, and where
274-- there are no guards, but with a 'where' clause.
275patBindWhere :: Pat () -> Exp () -> [Decl ()] -> Decl ()
276patBindWhere p e ds = let rhs = UnGuardedRhs () e
277             in PatBind () p rhs (if null ds then Nothing else Just (binds ds))
278
279-- | Bind an identifier to an expression.
280nameBind :: Name () -> Exp () -> Decl ()
281nameBind n e = patBind (pvar n) e
282
283-- | Apply function of a given name to a list of arguments.
284metaFunction :: String -> [Exp ()] -> Exp ()
285metaFunction s' es' = mf s' (reverse es')
286  where mf s []     = var $ name s
287        mf s (e:es) = app (mf s es) e
288
289-- | Apply a constructor of a given name to a list of pattern
290--   arguments, forming a constructor pattern.
291metaConPat :: String -> [Pat ()] -> Pat ()
292metaConPat s ps = pApp (name s) ps
293