jmacro 0.5.1 → 0.5.2

raw patch · 5 files changed

+112/−56 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Language/Javascript/JMacro.hs +4/−0
• Language/Javascript/JMacro/Base.hs +13/−8
• Language/Javascript/JMacro/QQ.hs +91/−44
• Language/Javascript/JMacro/TypeCheck.hs +2/−2
• jmacro.cabal +2/−2

@@ -60,6 +60,8 @@  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.@@ -73,7 +75,9 @@   module Language.Javascript.JMacro.Types  ) where +{- import Prelude hiding (tail, init, head, last, minimum, maximum, foldr1, foldl1, (!!), read)+-}  import Language.Javascript.JMacro.Base hiding (expr2stat) import Language.Javascript.JMacro.QQ

@@ -109,7 +109,7 @@            | TryStat    JStat Ident JStat JStat            | BlockStat  [JStat]            | ApplStat   JExpr [JExpr]-           | PostStat   String JExpr+           | PPostStat  Bool String JExpr            | AssignStat JExpr JExpr            | UnsatBlock (IdentSupply JStat)            | AntiStat   String@@ -132,7 +132,7 @@            | SelExpr    JExpr Ident            | IdxExpr    JExpr JExpr            | InfixExpr  String JExpr JExpr-           | PostExpr   String JExpr+           | PPostExpr  Bool String JExpr            | IfExpr     JExpr JExpr JExpr            | NewExpr    JExpr            | ApplExpr   JExpr [JExpr]@@ -167,7 +167,7 @@ expr2stat :: JExpr -> JStat expr2stat (ApplExpr x y) = (ApplStat x y) expr2stat (IfExpr x y z) = IfStat x (expr2stat y) (expr2stat z)-expr2stat (PostExpr s x) = PostStat s x+expr2stat (PPostExpr b s x) = PPostStat b s x expr2stat (AntiExpr x) = AntiStat x expr2stat _ = nullStat @@ -245,7 +245,7 @@            BlockStat xs -> ret BlockStat `app` mapM' f xs            ApplStat  e xs -> ret ApplStat `app` f e `app` mapM' f xs            TryStat s i s1 s2 -> ret TryStat `app` f s `app` f i `app` f s1 `app` f s2-           PostStat o e -> ret (PostStat o) `app` f e+           PPostStat b o e -> ret (PPostStat b o) `app` f e            AssignStat e e' -> ret AssignStat `app` f e `app` f e'            UnsatBlock _ -> ret v'            AntiStat _ -> ret v'@@ -256,7 +256,7 @@            SelExpr e e' -> ret SelExpr `app` f e `app` f e'            IdxExpr e e' -> ret IdxExpr `app` f e `app` f e'            InfixExpr o e e' -> ret (InfixExpr o) `app` f e `app` f e'-           PostExpr o e -> ret (PostExpr o) `app` f e+           PPostExpr b o e -> ret (PPostExpr b o) `app` f e            IfExpr e e' e'' -> ret IfExpr `app` f e `app` f e' `app` f e''            NewExpr e -> ret NewExpr `app` f e            ApplExpr e xs -> ret ApplExpr `app` f e `app` mapM' f xs@@ -469,7 +469,9 @@               mbFinally | s2 == BlockStat [] = PP.empty                         | otherwise = text "finally" $$ braceNest' (jsToDoc s2)     jsToDoc (AssignStat i x) = jsToDoc i <+> char '=' <+> jsToDoc x-    jsToDoc (PostStat op x) = jsToDoc x <> text op+    jsToDoc (PPostStat isPre op x)+        | isPre = text op <> jsToDoc x+        | otherwise = jsToDoc x <> text op     jsToDoc (AntiStat s) = text $ "`(" ++ s ++ ")`"     jsToDoc (ForeignStat i t) = text "//foriegn" <+> jsToDoc i <+> text "::" <+> jsToDoc t     jsToDoc (BlockStat xs) = jsToDoc (flattenBlocks xs)@@ -486,7 +488,10 @@         where op' | op == "++" = "+"                   | otherwise = op -    jsToDoc (PostExpr op x) = jsToDoc x <> text op+    jsToDoc (PPostExpr isPre op x)+        | isPre = text op <> jsToDoc x+        | otherwise = jsToDoc x <> text op+     jsToDoc (ApplExpr je xs) = jsToDoc je <> (parens . fsep . punctuate comma $ map jsToDoc xs)     jsToDoc (NewExpr e) = text "new" <+> jsToDoc e     jsToDoc (AntiExpr s) = text $ "`(" ++ s ++ ")`"@@ -680,7 +685,7 @@ -- | Create a for in statement. -- Usage: -- @jForIn {expression} $ \x -> {block involving x}@-jForIn :: ToSat a => JExpr -> (JExpr -> a) -> JStat+jForIn :: ToSat a => JExpr -> (JExpr -> a)  -> JStat jForIn e f = UnsatBlock . IS $ do                (block, is) <- runIdentSupply $ toSat_ f []                return $ ForInStat False (headNote "jForIn" is) e block

@@ -15,17 +15,20 @@ module Language.Javascript.JMacro.QQ(jmacro,jmacroE,parseJM) where import Prelude hiding (tail, init, head, last, minimum, maximum, foldr1, foldl1, (!!), read) import Control.Applicative hiding ((<|>),many,optional,(<*))+import Control.Arrow(first) import Control.Monad.State.Strict import qualified Data.ByteString.Char8 as BS import Data.Char(digitToInt, toLower, isUpper) import Data.List(isPrefixOf, sort) import Data.Generics(extQ,Data)+import Data.Maybe(fromMaybe)+import Data.Monoid import qualified Data.Map as M  --import Language.Haskell.Meta.Parse import qualified Language.Haskell.TH as TH import Language.Haskell.TH(mkName)-import qualified Language.Haskell.TH.Lib as TH+--import qualified Language.Haskell.TH.Lib as TH import Language.Haskell.TH.Quote  import Text.ParserCombinators.Parsec@@ -42,7 +45,7 @@  import Web.Encodings -import Debug.Trace+--import Debug.Trace  {--------------------------------------------------------------------   QuasiQuotation@@ -100,7 +103,7 @@ antiIdents :: JMacro a => [String] -> a -> a antiIdents ss x = foldr antiIdent x ss -+fixIdent :: String -> String fixIdent css@(c:_)     | isUpper c = '_' : escapeDollar css     | otherwise = escapeDollar css@@ -228,7 +231,7 @@ jsLang :: P.LanguageDef () jsLang = javaStyle {            P.reservedNames = ["var","return","if","else","while","for","in","break","new","function","switch","case","default","fun","try","catch","finally","foreign"],-           P.reservedOpNames = ["|>","<|","+=","-=","*=","/=","%=","--","*","/","+","-",".","%","?","=","==","!=","<",">","&&","||","++","===",">=","<=","->","::","::!"],+           P.reservedOpNames = ["|>","<|","+=","-=","*=","/=","%=","--","*","/","+","-",".","%","?","=","==","!=","<",">","&&","||","++","===",">=","<=","->","::","::!",":|","@"],            P.identLetter = alphaNum <|> oneOf "_$",            P.identStart  = letter <|> oneOf "_$",            P.commentLine = "//",@@ -257,7 +260,7 @@ (<*) :: Monad m => m b -> m a -> m b x <* y = do   xr <- x-  y+  _ <- y   return xr  parseJM :: String -> Either ParseError JStat@@ -274,20 +277,13 @@             eof             return ans -{--ident :: JMParser Ident-ident = do-  i <- identifier-  when ("jmId_" `isPrefixOf` i) $ fail "Illegal use of reserved jmId_ prefix in variable name."-  return (StrI i)--}--+getType :: JMParser (Bool, JLocalType) getType = do   isForce <- (reservedOp "::!" >> return True) <|> (reservedOp "::" >> return False)   t <- runTypeParser   return (isForce, t) +addForcedType :: Maybe (Bool, JLocalType) -> JExpr -> JExpr addForcedType (Just (True,t)) e = TypeExpr True e t addForcedType _ e = e @@ -308,18 +304,65 @@   when (i=="this") $ fail "Illegal attempt to name variable 'this'."   return (StrI i) ---varidentdecls can take types!-identAssignDecl :: JMParser [JStat]-identAssignDecl = do-  (i,mbTyp) <- varidentdecl-  optAssignStat <- optionMaybe $ do-                    reservedOp "="-                    e <- expr-                    return $ AssignStat (ValExpr (JVar (clean i))) (addForcedType mbTyp e)-  return $ DeclStat i (fmap snd mbTyp) : maybe [] (:[]) optAssignStat-    where clean (StrI ('!':x)) = StrI x-          clean x = x+cleanIdent :: Ident -> Ident+cleanIdent (StrI ('!':x)) = StrI x+cleanIdent x = x +-- Handle varident decls for type annotations?+-- Patterns+data PatternTree = PTAs Ident PatternTree+                 | PTCons PatternTree PatternTree+                 | PTList [PatternTree]+                 | PTObj [(String,PatternTree)]+                 | PTVar Ident+                   deriving Show+patternTree :: JMParser PatternTree+patternTree = toCons <$> (parens patternTree <|> ptList <|> ptObj <|> varOrAs) `sepBy1` reservedOp ":|"+    where+      toCons [] = PTVar (StrI "_")+      toCons [x] = x+      toCons (x:xs) = PTCons x (toCons xs)+      ptList  = lexeme $ PTList <$> brackets' (commaSep patternTree)+      ptObj   = lexeme $ PTObj  <$> oxfordBraces (commaSep $ liftM2 (,) myIdent (colon >> patternTree))+      varOrAs = do+        i <- fst <$> varidentdecl+        isAs <- option False (reservedOp "@" >> return True)+        if isAs+          then PTAs i <$> patternTree+          else return $ PTVar i++--either we have a function from any ident to the constituent parts+--OR the top level is named, and hence we have the top ident, plus decls for the constituent parts+patternBinding :: JMParser (Either (Ident -> [JStat]) (Ident,[JStat]))+patternBinding = do+  ptree <- patternTree+  let go path (PTAs asIdent pt) = [DeclStat asIdent Nothing, AssignStat (ValExpr (JVar (cleanIdent asIdent))) path] ++ go path pt+      go path (PTVar i)+          | i == (StrI "_") = []+          | otherwise = [DeclStat i Nothing, AssignStat (ValExpr (JVar (cleanIdent i))) (path)]+      go path (PTList pts) = concatMap (uncurry go) $ zip (map addIntToPath [0..]) pts+           where addIntToPath i = IdxExpr path (ValExpr $ JInt i)+      go path (PTObj xs)   = concatMap (uncurry go) $ map (first fixPath) xs+           where fixPath lbl = IdxExpr path (ValExpr $ JStr lbl)+      go path (PTCons x xs) = concat [go (IdxExpr path (ValExpr $ JInt 0)) x,+                                      go (ApplExpr (SelExpr path (StrI "slice")) [ValExpr $ JInt 1]) xs]+  case ptree of+    PTVar i -> return $ Right (i,[])+    PTAs  i pt -> return $ Right (i, go (ValExpr $ JVar i) pt)+    _ -> return $ Left $ \i -> go (ValExpr $ JVar i) ptree++patternBlocks :: JMParser ([Ident],[JStat])+patternBlocks = fmap concat . unzip . zipWith (\i efr -> either (\f -> (i, f i)) id efr) (map (StrI . ("jmId_match_" ++) . show) [(1::Int)..]) <$> many patternBinding++destructuringDecl = do+    (i,patDecls) <- either (\f -> (matchVar, f matchVar)) id <$> patternBinding+    optAssignStat <- optionMaybe $ do+       reservedOp "="+       e <- expr+       return $  AssignStat (ValExpr (JVar (cleanIdent i))) e : patDecls+    return $ DeclStat i Nothing : fromMaybe [] optAssignStat+  where matchVar = StrI "jmId_match_var"+ statblock :: JMParser [JStat] statblock = concat <$> (sepEndBy1 (whiteSpace >> statement) (semi <|> return "")) @@ -354,7 +397,7 @@     where       declStat = do         reserved "var"-        res <- concat <$> commaSep1 identAssignDecl+        res <- concat <$> commaSep1 destructuringDecl         _ <- semi         return res @@ -362,22 +405,21 @@         reserved "function"          (i,mbTyp) <- varidentdecl-        as <- parens (commaSep identdecl) <|> many1 identdecl-        b <- try (ReturnStat <$> braces expr) <|> (l2s <$> statement)+        (as,patDecls) <- fmap (\x -> (x,[])) (try $ parens (commaSep identdecl)) <|> patternBlocks+        b' <- try (ReturnStat <$> braces expr) <|> (l2s <$> statement)+        let b = BlockStat patDecls `mappend` b'         return $ [DeclStat i (fmap snd mbTyp),-                  AssignStat (ValExpr $ JVar (clean i)) (addForcedType mbTyp $ ValExpr $ JFunc as b)]-            where clean (StrI ('!':x)) = StrI x-                  clean x = x+                  AssignStat (ValExpr $ JVar (cleanIdent i)) (addForcedType mbTyp $ ValExpr $ JFunc as b)]        funDecl = do         reserved "fun"         n <- identdecl         mbTyp <- optionMaybe getType-        as <- many identdecl-        b <- try (ReturnStat <$> braces expr) <|> (l2s <$> statement) <|> (symbol "->" >> ReturnStat <$> expr)+        (as, patDecls) <- patternBlocks+        b' <- try (ReturnStat <$> braces expr) <|> (l2s <$> statement) <|> (symbol "->" >> ReturnStat <$> expr)+        let b = BlockStat patDecls `mappend` b'         return $ [DeclStat (addBang n) (fmap snd mbTyp),                   AssignStat (ValExpr $ JVar n) (addForcedType mbTyp $ ValExpr $ JFunc as b)]-             where addBang (StrI x) = StrI ('!':'!':x)        foreignStat = do@@ -529,16 +571,22 @@           addIf ans <|> return ans     rawExpr = buildExpressionParser table dotExpr <?> "expression"     table = [[iop "*", iop "/", iop "%"],+             [pop "++", pop "--"],              [iop "++", iop "+", iop "-", iop "--"],+             [consOp],              [iope "==", iope "!=", iope "<", iope ">",               iope ">=", iope "<=", iope "==="],              [iop "&&", iop "||"],              [applOp, applOpRev]             ]+    pop  s  = Prefix (reservedOp s >> return (PPostExpr True s))     iop  s  = Infix (reservedOp s >> return (InfixExpr s)) AssocLeft     iope s  = Infix (reservedOp s >> return (InfixExpr s)) AssocNone     applOp  = Infix (reservedOp "<|" >> return (\x y -> ApplExpr x [y])) AssocRight     applOpRev  = Infix (reservedOp "|>" >> return (\x y -> ApplExpr y [x])) AssocLeft+    consOp  = Infix (reservedOp ":|" >> return consAct) AssocRight+    consAct x y = ApplExpr (ValExpr (JFunc [StrI "x",StrI "y"] (BlockStat [BlockStat [DeclStat (StrI "tmp") Nothing, AssignStat tmpVar (ApplExpr (SelExpr (ValExpr (JVar (StrI "x"))) (StrI "slice")) [ValExpr (JInt 0)]),ApplStat (SelExpr tmpVar (StrI "unshift")) [ValExpr (JVar (StrI "y"))],ReturnStat tmpVar]]))) [x,y]+        where tmpVar = ValExpr (JVar (StrI "tmp"))  dotExpr :: JMParser JExpr dotExpr = do@@ -556,9 +604,9 @@             case nxt of               Just '.' -> addNxt =<< (dot >> (SelExpr e <$> (ident' <|> numIdent)))               Just '[' -> addNxt =<< (IdxExpr e <$> brackets' expr)-              Just '(' -> addNxt =<< (ApplExpr e <$> args')-              Just '-' -> try (reservedOp "--" >> return (PostExpr "--" e)) <|> return e-              Just '+' -> try (reservedOp "++" >> return (PostExpr "++" e)) <|> return e+              Just '(' -> addNxt =<< (ApplExpr e <$> parens' (commaSep expr))+              Just '-' -> try (reservedOp "--" >> return (PPostExpr False "--" e)) <|> return e+              Just '+' -> try (reservedOp "++" >> return (PPostExpr False "++" e)) <|> return e               _   -> return e      numIdent = StrI <$> many1 digit@@ -588,23 +636,22 @@               var = JVar <$> ident'               func = do                 (symbol "\\" >> return ()) <|> reserved "function"-                liftM2 JFunc (parens (commaSep identdecl) <|> many identdecl)-                             (braces' statOrEblock <|>-                               (symbol "->" >> (ReturnStat <$> expr)))+                (as,patDecls) <- fmap (\x -> (x,[])) (try $ parens (commaSep identdecl)) <|> patternBlocks+                b' <- (braces' statOrEblock <|> (symbol "->" >> (ReturnStat <$> expr)))+                return $ JFunc as (BlockStat patDecls `mappend` b')               statOrEblock  = try (ReturnStat <$> expr `folBy` '}') <|> (l2s <$> statblock)               propPair = liftM2 (,) myIdent (colon >> expr)  --notFolBy a b = a <* notFollowedBy (char b)+folBy :: JMParser a -> Char -> JMParser a folBy a b = a <* (lookAhead (char b) >>= const (return ()))-args' :: JMParser [JExpr]-args' = parens' $ commaSep expr  --Parsers without Lexeme--braces', brackets', parens' :: JMParser a -> JMParser a+braces', brackets', parens', oxfordBraces :: JMParser a -> JMParser a brackets' = around' '[' ']' braces' = around' '{' '}' parens' = around' '(' ')'+oxfordBraces x = lexeme (reservedOp "{|") >> (lexeme x <* reservedOp "|}")  around' :: Char -> Char -> JMParser a -> JMParser a around' a b x = lexeme (char a) >> (lexeme x <* char b)

@@ -806,7 +806,7 @@                   typecheck e  <<:> return t                   typecheck e1 <<:> return t -    typecheck (PostExpr _ e) = case e of+    typecheck (PPostExpr _ _ e) = case e of                                  (SelExpr _ _) -> go                                  (ValExpr (JVar _)) -> go                                  (IdxExpr _ _) -> go@@ -903,7 +903,7 @@               stripStat (t:ts) = t : stripStat ts               stripStat t = t     typecheck (ApplStat args body) = typecheck (ApplExpr args body) >> return JTStat-    typecheck (PostStat s e) = typecheck (PostExpr s e) >> return JTStat+    typecheck (PPostStat b s e) = typecheck (PPostExpr b s e) >> return JTStat     typecheck (AssignStat e e1) = do       typecheck e1 <<:> typecheck e       return JTStat

@@ -1,7 +1,7 @@ name:                jmacro-version:             0.5.1+version:             0.5.2 synopsis:            QuasiQuotation library for programmatic generation of Javascript code.-description:         Javascript syntax, functional syntax, hygienic names, compile-time guarantees of syntactic correctness, limited typechecking.+description:         Javascript syntax, functional syntax, hygienic names, compile-time guarantees of syntactic correctness, limited typechecking. Additional documentation available at <http://www.haskell.org/haskellwiki/Jmacro> category:            Language license:             BSD3 license-file:        LICENSE