jmacro-0.6.14: QuasiQuotation library for programmatic generation of Javascript code.

Copyright(c) Gershom Bazerman 2010
LicenseBSD 3 Clause
Maintainergershomb@gmail.com
Stabilityexperimental
Safe HaskellNone
LanguageHaskell98

Language.Javascript.JMacro

Contents

Description

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

A number of examples are available in the source of Language.Javascript.JMacro.Prelude.

Functions to generate generic RPC wrappers (using json serialization) are available in Language.Javascript.JMacro.Rpc.

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 features in jmacro (documented on the wiki) include an infix application operator, and an enhanced destructuring bind.

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

An experimental typechecker is available in the Language.Javascript.JMacro.Typed module.

Synopsis

Documentation

jmacro :: QuasiQuoter #

QuasiQuoter for a block of JMacro statements.

jmacroE :: QuasiQuoter #

QuasiQuoter for a JMacro expression.

ADT

data JStat #

Statements

Instances

Eq JStat # 

Methods

(==) :: JStat -> JStat -> Bool #

(/=) :: JStat -> JStat -> Bool #

Data JStat # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> JStat -> c JStat #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c JStat #

toConstr :: JStat -> Constr #

dataTypeOf :: JStat -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c JStat) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JStat) #

gmapT :: (forall b. Data b => b -> b) -> JStat -> JStat #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JStat -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JStat -> r #

gmapQ :: (forall d. Data d => d -> u) -> JStat -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> JStat -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> JStat -> m JStat #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> JStat -> m JStat #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> JStat -> m JStat #

Ord JStat # 

Methods

compare :: JStat -> JStat -> Ordering #

(<) :: JStat -> JStat -> Bool #

(<=) :: JStat -> JStat -> Bool #

(>) :: JStat -> JStat -> Bool #

(>=) :: JStat -> JStat -> Bool #

max :: JStat -> JStat -> JStat #

min :: JStat -> JStat -> JStat #

Show JStat # 

Methods

showsPrec :: Int -> JStat -> ShowS #

show :: JStat -> String #

showList :: [JStat] -> ShowS #

Monoid JStat # 

Methods

mempty :: JStat #

mappend :: JStat -> JStat -> JStat #

mconcat :: [JStat] -> JStat #

ToStat JStat # 

Methods

toStat :: JStat -> JStat #

JsToDoc JStat # 

Methods

jsToDoc :: JStat -> Doc #

JMacro JStat # 
JTypeCheck JStat # 
ToStat [JStat] # 

Methods

toStat :: [JStat] -> JStat #

JsToDoc [JStat] # 

Methods

jsToDoc :: [JStat] -> Doc #

data JExpr #

Expressions

Instances

Eq JExpr # 

Methods

(==) :: JExpr -> JExpr -> Bool #

(/=) :: JExpr -> JExpr -> Bool #

Data JExpr # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> JExpr -> c JExpr #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c JExpr #

toConstr :: JExpr -> Constr #

dataTypeOf :: JExpr -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c JExpr) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JExpr) #

gmapT :: (forall b. Data b => b -> b) -> JExpr -> JExpr #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JExpr -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JExpr -> r #

gmapQ :: (forall d. Data d => d -> u) -> JExpr -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> JExpr -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> JExpr -> m JExpr #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> JExpr -> m JExpr #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> JExpr -> m JExpr #

Num JExpr # 
Ord JExpr # 

Methods

compare :: JExpr -> JExpr -> Ordering #

(<) :: JExpr -> JExpr -> Bool #

(<=) :: JExpr -> JExpr -> Bool #

(>) :: JExpr -> JExpr -> Bool #

(>=) :: JExpr -> JExpr -> Bool #

max :: JExpr -> JExpr -> JExpr #

min :: JExpr -> JExpr -> JExpr #

Show JExpr # 

Methods

showsPrec :: Int -> JExpr -> ShowS #

show :: JExpr -> String #

showList :: [JExpr] -> ShowS #

ToStat JExpr # 

Methods

toStat :: JExpr -> JStat #

ToJExpr JExpr # 
JsToDoc JExpr # 

Methods

jsToDoc :: JExpr -> Doc #

JMacro JExpr # 
JTypeCheck JExpr # 
ToStat [JExpr] # 

Methods

toStat :: [JExpr] -> JStat #

JsToDoc [JExpr] # 

Methods

jsToDoc :: [JExpr] -> Doc #

data JVal #

Values

Instances

Eq JVal # 

Methods

(==) :: JVal -> JVal -> Bool #

(/=) :: JVal -> JVal -> Bool #

Data JVal # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> JVal -> c JVal #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c JVal #

toConstr :: JVal -> Constr #

dataTypeOf :: JVal -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c JVal) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JVal) #

gmapT :: (forall b. Data b => b -> b) -> JVal -> JVal #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JVal -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JVal -> r #

gmapQ :: (forall d. Data d => d -> u) -> JVal -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> JVal -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> JVal -> m JVal #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> JVal -> m JVal #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> JVal -> m JVal #

Ord JVal # 

Methods

compare :: JVal -> JVal -> Ordering #

(<) :: JVal -> JVal -> Bool #

(<=) :: JVal -> JVal -> Bool #

(>) :: JVal -> JVal -> Bool #

(>=) :: JVal -> JVal -> Bool #

max :: JVal -> JVal -> JVal #

min :: JVal -> JVal -> JVal #

Show JVal # 

Methods

showsPrec :: Int -> JVal -> ShowS #

show :: JVal -> String #

showList :: [JVal] -> ShowS #

ToJExpr JVal # 
JsToDoc JVal # 

Methods

jsToDoc :: JVal -> Doc #

JMacro JVal # 
JTypeCheck JVal # 

Methods

typecheck :: JVal -> TMonad JType #

newtype Ident #

Identifiers

Constructors

StrI String 

Instances

Eq Ident # 

Methods

(==) :: Ident -> Ident -> Bool #

(/=) :: Ident -> Ident -> Bool #

Data Ident # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Ident -> c Ident #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Ident #

toConstr :: Ident -> Constr #

dataTypeOf :: Ident -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c Ident) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ident) #

gmapT :: (forall b. Data b => b -> b) -> Ident -> Ident #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ident -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Ident -> r #

gmapQ :: (forall d. Data d => d -> u) -> Ident -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Ident -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Ident -> m Ident #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Ident -> m Ident #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Ident -> m Ident #

Ord Ident # 

Methods

compare :: Ident -> Ident -> Ordering #

(<) :: Ident -> Ident -> Bool #

(<=) :: Ident -> Ident -> Bool #

(>) :: Ident -> Ident -> Bool #

(>=) :: Ident -> Ident -> Bool #

max :: Ident -> Ident -> Ident #

min :: Ident -> Ident -> Ident #

Show Ident # 

Methods

showsPrec :: Int -> Ident -> ShowS #

show :: Ident -> String #

showList :: [Ident] -> ShowS #

JsToDoc Ident # 

Methods

jsToDoc :: Ident -> Doc #

JMacro Ident # 

newtype IdentSupply a #

Constructors

IS 

Fields

Instances

Functor IdentSupply # 

Methods

fmap :: (a -> b) -> IdentSupply a -> IdentSupply b #

(<$) :: a -> IdentSupply b -> IdentSupply a #

Eq a => Eq (IdentSupply a) # 
Data a => Data (IdentSupply a) # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> IdentSupply a -> c (IdentSupply a) #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (IdentSupply a) #

toConstr :: IdentSupply a -> Constr #

dataTypeOf :: IdentSupply a -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c (IdentSupply a)) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (IdentSupply a)) #

gmapT :: (forall b. Data b => b -> b) -> IdentSupply a -> IdentSupply a #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IdentSupply a -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IdentSupply a -> r #

gmapQ :: (forall d. Data d => d -> u) -> IdentSupply a -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> IdentSupply a -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> IdentSupply a -> m (IdentSupply a) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> IdentSupply a -> m (IdentSupply a) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> IdentSupply a -> m (IdentSupply a) #

Ord a => Ord (IdentSupply a) # 
Show a => Show (IdentSupply a) # 

Generic traversal (via compos)

class JMacro a where #

Compos and ops for generic traversal as defined over the JMacro ADT.

Utility class to coerce the ADT into a regular structure.

Minimal complete definition

jtoGADT, jfromGADT

Methods

jtoGADT :: a -> JMGadt a #

jfromGADT :: JMGadt a -> a #

data JMGadt a where #

Union type to allow regular traversal by compos.

Instances

Compos JMGadt # 

Methods

compos :: (forall a. a -> m a) -> (forall a b. m (a -> b) -> m a -> m b) -> (forall a. JMGadt a -> m (JMGadt a)) -> JMGadt c -> m (JMGadt c) #

class Compos t where #

Minimal complete definition

compos

Methods

compos :: (forall a. a -> m a) -> (forall a b. m (a -> b) -> m a -> m b) -> (forall a. t a -> m (t a)) -> t c -> m (t c) #

Instances

Compos JMGadt # 

Methods

compos :: (forall a. a -> m a) -> (forall a b. m (a -> b) -> m a -> m b) -> (forall a. JMGadt a -> m (JMGadt a)) -> JMGadt c -> m (JMGadt c) #

composOp :: Compos t => (forall a. t a -> t a) -> t b -> t b #

composOpM :: (Compos t, Monad m) => (forall a. t a -> m (t a)) -> t b -> m (t b) #

composOpM_ :: (Compos t, Monad m) => (forall a. t a -> m ()) -> t b -> m () #

composOpFold :: Compos t => b -> (b -> b -> b) -> (forall a. t a -> b) -> t c -> b #

Hygienic transformation

withHygiene :: JMacro a => (a -> a) -> a -> a #

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.

scopify :: JStat -> JStat #

Takes a fully saturated expression and transforms it to use unique variables that respect scope.

Display/Output

renderJs :: (JsToDoc a, JMacro a) => a -> Doc #

Render a syntax tree as a pretty-printable document (simply showing the resultant doc produces a nice, well formatted String).

renderPrefixJs :: (JsToDoc a, JMacro a) => String -> a -> Doc #

Render a syntax tree as a pretty-printable document, using a given prefix to all generated names. Use this with distinct prefixes to ensure distinct generated names between independent calls to render(Prefix)Js.

class JsToDoc a where #

Minimal complete definition

jsToDoc

Methods

jsToDoc :: a -> Doc #

Instances

JsToDoc JLocalType # 

Methods

jsToDoc :: JLocalType -> Doc #

JsToDoc JType # 

Methods

jsToDoc :: JType -> Doc #

JsToDoc Ident # 

Methods

jsToDoc :: Ident -> Doc #

JsToDoc JVal # 

Methods

jsToDoc :: JVal -> Doc #

JsToDoc JExpr # 

Methods

jsToDoc :: JExpr -> Doc #

JsToDoc JStat # 

Methods

jsToDoc :: JStat -> Doc #

JsToDoc [JExpr] # 

Methods

jsToDoc :: [JExpr] -> Doc #

JsToDoc [JStat] # 

Methods

jsToDoc :: [JStat] -> Doc #

Ad-hoc data marshalling

class ToJExpr a where #

Things that can be marshalled into javascript values. Instantiate for any necessary data structures.

Minimal complete definition

toJExpr

Methods

toJExpr :: a -> JExpr #

toJExprFromList :: [a] -> JExpr #

Instances

ToJExpr Bool # 
ToJExpr Char # 
ToJExpr Double # 
ToJExpr Int # 

Methods

toJExpr :: Int -> JExpr #

toJExprFromList :: [Int] -> JExpr #

ToJExpr Integer # 
ToJExpr () # 

Methods

toJExpr :: () -> JExpr #

toJExprFromList :: [()] -> JExpr #

ToJExpr Text # 
ToJExpr Value # 
ToJExpr Text # 
ToJExpr JVal # 
ToJExpr JExpr # 
ToJExpr a => ToJExpr [a] # 

Methods

toJExpr :: [a] -> JExpr #

toJExprFromList :: [[a]] -> JExpr #

(ToJExpr a, ToJExpr b) => ToJExpr (a, b) # 

Methods

toJExpr :: (a, b) -> JExpr #

toJExprFromList :: [(a, b)] -> JExpr #

ToJExpr a => ToJExpr (Map String a) # 
(ToJExpr a, ToJExpr b, ToJExpr c) => ToJExpr (a, b, c) # 

Methods

toJExpr :: (a, b, c) -> JExpr #

toJExprFromList :: [(a, b, c)] -> JExpr #

(ToJExpr a, ToJExpr b, ToJExpr c, ToJExpr d) => ToJExpr (a, b, c, d) # 

Methods

toJExpr :: (a, b, c, d) -> JExpr #

toJExprFromList :: [(a, b, c, d)] -> JExpr #

(ToJExpr a, ToJExpr b, ToJExpr c, ToJExpr d, ToJExpr e) => ToJExpr (a, b, c, d, e) # 

Methods

toJExpr :: (a, b, c, d, e) -> JExpr #

toJExprFromList :: [(a, b, c, d, e)] -> JExpr #

(ToJExpr a, ToJExpr b, ToJExpr c, ToJExpr d, ToJExpr e, ToJExpr f) => ToJExpr (a, b, c, d, e, f) # 

Methods

toJExpr :: (a, b, c, d, e, f) -> JExpr #

toJExprFromList :: [(a, b, c, d, e, f)] -> JExpr #

Literals

Occasionally helpful combinators

jLam :: ToSat a => a -> JExpr #

Create a new anonymous function. The result is an expression. Usage: jLam $ x y -> {JExpr involving x and y}

jVar :: ToSat a => a -> JStat #

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}

jVarTy :: ToSat a => a -> Maybe JLocalType -> JStat #

Introduce a new variable with optional type 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 -> JStat #

jForIn :: ToSat a => JExpr -> (JExpr -> a) -> JStat #

Create a for in statement. Usage: jForIn {expression} $ x -> {block involving x}

jForEachIn :: ToSat a => JExpr -> (JExpr -> a) -> JStat #

As with "jForIn" but creating a "for each in" statement.

jTryCatchFinally :: ToSat a => JStat -> a -> JStat -> JStat #

class ToStat a where #

Minimal complete definition

toStat

Methods

toStat :: a -> JStat #

Instances

ToStat JExpr # 

Methods

toStat :: JExpr -> JStat #

ToStat JStat # 

Methods

toStat :: JStat -> JStat #

ToStat [JExpr] # 

Methods

toStat :: [JExpr] -> JStat #

ToStat [JStat] # 

Methods

toStat :: [JStat] -> JStat #

Hash combinators

Utility

jsSaturate :: JMacro a => Maybe String -> a -> a #

Given an optional prefix, fills in all free variable names with a supply of names generated by the prefix.

newtype SaneDouble #

Constructors

SaneDouble Double 

Instances

Eq SaneDouble # 
Fractional SaneDouble # 
Data SaneDouble # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> SaneDouble -> c SaneDouble #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c SaneDouble #

toConstr :: SaneDouble -> Constr #

dataTypeOf :: SaneDouble -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c SaneDouble) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SaneDouble) #

gmapT :: (forall b. Data b => b -> b) -> SaneDouble -> SaneDouble #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SaneDouble -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SaneDouble -> r #

gmapQ :: (forall d. Data d => d -> u) -> SaneDouble -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> SaneDouble -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> SaneDouble -> m SaneDouble #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> SaneDouble -> m SaneDouble #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> SaneDouble -> m SaneDouble #

Num SaneDouble # 
Ord SaneDouble # 
Show SaneDouble #