jmacro-0.1.2: QuasiQuotation library for programmatic generation of Javascript code.Source codeContentsIndex
Language.Javascript.JMacro
Stabilityexperimental
Maintainergershomb@gmail.com
Contents
ADT
Generic traversal (via compos)
Hygienic transformation
Display/Output
Ad-hoc data marshalling
Occasionally helpful combinators
Hash combinators
utility
Description

Simple DSL for lightweight (untyped) programmatic generation of Javascript.

usage:

 renderJs [$jmacro|fun id x -> x|]

The above produces the id function at the top level.

 renderJs [$jmacro|var id = \x -> x|]

So does the above here. However, as id is brought into scope by the keyword var, you do not get a variable named id in the generated javascript, but a variable with an arbitrary unique identifier.

 renderJs [$jmacro|var !id = \x -> x|]

The above, by using the bang special form in a var declaration, produces a variable that really is named id.

 renderJs [$jmacro|function id(x) {return x;}|]

The above is also id.

 renderJs [$jmacro|function !id(x) {return x;}|]

As is the above (with the correct name).

 renderJs [$jmacro|fun id x {return x;}|]

As is the above.

 renderJs [$jmacroE|foo(x,y)|]

The above is an expression representing the application of foo to x and y.

 renderJs [$jmacroE|foo x y|]]

As is the above.

 renderJs [$jmacroE|foo (x,y)|]]

While the above is an error. (i.e. standard javascript function application cannot seperate the leading parenthesis of the argument from the function being applied)

 \x -> [$jmacroE|foo `(x)`|]]

The above is a haskell expression that provides a function that takes an x, and yields an expression representing the application of foo to the value of x as transformed to a Javascript expression.

 [$jmacroE|\x ->`(foo x)`|]]

Meanwhile, the above lambda is in Javascript, and brings the variable into scope both in javascript and in the enclosed antiquotes. The expression is a Javascript function that takes an x, and yields an expression produced by the application of the Haskell function foo as applied to the identifier x (which is of type JExpr -- i.e. a Javascript expression).

Other than that, the language is essentially Javascript (1.5). Note however that one must use semicolons in a principled fashion -- i.e. to end statements consistently. Otherwise, the parser will mistake the whitespace for a whitespace application, and odd things will occur. A further gotcha exists in regex literals, whicch cannot begin with a space. x 5 4 parses as ((x 5) 4). However, x 5 4 will parse as x(5 , 4). Such are the perils of operators used as delimeters in the presence of whitespace application.

Additional datatypes can be marshalled to Javascript by proper instance declarations for the ToJExpr class.

An experimental typechecker is available in the Typed module.

Synopsis
jmacro :: QuasiQuoter
jmacroE :: QuasiQuoter
data JStat
= DeclStat Ident
| ReturnStat JExpr
| IfStat JExpr JStat JStat
| WhileStat JExpr JStat
| ForInStat Bool Ident JExpr JStat
| SwitchStat JExpr [(JExpr, JStat)] JStat
| BlockStat [JStat]
| ApplStat JExpr [JExpr]
| PostStat String JExpr
| AssignStat JExpr JExpr
| UnsatBlock (State [Ident] JStat)
| AntiStat String
| BreakStat
data JExpr
= ValExpr JVal
| SelExpr JExpr Ident
| IdxExpr JExpr JExpr
| InfixExpr String JExpr JExpr
| PostExpr String JExpr
| IfExpr JExpr JExpr JExpr
| NewExpr JExpr
| ApplExpr JExpr [JExpr]
| UnsatExpr (State [Ident] JExpr)
| AntiExpr String
data JVal
= JVar Ident
| JList [JExpr]
| JDouble Double
| JInt Integer
| JStr String
| JRegEx String
| JHash (Map String JExpr)
| JFunc [Ident] JStat
| UnsatVal (State [Ident] JVal)
newtype Ident = StrI String
class JMacro a where
toMC :: a -> MultiComp
fromMC :: MultiComp -> a
data MultiComp
= MStat JStat
| MExpr JExpr
| MVal JVal
| MIdent Ident
class Compos t where
compos :: (forall a. a -> m a) -> (forall a b. m (a -> b) -> m a -> m b) -> (t -> m t) -> t -> m t
composOp :: Compos t => (t -> t) -> t -> t
composOpM :: (Compos t, Monad m) => (t -> m t) -> t -> m t
composOpM_ :: (Compos t, Monad m) => (t -> m ()) -> t -> m ()
composOpFold :: Compos t => b -> (b -> b -> b) -> (t -> b) -> t -> b
withHygiene :: JMacro a => (a -> a) -> a -> a
renderJs :: (JsToDoc a, JMacro a) => a -> Doc
class JsToDoc a where
jsToDoc :: a -> Doc
class ToJExpr a where
toJExpr :: a -> JExpr
toJExprFromList :: [a] -> JExpr
jLam :: ToSat a => a -> JExpr
jVar :: ToSat a => a -> JStat
jFor :: (ToJExpr a, ToStat b) => JStat -> a -> JStat -> b -> JStat
jForIn :: ToSat a => JExpr -> (JExpr -> a) -> JStat
jForEachIn :: ToSat a => JExpr -> (JExpr -> a) -> JStat
expr2stat :: JExpr -> JStat
class ToStat a where
toStat :: a -> JStat
nullStat :: JStat
jhEmpty :: Map String JExpr
jhSingle :: ToJExpr a => String -> a -> Map String JExpr
jhAdd :: ToJExpr a => String -> a -> Map String JExpr -> Map String JExpr
jhFromList :: [(String, JExpr)] -> JVal
jsSaturate :: JMacro a => Maybe String -> a -> a
Documentation
jmacro :: QuasiQuoterSource
QuasiQuoter for a block of JMacro statements.
jmacroE :: QuasiQuoterSource
QuasiQuoter for a JMacro expression.
ADT
data JStat Source
Statements
Constructors
DeclStat Ident
ReturnStat JExpr
IfStat JExpr JStat JStat
WhileStat JExpr JStat
ForInStat Bool Ident JExpr JStat
SwitchStat JExpr [(JExpr, JStat)] JStat
BlockStat [JStat]
ApplStat JExpr [JExpr]
PostStat String JExpr
AssignStat JExpr JExpr
UnsatBlock (State [Ident] JStat)
AntiStat String
BreakStat
show/hide Instances
data JExpr Source
Expressions
Constructors
ValExpr JVal
SelExpr JExpr Ident
IdxExpr JExpr JExpr
InfixExpr String JExpr JExpr
PostExpr String JExpr
IfExpr JExpr JExpr JExpr
NewExpr JExpr
ApplExpr JExpr [JExpr]
UnsatExpr (State [Ident] JExpr)
AntiExpr String
show/hide Instances
data JVal Source
Values
Constructors
JVar Ident
JList [JExpr]
JDouble Double
JInt Integer
JStr String
JRegEx String
JHash (Map String JExpr)
JFunc [Ident] JStat
UnsatVal (State [Ident] JVal)
show/hide Instances
newtype Ident Source
Identifiers
Constructors
StrI String
show/hide Instances
Generic traversal (via compos)
class JMacro a whereSource
Utility class to coerce the ADT into a regular structure.
Methods
toMC :: a -> MultiCompSource
fromMC :: MultiComp -> aSource
show/hide Instances
data MultiComp Source
Union type to allow regular traversal by compos.
Constructors
MStat JStat
MExpr JExpr
MVal JVal
MIdent Ident
show/hide Instances
class Compos t whereSource
Compos and ops for generic traversal as defined over the JMacro ADT.
Methods
compos :: (forall a. a -> m a) -> (forall a b. m (a -> b) -> m a -> m b) -> (t -> m t) -> t -> m tSource
show/hide Instances
composOp :: Compos t => (t -> t) -> t -> tSource
composOpM :: (Compos t, Monad m) => (t -> m t) -> t -> m tSource
composOpM_ :: (Compos t, Monad m) => (t -> m ()) -> t -> m ()Source
composOpFold :: Compos t => b -> (b -> b -> b) -> (t -> b) -> t -> bSource
Hygienic transformation
withHygiene :: JMacro a => (a -> a) -> a -> aSource
Apply a transformation to a fully saturated syntax tree, taking care to return any free variables back to their free state following the transformation. As the transformation preserves free variables, it is hygienic.
Display/Output
renderJs :: (JsToDoc a, JMacro a) => a -> DocSource
Render a syntax tree as a pretty-printable document (simply showing the resultant doc produces a nice, well formatted String).
class JsToDoc a whereSource
Methods
jsToDoc :: a -> DocSource
show/hide Instances
Ad-hoc data marshalling
class ToJExpr a whereSource
Things that can be marshalled into javascript values. Instantiate for any necessary data structures.
Methods
toJExpr :: a -> JExprSource
toJExprFromList :: [a] -> JExprSource
show/hide Instances
Occasionally helpful combinators
jLam :: ToSat a => a -> JExprSource
Create a new anonymous function. The result is an expression. Usage: jLam $ x y -> {JExpr involving x and y}
jVar :: ToSat a => a -> JStatSource
Introduce a new variable into scope for the duration of the enclosed expression. The result is a block statement. Usage: jVar $ x y -> {JExpr involving x and y}
jFor :: (ToJExpr a, ToStat b) => JStat -> a -> JStat -> b -> JStatSource
jForIn :: ToSat a => JExpr -> (JExpr -> a) -> JStatSource
Create a for in statement. Usage: jForIn {expression} $ x -> {block involving x}
jForEachIn :: ToSat a => JExpr -> (JExpr -> a) -> JStatSource
As with jForIn but creating a "for each in" statement.
expr2stat :: JExpr -> JStatSource
class ToStat a whereSource
Methods
toStat :: a -> JStatSource
show/hide Instances
nullStat :: JStatSource
Hash combinators
jhEmpty :: Map String JExprSource
jhSingle :: ToJExpr a => String -> a -> Map String JExprSource
jhAdd :: ToJExpr a => String -> a -> Map String JExpr -> Map String JExprSource
jhFromList :: [(String, JExpr)] -> JValSource
utility
jsSaturate :: JMacro a => Maybe String -> a -> aSource
Given an optional prefix, fills in all free variable names with a supply of names generated by the prefix.
Produced by Haddock version 2.4.2