hpaco-lib 0.11.0.6 → 0.16.1.0

raw patch · 20 files changed

+1267/−585 lines, 20 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Data/Variant.hs +19/−1
• Data/Variant/ToFrom.hs +78/−0
• Text/HPaco/AST/AST.hs +8/−0
• Text/HPaco/AST/Statement.hs +2/−1
• Text/HPaco/Optimizer.hs +16/−8
• Text/HPaco/Readers/Paco.hs +7/−482
• Text/HPaco/Readers/Paco/Basics.hs +95/−0
• Text/HPaco/Readers/Paco/Expressions.hs +202/−0
• Text/HPaco/Readers/Paco/ParserInternals.hs +67/−0
• Text/HPaco/Readers/Paco/Statements.hs +235/−0
• Text/HPaco/Writers/Dependencies.hs +8/−0
• Text/HPaco/Writers/Internal/WrapMode.hs +1/−0
• Text/HPaco/Writers/Javascript.hs +70/−28
• Text/HPaco/Writers/JsonLisp.hs +164/−0
• Text/HPaco/Writers/PHP.hs +119/−41
• Text/HPaco/Writers/Run.hs +8/−10
• Text/HPaco/Writers/Run/Library.hs +50/−0
• hpaco-lib.cabal +9/−1
• snippets/js/preamble.js +65/−2
• snippets/php/preamble.php +44/−11

@@ -15,7 +15,7 @@         , scopeMerge         , keys         , values-        , vmap+        , vmap, vamap         , wrapf, wrapfs         , wrapf1, wrapfs1         , call, callMaybe, callDef@@ -45,6 +45,21 @@ instance Eq ([Variant] -> Variant)     where (==) a b = False +instance Ord Variant+    where+        compare (String a) b = compare a $ flatten b+        compare a (String b) = compare (flatten a) b+        compare (Double a) b = compare a $ toDouble b+        compare a (Double b) = compare (toDouble a) b+        compare (Integer a) b = compare a $ toInteger b+        compare a (Integer b) = compare (toInteger a) b+        compare (Bool a) b = compare a $ toBool b+        compare a (Bool b) = compare (toBool a) b+        compare Null Null = EQ+        compare Null _ = LT+        compare _ Null = GT+        compare _ _ = EQ+ flatten :: Variant -> String flatten (String s) = s flatten (Integer i) = show i@@ -178,6 +193,9 @@  vmap :: (Variant -> a) -> Variant -> [a] vmap f v = map f $ values v++vamap :: ((Variant, Variant) -> a) -> Variant -> [a]+vamap f v = map f $ toAList v  wrapfs :: (Variant -> [Variant] -> Variant) -> Variant -> Variant wrapfs f s = Function $ f s

@@ -0,0 +1,78 @@+{-#LANGUAGE FlexibleInstances, UndecidableInstances, IncoherentInstances #-}+module Data.Variant.ToFrom where++import Data.Variant+import Prelude hiding (toInteger)++class ToVariant a where+    toVariant :: a -> Variant++class FromVariant a where+    fromVariant :: Variant -> a++-- Variant itself implements to/from variant+instance ToVariant Variant where+    toVariant = id+instance FromVariant Variant where+    fromVariant = id++-- Various scalar instances++instance ToVariant String where+    toVariant = String+instance FromVariant String where+    fromVariant = flatten++instance ToVariant Bool where+    toVariant = Bool+instance FromVariant Bool where+    fromVariant = toBool++instance ToVariant Double where+    toVariant = Double+instance FromVariant Double where+    fromVariant = toDouble++instance ToVariant Integer where+    toVariant = Integer+instance FromVariant Integer where+    fromVariant = toInteger++instance ToVariant Int where+    toVariant = Integer . fromIntegral+instance FromVariant Int where+    fromVariant = fromIntegral . toInteger++-- Maybes of to/from variant types implement to/from variant+instance ToVariant a => ToVariant (Maybe a) where+    toVariant Nothing = Null+    toVariant (Just a) = toVariant a++instance FromVariant a => FromVariant (Maybe a) where+    fromVariant Null = Nothing+    fromVariant a = Just (fromVariant a)++-- Lists of variants+instance (ToVariant a, ToVariant b) => ToVariant [(a,b)] where+    toVariant xs =+        let (keys, values) = unzip xs+            vkeys = map toVariant keys+            vvalues = map toVariant values+        in AList $ zip vkeys vvalues++instance (FromVariant a, FromVariant b) => FromVariant [(a,b)] where+    fromVariant = map (\(k,v) -> (fromVariant k, fromVariant v)) . toAList++instance ToVariant a => ToVariant [a] where+    toVariant xs = List (map toVariant xs)++instance FromVariant a => FromVariant [a] where+    fromVariant = map fromVariant . values++-- Functions, up to 3 arguments+instance (FromVariant a, ToVariant b) => ToVariant (a -> b) where+    toVariant f = Function (\(x:_) -> toVariant (f $ fromVariant x))+instance (FromVariant a, FromVariant b, ToVariant c) => ToVariant (a -> b -> c) where+    toVariant f = Function (\(x:y:_) -> toVariant (f (fromVariant x) (fromVariant y)))+instance (FromVariant a, FromVariant b, FromVariant c, ToVariant d) => ToVariant (a -> b -> c -> d) where+    toVariant f = Function (\(x:y:z:_) -> toVariant (f (fromVariant x) (fromVariant y) (fromVariant z)))

@@ -6,5 +6,13 @@ data AST =     AST { astRootStatement :: Statement         , astDefs :: [(Identifier,Statement)]+        , astDeps :: [String]         }         deriving (Show)++defAST :: AST+defAST =+    AST { astRootStatement = NullStatement+        , astDefs = []+        , astDeps = []+        }

@@ -4,11 +4,12 @@ import Text.HPaco.AST.Identifier (Identifier)  data Statement = NullStatement+               | SourcePositionStatement FilePath Int                | StatementSequence [Statement]                | PrintStatement Expression                | IfStatement Expression Statement Statement                | LetStatement Identifier Expression Statement-               | ForStatement Identifier Expression Statement+               | ForStatement (Maybe Identifier) Identifier Expression Statement                | CallStatement Identifier                | SwitchStatement Expression [(Expression, Statement)]                deriving (Show, Eq)

@@ -29,15 +29,17 @@             then PrintStatement e             else optimizeStatement $ PrintStatement e' +-- Turn SourcePositionStatements into Null statements so that they are removed+optimizeStatement (SourcePositionStatement _ _) = NullStatement+ optimizeStatement (StatementSequence xs) =-    let xs' = filter (/= NullStatement) (map optimizeStatement xs)+    let xs' = fusePrints $ filter (/= NullStatement) (map optimizeStatement xs)     in case xs' of         -- flatten nested statement sequences         (StatementSequence ss):rem -> optimizeStatement . StatementSequence $ ss ++ rem-        -- combine print statements-        (PrintStatement (StringLiteral lhs)):(PrintStatement (StringLiteral rhs)):rem ->-            optimizeStatement . StatementSequence $-                (PrintStatement $ StringLiteral (lhs ++ rhs)):rem+        -- reduce statement sequences with only one statement in them down+        -- to that single statement+        s:[] -> s         -- remove empty statement sequences         [] -> NullStatement         otherwise -> StatementSequence xs'@@ -55,10 +57,10 @@         stmt' = optimizeStatement stmt     in LetStatement id e' stmt' -optimizeStatement (ForStatement id e stmt) =+optimizeStatement (ForStatement iter id e stmt) =     let e' = optimizeExpression e         stmt' = optimizeStatement stmt-    in ForStatement id e' stmt'+    in ForStatement iter id e' stmt'  optimizeStatement (SwitchStatement e branches) =     let e' = optimizeExpression e@@ -68,6 +70,12 @@ optimizeStatement s = s  +fusePrints :: [Statement] -> [Statement]+fusePrints ((PrintStatement (StringLiteral lhs)):(PrintStatement (StringLiteral rhs)):rem) =+    fusePrints $ PrintStatement (StringLiteral $ lhs ++ rhs):fusePrints rem+fusePrints (s:rem) = s:fusePrints rem+fusePrints [] = []+ optimizeExpression :: Expression -> Expression optimizeExpression e =     if isConst e@@ -88,7 +96,7 @@  evaluateConstExpression :: Expression -> Expression evaluateConstExpression e =-    let rs = Run.RunState { Run.rsScope = Null, Run.rsAST = AST { astDefs = [], astRootStatement = NullStatement }, Run.rsOptions = Run.defaultOptions }+    let rs = Run.RunState { Run.rsScope = Null, Run.rsAST = defAST, Run.rsOptions = Run.defaultOptions }         v = unsafePerformIO $ evalStateT (Run.runExpression e) rs     in fromVariant v 

@@ -1,4 +1,3 @@-{-#LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} module Text.HPaco.Readers.Paco     ( readPaco     )@@ -7,44 +6,23 @@ import Control.Monad import Control.Monad.IO.Class import Text.HPaco.Reader+import Text.HPaco.Readers.Paco.ParserInternals+import Text.HPaco.Readers.Paco.Basics+import Text.HPaco.Readers.Paco.Statements import Text.HPaco.AST.AST import Text.HPaco.AST.Statement import Text.HPaco.AST.Expression-import Text.Parsec.Prim-import Text.Parsec.Char-import Text.Parsec.Combinator-import Text.Parsec.Pos (SourcePos, sourceLine, sourceColumn)-import Text.Parsec.String hiding (Parser)-import Text.Parsec.Error (ParseError)-import Control.Exception (throw, Exception)-import Data.Typeable+import Control.Exception (throw) import System.IO (withFile, IOMode (ReadMode)) import System.IO.Strict import System.FilePath -instance Exception ParseError-deriving instance Typeable ParseError--data PacoState = PacoState-                    { psBasePath :: FilePath-                    , psDefs :: [(String, Statement)]-                    , psIncludeExtension :: Maybe String-                    }--type Parser a = ParsecT String PacoState IO a--defaultPacoState :: PacoState-defaultPacoState = PacoState-                        { psBasePath = ""-                        , psDefs = []-                        , psIncludeExtension = Nothing-                        }- readPaco :: Reader readPaco filename =     let pstate = defaultPacoState                     { psBasePath = takeDirectory filename                     , psIncludeExtension = renull $ takeExtension filename+                    , psHandleInclude = readPaco                     }     in readPacoWithState pstate filename     where renull "" = Nothing@@ -60,464 +38,11 @@  document :: Parser AST document = do-    stmts <- many statement+    stmts <- statements     eof     pstate <- getState     return $ AST                  { astRootStatement = StatementSequence stmts                 , astDefs = psDefs pstate+                , astDeps = psDeps pstate                 }---- Statement parsers--statement :: Parser Statement-statement = try ifStatement -          <|> try withStatement-          <|> try switchStatement-          <|> try forStatement-          <|> try defStatement-          <|> try callStatement-          <|> try commentStatement-          <|> try includeStatement-          <|> try interpolateStatement-          <|> try newlineStatement-          <|> try escapeSequenceStatement-          <|> rawTextStatement--commentStatement :: Parser Statement-commentStatement = do-    string "{%--"-    manyTill-        (try (discard commentStatement) <|> discard anyChar)-        (try $ string "--%}")-    return NullStatement--includeStatement :: Parser Statement-includeStatement = do-    (basename, innerContext) <- complexTag "include" inner-    dirname <- psBasePath `liftM` getState-    extension <- psIncludeExtension `liftM` getState-    let fn0 = joinPath [ dirname, basename ]-    let fn = maybe fn0 (fillExtension fn0) extension-    src <- liftIO $ withFile fn ReadMode hGetContents-    subAst <- liftIO $ readPaco fn src-    let stmt = astRootStatement subAst-    return $ maybe stmt (\(ident, expr) -> LetStatement ident expr stmt) innerContext-    where-        path :: Parser String-        path = many1 $ try $ noneOf " \t\r\n%"--        inner :: Parser (String, Maybe (String, Expression))-        inner = do-            basename <- path-            ss_-            innerContext <- optionMaybe $ try (ss_ >> string "with" >> ss_ >> letPair)-            return (basename, innerContext)--interpolateStatement :: Parser Statement-interpolateStatement = do-    char '{'-    em <- option (Just EscapeHTML) escapeMode-    ss_-    expr <- expression-    ss_-    char '}'-    let expr' = maybe-                    expr-                    (\m -> EscapeExpression m expr)-                    em-    return $ PrintStatement $ expr'--rawTextStatement :: Parser Statement-rawTextStatement = do-    chrs <- many1 $ noneOf "{\\\n"-    return $ PrintStatement $ StringLiteral chrs--newlineStatement :: Parser Statement-newlineStatement = do-    char '\n'-    ss_-    return $ PrintStatement $ StringLiteral "\n"--escapeSequenceStatement :: Parser Statement-escapeSequenceStatement = do-    char '\\'-    c <- anyChar-    case c of-        '\n' -> return NullStatement-        otherwise -> return $ PrintStatement $ StringLiteral [ '\\', c ]--ifStatement :: Parser Statement-ifStatement = do-        cond <- complexTag "if" expression-        trueStmts <- many statement-        let trueBranch = StatementSequence trueStmts-        falseBranch <- option NullStatement $ try elseBranch-        simpleTag "endif"-        return $ IfStatement cond trueBranch falseBranch-        where elseBranch =-                do-                    simpleTag "else"-                    stmts <- many statement-                    return . StatementSequence $ stmts--withStatement :: Parser Statement-withStatement = withOrForStatement LetStatement "with"--forStatement :: Parser Statement-forStatement = withOrForStatement ForStatement "for"--withOrForStatement :: (String -> Expression -> Statement -> Statement) -> String -> Parser Statement-withOrForStatement ctor keyword = do-    (ident, expr) <- complexTag keyword letPair-    stmts <- many $ try statement-    simpleTag $ "end" ++ keyword-    return $ ctor ident expr $ StatementSequence stmts--letPair :: Parser (String, Expression)-letPair = do-    expr <- expression-    ss_-    ident <- option "." $ try $ char ':' >> ss_ >> identifier-    ss_-    return (ident, expr)--switchStatement :: Parser Statement-switchStatement = do-    masterExpr <- complexTag "switch" expression-    ss_-    branches <- many switchBranch-    ss_-    simpleTag "endswitch"-    return $ SwitchStatement masterExpr branches-    where switchBranch = do-            ss_-            switchExpr <- complexTag "case" expression-            stmts <- many statement-            simpleTag "endcase"-            ss_-            return (switchExpr, StatementSequence stmts)--defStatement :: Parser Statement-defStatement = do-    name <- complexTag "def" identifier-    body <- many statement-    simpleTag "enddef"-    addDef name $ StatementSequence body-    return NullStatement--callStatement :: Parser Statement-callStatement = do-    name <- complexTag "call" identifier-    optional $ char '\n'-    return $ CallStatement name--simpleTag tag = complexTag tag (return ())-complexTag tag inner = -    let go = do-            string "{%" -            ss_ -            string tag -            ss_ -            i <- inner-            ss_-            string "%}" -            return i-        standalone = do-            assertStartOfLine-            ss_-            v <- go-            char '\n'-            return v--    in try standalone <|> try go----- Expression parsers--expression = booleanExpression--booleanExpression =-    binaryExpression-        [("&&", OpBooleanAnd),-         ("||", OpBooleanOr),-         ("^^", OpBooleanXor)]-        setOperationExpression--setOperationExpression =-    binaryExpression-        [("in", OpInList),-         ("contains", Flipped OpInList)]-        comparativeExpression--comparativeExpression =-    binaryExpression-        [("==", OpEquals),-         ("!==", OpNotEquals),-         ("=", OpLooseEquals),-         ("!=", OpLooseNotEquals),-         (">=", OpNotLess),-         (">", OpGreater),-         ("<=", OpNotGreater),-         ("<", OpLess)]-        additiveExpression--additiveExpression =-    binaryExpression-        [("+", OpPlus), ("-", OpMinus)]-        multiplicativeExpression--multiplicativeExpression =-    binaryExpression-        [("*", OpMul), ("/", OpDiv), ("%", OpMod)]-        (try traditionalFunctionCallExpression <|> postfixExpression)--binaryExpression :: [(String, BinaryOperator)] -> (Parser Expression) -> Parser Expression-binaryExpression opMap innerParser = do-    let rem :: Parser (BinaryOperator, Expression)-        rem = do-            ss_-            opStr <- foldl1 (<|>) $ map (try . string . fst) opMap-            ss_-            let Just op = lookup opStr opMap-            e <- innerParser-            return (op, e)-    left <- innerParser-    right <- many $ try rem-    return $ foldl combine left right-    where-        combine :: Expression -> (BinaryOperator, Expression) -> Expression-        combine lhs (op, rhs) = BinaryExpression op lhs rhs--traditionalFunctionCallExpression = do-    char '$'-    args <- manySepBy (try expression) ss_-    return $ FunctionCallExpression (head args) (tail args)--postfixExpression = do-    left <- (try prefixExpression <|> simpleExpression)-    postfixes <- many postfix-    return $ foldl combine left postfixes-    where-        combine :: Expression -> (Expression -> Expression) -> Expression-        combine l f = f l--prefixExpression = do-    ss_-    operator <- unaryOperator-    ss_-    expr <- (try prefixExpression <|> simpleExpression)-    return $ UnaryExpression operator expr--unaryOperator = do-    let opMap = [("not", OpNot)]-    opStr <- foldl1 (<|>) $ map (try . string . fst) opMap-    let Just op = lookup opStr opMap-    return op-    -postfix = try memberAccessPostfix-        <|> try indexPostfix-        <|> try functionCallPostfix--memberAccessPostfix :: Parser (Expression -> Expression)-memberAccessPostfix = do-    char '.'-    expr <- StringLiteral `liftM` identifier-    return $ \l -> BinaryExpression OpMember l expr--indexPostfix :: Parser (Expression -> Expression)-indexPostfix = do-    ss_-    char '['-    e <- expression-    char ']'-    ss_-    return $ \l -> BinaryExpression OpMember l e--functionCallPostfix :: Parser (Expression -> Expression)-functionCallPostfix = do-    char '('-    args <- manySepBy (try expression) (try $ ss_ >> char ',' >> ss_)-    ss_-    char ')'-    return $ \l -> FunctionCallExpression l args--simpleExpression :: Parser Expression-simpleExpression  =  floatLiteral-                 <|> intLiteral-                 <|> stringLiteral-                 <|> listExpression-                 <|> alistExpression-                 <|> varRefExpr-                 <|> bracedExpression--bracedExpression :: Parser Expression-bracedExpression = do-    char '('-    ss_-    inner <- expression-    ss_-    char ')'-    return inner--listExpression :: Parser Expression-listExpression = do-    char '['-    ss_-    items <- manySepBy expression (ss_ >> char ',' >> ss_)-    ss_-    optional $ char ',' >> ss_-    char ']'-    return $ ListExpression items--alistExpression :: Parser Expression-alistExpression = do-    char '{'-    ss_-    items <- option [] $ try $ manySepBy elem $ char ','-    ss_-    optional $ char ',' >> ss_-    char '}'-    return $ AListExpression items-    where-        elem :: Parser (Expression, Expression)-        elem = do-            ss_-            key <- expression-            ss_ >> char ':' >> ss_-            value <- expression-            ss_-            return (key, value)--intLiteral :: Parser Expression-intLiteral = do-    sign <- option '+' $ oneOf "+-"-    str <- many1 digit-    let str' = if sign == '-' then sign:str else str-    return . IntLiteral . read $ str'--floatLiteral :: Parser Expression-floatLiteral = do-    str <- (try dpd <|> try pd)-    return . FloatLiteral . read $ str-    where-        dpd = do-            sign <- option '+' $ oneOf "+-"-            intpart <- many1 digit-            char '.'-            fracpart <- many digit-            let str = intpart ++ "." ++ fracpart-            return $ if sign == '-' then sign:str else str-        pd = do-            sign <- option '+' $ oneOf "+-"-            char '.'-            fracpart <- many1 digit-            let str = "0." ++ fracpart-            return $ if sign == '-' then sign:str else str--stringLiteral :: Parser Expression-stringLiteral = do-    str <- anyQuotedString-    return . StringLiteral $ str--varRefExpr :: Parser Expression-varRefExpr = do-    id <- (string "." <|> identifier)-    return $ VariableReference id---- Parser state management--addDef :: String -> Statement -> Parser ()-addDef name value =-    modifyState (\s -> s { psDefs = ((name, value):psDefs s) })--resolveDef :: String -> Parser Statement-resolveDef name = do-    defs <- psDefs `liftM` getState-    let val = lookup name defs-    maybe-        (unexpected $ name ++ " is not defined.")-        return-        val---- Auxiliary parsers--ss :: a -> Parser a-ss a = skipMany space >> return a--ss_ :: Parser ()-ss_ = ss ()--braces :: Parser a -> Parser a-braces inner = do-    char '{'-    ss_-    v <- inner-    ss_-    char '}'-    return v--escapeMode :: Parser (Maybe EscapeMode)-escapeMode = (char '!' >> return Nothing)-          <|> (char '@' >> return (Just EscapeURL))--identifier :: Parser String-identifier = do-    x <- letter <|> char '_'-    xs <- many $ letter <|> digit <|> char '_'-    return $ x:xs--anyQuotedString = singleQuotedString <|> doubleQuotedString--singleQuotedString = quotedString '\''-doubleQuotedString = quotedString '"'--quotedString qc = do-    char qc-    str <- many $ quotedStringChar qc-    char qc-    return str--quotedStringChar qc =-    try escapedChar-    <|> noneOf [qc]--escapedChar = do-    char '\\'-    c2 <- anyChar-    return $ case c2 of-                'n' -> '\n'-                'r' -> '\r'-                'b' -> '\b'-                't' -> '\t'-                otherwise -> c2--discard :: Parser a -> Parser ()-discard p = p >> return ()--manySepBy :: Parser a -> Parser b -> Parser [a]-manySepBy elem sep = do-    h <- try elem-    t <- many (try $ sep >> elem)-    return $ h:t--assertStartOfInput :: Parser ()-assertStartOfInput = do-    pos <- getPosition-    if sourceLine pos == 1 && sourceColumn pos == 1-        then return ()-        else unexpected "start of input"--assertStartOfLine :: Parser ()-assertStartOfLine = do-    pos <- getPosition-    if sourceColumn pos == 1-        then return ()-        else unexpected "start of line"--fillExtension :: FilePath -> String -> FilePath-fillExtension fp ext =-    let ext0 = takeExtension fp-    in if null ext0-        then replaceExtension fp ext-        else fp

@@ -0,0 +1,95 @@+module Text.HPaco.Readers.Paco.Basics+    ( module Text.Parsec.Combinator+    , module Text.Parsec.Char+    , module Text.Parsec.Prim+    , module Text.Parsec.String+    , ss, ss_+    , braces+    , identifier+    , anyQuotedString, singleQuotedString, doubleQuotedString+    , discard+    , manySepBy+    , assertStartOfLine, assertStartOfInput+    )+where++import Text.HPaco.Readers.Paco.ParserInternals+import Text.Parsec.Char+import Text.Parsec.Combinator+import Text.Parsec.Pos (SourcePos, sourceLine, sourceColumn, sourceName)+import Text.Parsec.Prim+import Text.Parsec.String hiding (Parser)+import Control.Monad.IO.Class+import System.IO.Strict++-- Auxiliary parsers++ss :: a -> Parser a+ss a = skipMany space >> return a++ss_ :: Parser ()+ss_ = ss ()++braces :: Parser a -> Parser a+braces inner = do+    char '{'+    ss_+    v <- inner+    ss_+    char '}'+    return v++identifier :: Parser String+identifier = do+    x <- letter <|> char '_'+    xs <- many $ letter <|> digit <|> char '_'+    return $ x:xs++anyQuotedString = singleQuotedString <|> doubleQuotedString++singleQuotedString = quotedString '\''+doubleQuotedString = quotedString '"'++quotedString qc = do+    char qc+    str <- many $ quotedStringChar qc+    char qc+    return str++quotedStringChar qc =+    try escapedChar+    <|> noneOf [qc]++escapedChar :: Parser Char+escapedChar = do+    char '\\'+    c2 <- anyChar+    return $ case c2 of+                'n' -> '\n'+                'r' -> '\r'+                'b' -> '\b'+                't' -> '\t'+                otherwise -> c2++discard :: Parser a -> Parser ()+discard p = p >> return ()++manySepBy :: Parser a -> Parser b -> Parser [a]+manySepBy elem sep = do+    h <- try elem+    t <- many (try $ sep >> elem)+    return $ h:t++assertStartOfInput :: Parser ()+assertStartOfInput = do+    pos <- getPosition+    if sourceLine pos == 1 && sourceColumn pos == 1+        then return ()+        else unexpected "start of input"++assertStartOfLine :: Parser ()+assertStartOfLine = do+    pos <- getPosition+    if sourceColumn pos == 1+        then return ()+        else unexpected "start of line"

@@ -0,0 +1,202 @@+module Text.HPaco.Readers.Paco.Expressions+    ( expression+    )+where++import Control.Monad+import Text.HPaco.Readers.Paco.Basics+import Text.HPaco.Readers.Paco.ParserInternals+import Text.HPaco.AST.Statement+import Text.HPaco.AST.Expression++expression = booleanExpression++booleanExpression =+    binaryExpression+        [("&&", OpBooleanAnd),+         ("||", OpBooleanOr),+         ("^^", OpBooleanXor)]+        setOperationExpression++setOperationExpression =+    binaryExpression+        [("in", OpInList),+         ("contains", Flipped OpInList)]+        comparativeExpression++comparativeExpression =+    binaryExpression+        [("==", OpEquals),+         ("!==", OpNotEquals),+         ("=", OpLooseEquals),+         ("!=", OpLooseNotEquals),+         (">=", OpNotLess),+         (">", OpGreater),+         ("<=", OpNotGreater),+         ("<", OpLess)]+        additiveExpression++additiveExpression =+    binaryExpression+        [("+", OpPlus), ("-", OpMinus)]+        multiplicativeExpression++multiplicativeExpression =+    binaryExpression+        [("*", OpMul), ("/", OpDiv), ("%", OpMod)]+        (try traditionalFunctionCallExpression <|> postfixExpression)++binaryExpression :: [(String, BinaryOperator)] -> (Parser Expression) -> Parser Expression+binaryExpression opMap innerParser = do+    let rem :: Parser (BinaryOperator, Expression)+        rem = do+            ss_+            opStr <- foldl1 (<|>) $ map (try . string . fst) opMap+            ss_+            let Just op = lookup opStr opMap+            e <- innerParser+            return (op, e)+    left <- innerParser+    right <- many $ try rem+    return $ foldl combine left right+    where+        combine :: Expression -> (BinaryOperator, Expression) -> Expression+        combine lhs (op, rhs) = BinaryExpression op lhs rhs++traditionalFunctionCallExpression = do+    char '$'+    args <- manySepBy (try expression) ss_+    return $ FunctionCallExpression (head args) (tail args)++postfixExpression = do+    left <- (try prefixExpression <|> simpleExpression)+    postfixes <- many postfix+    return $ foldl combine left postfixes+    where+        combine :: Expression -> (Expression -> Expression) -> Expression+        combine l f = f l++prefixExpression = do+    ss_+    operator <- unaryOperator+    ss_+    expr <- (try prefixExpression <|> simpleExpression)+    return $ UnaryExpression operator expr++unaryOperator = do+    let opMap = [("not", OpNot)]+    opStr <- foldl1 (<|>) $ map (try . string . fst) opMap+    let Just op = lookup opStr opMap+    return op+    +postfix = try memberAccessPostfix+        <|> try indexPostfix+        <|> try functionCallPostfix++memberAccessPostfix :: Parser (Expression -> Expression)+memberAccessPostfix = do+    char '.'+    expr <- StringLiteral `liftM` identifier+    return $ \l -> BinaryExpression OpMember l expr++indexPostfix :: Parser (Expression -> Expression)+indexPostfix = do+    ss_+    char '['+    e <- expression+    char ']'+    ss_+    return $ \l -> BinaryExpression OpMember l e++functionCallPostfix :: Parser (Expression -> Expression)+functionCallPostfix = do+    char '('+    args <- manySepBy (try expression) (try $ ss_ >> char ',' >> ss_)+    ss_+    char ')'+    return $ \l -> FunctionCallExpression l args++simpleExpression :: Parser Expression+simpleExpression  =  floatLiteral+                 <|> intLiteral+                 <|> stringLiteral+                 <|> listExpression+                 <|> alistExpression+                 <|> varRefExpr+                 <|> bracedExpression++bracedExpression :: Parser Expression+bracedExpression = do+    char '('+    ss_+    inner <- expression+    ss_+    char ')'+    return inner++listExpression :: Parser Expression+listExpression = do+    char '['+    ss_+    items <- manySepBy expression (ss_ >> char ',' >> ss_)+    ss_+    optional $ char ',' >> ss_+    char ']'+    return $ ListExpression items++alistExpression :: Parser Expression+alistExpression = do+    char '{'+    ss_+    items <- option [] $ try $ manySepBy elem $ char ','+    ss_+    optional $ char ',' >> ss_+    char '}'+    return $ AListExpression items+    where+        elem :: Parser (Expression, Expression)+        elem = do+            ss_+            key <- expression+            ss_ >> char ':' >> ss_+            value <- expression+            ss_+            return (key, value)++intLiteral :: Parser Expression+intLiteral = do+    sign <- option '+' $ oneOf "+-"+    str <- many1 digit+    let str' = if sign == '-' then sign:str else str+    return . IntLiteral . read $ str'++floatLiteral :: Parser Expression+floatLiteral = do+    str <- (try dpd <|> try pd)+    return . FloatLiteral . read $ str+    where+        dpd = do+            sign <- option '+' $ oneOf "+-"+            intpart <- many1 digit+            char '.'+            fracpart <- many digit+            let str = intpart ++ "." ++ fracpart+            return $ if sign == '-' then sign:str else str+        pd = do+            sign <- option '+' $ oneOf "+-"+            char '.'+            fracpart <- many1 digit+            let str = "0." ++ fracpart+            return $ if sign == '-' then sign:str else str++stringLiteral :: Parser Expression+stringLiteral = do+    str <- anyQuotedString+    return . StringLiteral $ str++varRefExpr :: Parser Expression+varRefExpr = do+    id <- (string "." <|> identifier)+    return $ VariableReference id++

@@ -0,0 +1,67 @@+{-#LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}+module Text.HPaco.Readers.Paco.ParserInternals +    ( PacoState (..)+    , defaultPacoState+    , Text.Parsec.Error.ParseError+    , Parser+    , addDef, resolveDef+    , fillExtension+    )+where++import Control.Exception (Exception)+import Control.Monad+import Control.Monad.IO.Class+import Data.Typeable+import Text.HPaco.Reader+import Text.HPaco.AST.AST+import Text.HPaco.AST.Expression+import Text.HPaco.AST.Statement+import Text.Parsec.Error (ParseError)+import Text.Parsec.Prim+import Text.Parsec.Char+import Text.Parsec.String hiding (Parser)+import System.FilePath++instance Exception ParseError+deriving instance Typeable ParseError++data PacoState = PacoState+                    { psBasePath :: FilePath+                    , psDefs :: [(String, Statement)]+                    , psDeps :: [String]+                    , psIncludeExtension :: Maybe String+                    , psHandleInclude :: Reader+                    }++type Parser a = ParsecT String PacoState IO a++defaultPacoState :: PacoState+defaultPacoState = PacoState+                        { psBasePath = ""+                        , psDefs = []+                        , psDeps = []+                        , psIncludeExtension = Nothing+                        , psHandleInclude = (\s t -> return defAST)+                        }++addDef :: String -> Statement -> Parser ()+addDef name value =+    modifyState (\s -> s { psDefs = ((name, value):psDefs s) })++resolveDef :: String -> Parser Statement+resolveDef name = do+    defs <- psDefs `liftM` getState+    let val = lookup name defs+    maybe+        (unexpected $ name ++ " is not defined.")+        return+        val++fillExtension :: FilePath -> String -> FilePath+fillExtension fp ext =+    let ext0 = takeExtension fp+    in if null ext0+        then replaceExtension fp ext+        else fp+

@@ -0,0 +1,235 @@+module Text.HPaco.Readers.Paco.Statements+    ( statements, statement+    )+where++import Control.Monad+import Control.Monad.IO.Class+import System.IO.Strict+import System.FilePath+import System.IO (withFile, IOMode (ReadMode))+import Text.HPaco.Readers.Paco.Basics+import Text.HPaco.Readers.Paco.ParserInternals+import Text.HPaco.Readers.Paco.Expressions+import Text.HPaco.AST.AST+import Text.HPaco.AST.Statement+import Text.HPaco.AST.Expression+import Text.Parsec.Pos (SourcePos, sourceLine, sourceColumn, sourceName)++statements :: Parser [Statement]+statements =+    concat `liftM` many statementPair+    where statementPair = do+                l <- lineNumberStatement+                s <- statement+                return [l,s]++statement :: Parser Statement+statement = try ifStatement +          <|> try withStatement+          <|> try switchStatement+          <|> try forStatement+          <|> try defStatement+          <|> try callStatement+          <|> try commentStatement+          <|> try includeStatement+          <|> try interpolateStatement+          <|> try newlineStatement+          <|> try escapeSequenceStatement+          <|> try rawTextStatement++lineNumberStatement :: Parser Statement+lineNumberStatement = do+    pos <- getPosition+    return $ SourcePositionStatement (sourceName pos) (sourceLine pos)++commentStatement :: Parser Statement+commentStatement = do+    string "{%--"+    manyTill+        (try (discard commentStatement) <|> discard anyChar)+        (try $ string "--%}")+    return NullStatement++includeStatement :: Parser Statement+includeStatement = do+    (basename, innerContext) <- complexTag "include" inner+    dirname <- psBasePath `liftM` getState+    extension <- psIncludeExtension `liftM` getState+    reader <- psHandleInclude `liftM` getState+    let fn0 = joinPath [ dirname, basename ]+    let fn = maybe fn0 (fillExtension fn0) extension+    src <- liftIO $ withFile fn ReadMode hGetContents+    subAst <- liftIO $ reader fn src+    let stmt = astRootStatement subAst+    modifyState (\s -> s { psDeps = fn:psDeps s ++ astDeps subAst })+    return $ maybe stmt (\(ident, expr) -> LetStatement ident expr stmt) innerContext+    where+        path :: Parser String+        path = many1 $ try $ noneOf " \t\r\n%"++        inner :: Parser (String, Maybe (String, Expression))+        inner = do+            basename <- path+            ss_+            innerContext <- optionMaybe $ try (ss_ >> string "with" >> ss_ >> letPair)+            return (basename, innerContext)++interpolateStatement :: Parser Statement+interpolateStatement = do+    char '{'+    em <- option (Just EscapeHTML) escapeMode+    ss_+    expr <- expression+    ss_+    char '}'+    let expr' = maybe+                    expr+                    (\m -> EscapeExpression m expr)+                    em+    return $ PrintStatement $ expr'++rawTextStatement :: Parser Statement+rawTextStatement = do+    chrs <- many1 $ noneOf "{\\\n"+    return $ PrintStatement $ StringLiteral chrs++newlineStatement :: Parser Statement+newlineStatement = do+    char '\n'+    ss_+    return $ PrintStatement $ StringLiteral "\n"++escapeSequenceStatement :: Parser Statement+escapeSequenceStatement = do+    char '\\'+    c <- anyChar+    case c of+        '\n' -> return NullStatement+        otherwise -> return $ PrintStatement $ StringLiteral [ '\\', c ]++ifStatement :: Parser Statement+ifStatement = do+        cond <- complexTag "if" expression+        trueStmts <- statements+        let trueBranch = StatementSequence trueStmts+        falseBranch <- option NullStatement $ try elseBranch+        simpleTag "endif"+        return $ IfStatement cond trueBranch falseBranch+        where elseBranch =+                do+                    simpleTag "else"+                    stmts <- statements+                    return . StatementSequence $ stmts++withStatement :: Parser Statement+withStatement = withOrForStatement (\(n,v) -> LetStatement n v) "with" letPairs++forStatement :: Parser Statement+forStatement = withOrForStatement (\(k, n, v) -> ForStatement k n v) "for" forDefs++withOrForStatement :: (a -> Statement -> Statement) -> String -> Parser [a] -> Parser Statement+withOrForStatement ctor keyword innerP = do+    lets <- complexTag keyword innerP+    stmts <- statements+    simpleTag $ "end" ++ keyword+    return $ foldr ctor (StatementSequence stmts) lets++letPairs :: Parser [(String, Expression)]+letPairs = manySepBy (try letPair) (try $ char ',')++forDefs :: Parser [(Maybe String, String, Expression)]+forDefs = manySepBy (try forDef) (try $ char ',')++letPair :: Parser (String, Expression)+letPair = do+    ss_+    expr <- expression+    ss_+    ident <- option "." $ try $ char ':' >> ss_ >> identifier+    ss_+    return (ident, expr)++forDef :: Parser (Maybe String, String, Expression)+forDef = try forTriple <|> forPair++forPair :: Parser (Maybe String, String, Expression)+forPair = do+    (ident, expr) <- letPair+    return (Nothing, ident, expr)++forTriple :: Parser (Maybe String, String, Expression)+forTriple = do+    ss_+    expr <- expression+    ss_+    char ':'+    ss_+    key <- identifier+    ss_+    doFlip <- option False $ flip+    ss_+    val <- identifier+    ss_+    if doFlip+        then return (Just val, key, expr)+        else return (Just key, val, expr)+    where+        flip = try fwdArr <|> try revArr+        fwdArr = string "->" >> return False+        revArr = string "<-" >> return True++switchStatement :: Parser Statement+switchStatement = do+    masterExpr <- complexTag "switch" expression+    ss_+    branches <- many switchBranch+    ss_+    simpleTag "endswitch"+    return $ SwitchStatement masterExpr branches+    where switchBranch = do+            ss_+            switchExpr <- complexTag "case" expression+            stmts <- statements+            simpleTag "endcase"+            ss_+            return (switchExpr, StatementSequence stmts)++defStatement :: Parser Statement+defStatement = do+    name <- complexTag "def" identifier+    body <- statements+    simpleTag "enddef"+    addDef name $ StatementSequence body+    return NullStatement++callStatement :: Parser Statement+callStatement = do+    name <- complexTag "call" identifier+    optional $ char '\n'+    return $ CallStatement name++simpleTag tag = complexTag tag (return ())+complexTag tag inner = +    let go = do+            string "{%" +            ss_ +            string tag +            ss_ +            i <- inner+            ss_+            string "%}" +            return i+        standalone = do+            assertStartOfLine+            ss_+            v <- go+            char '\n'+            return v++    in try standalone <|> try go++escapeMode :: Parser (Maybe EscapeMode)+escapeMode = (char '!' >> return Nothing)+          <|> (char '@' >> return (Just EscapeURL))+

@@ -0,0 +1,8 @@+module Text.HPaco.Writers.Dependencies ( writeDependencies ) where++import Text.HPaco.AST.AST+import Data.List++writeDependencies :: String -> AST -> String+writeDependencies fn ast =+    fn ++ ": " ++ (concat $ intersperse " " (astDeps ast)) ++ "\n"

@@ -4,3 +4,4 @@ where  data WrapMode = WrapNone | WrapFunction | WrapClass+    deriving (Eq)

@@ -47,10 +47,7 @@ defaultJavascriptWriterState =     JavascriptWriterState         { jwsIndent = 0-        , jwsAST = AST-                     { astRootStatement = NullStatement-                     , astDefs = []-                     }+        , jwsAST = defAST         }  type PWS = RWS WriterOptions String JavascriptWriterState@@ -63,9 +60,17 @@ writeAST :: AST -> PWS () writeAST ast = do     writeHeader+    writeDefs $ astDefs ast     writeStatement $ astRootStatement ast     writeFooter +writeDefs = mapM_ writeDef++writeDef (identifier, body) = do+    writeIndentedLn $ "var _macro_" ++ identifier ++ " = function() {"+    withIndent $ writeStatement body+    writeIndentedLn "};"+ write :: String -> PWS () write = tell @@ -156,12 +161,22 @@         NullStatement -> return ()         IfStatement { } -> writeIf stmt         LetStatement identifier expr stmt -> writeLet identifier expr stmt-        ForStatement identifier expr stmt -> writeFor identifier expr stmt+        ForStatement Nothing identifier expr stmt -> writeFor identifier expr stmt+        ForStatement (Just iter) identifier expr stmt -> writeForExt iter identifier expr stmt         SwitchStatement masterExpr branches -> writeSwitch masterExpr branches         CallStatement identifier -> do-            ast <- gets jwsAST-            let body = fromMaybe NullStatement $ lookup identifier $ astDefs ast-            writeStatement body+            -- ast <- gets jwsAST+            -- let body = fromMaybe NullStatement $ lookup identifier $ astDefs ast+            -- writeStatement body+            writeIndentedLn $ "_macro_" ++ identifier ++ ".apply(this);"+        SourcePositionStatement fn ln -> do+            writeIndent+            write "/* "+            write fn+            write ":"+            write $ show ln+            write " */"+            writeNewline  writeIf :: Statement -> PWS () writeIf (IfStatement cond true false) = do@@ -180,41 +195,68 @@                 writeIndentedLn "}"  writeLet :: String -> Expression -> Statement -> PWS ()-writeLet identifier expr stmt = do-    writeWithScope identifier (writeExpression expr) stmt+writeLet identifier expr stmt =+    writeWithScope identifier (writeExpression expr) (writeStatement stmt)   writeFor :: String -> Expression -> Statement -> PWS ()-writeFor identifier expr stmt = do-    writeIndent-    write "_iteree = "-    writeExpression expr-    write ";"-    writeNewline-    writeIndentedLn "for (_index in _iteree) {"-    withIndent $ writeWithScope identifier (write "_iteree[_index]") stmt-    writeIndentedLn "}"+writeFor identifier expr stmt =+    writeFor_ identifier expr $+            withIndent $+            writeWithScope identifier (write "_iteree[_index]") (writeStatement stmt) -writeWithScope :: String -> (PWS ()) -> Statement -> PWS ()-writeWithScope identifier rhs stmt = do+writeForExt :: String -> String -> Expression -> Statement -> PWS ()+writeForExt ident identifier expr stmt =+    writeFor_ identifier expr $+            withIndent $+            writeWithScope ident (write "_index") $+            writeWithScope identifier (write "_iteree[_index]") (writeStatement stmt)++writeFor_ :: String -> Expression -> PWS () -> PWS ()+writeFor_ identifier expr writeInner = do+    writeIndentedLn "(function(){"+    withIndent $ do+        writeIndent+        write "var _iteree = "+        writeExpression expr+        write ";"+        writeNewline+        writeIndentedLn "if (Array.isArray(_iteree)) {"+        withIndent $ do+            writeIndentedLn "for (var _index = 0; _index < _iteree.length; ++_index) {"+            writeInner+            writeIndentedLn "}"+        writeIndentedLn "}"+        writeIndentedLn "else {"+        withIndent $ do+            writeIndentedLn "for (var _index in _iteree) {"+            writeInner+            writeIndentedLn "}"+        writeIndentedLn "}"+    writeIndentedLn "}).apply(this);"++writeWithScope :: String -> (PWS ()) -> (PWS ()) -> PWS ()+writeWithScope identifier rhs inner = do     if identifier == "."         then do             writeIndent-            write "_scope = "+            write "_newscope = "             rhs             write ";"             writeNewline         else do             writeIndent-            write "_scope = {'"+            write "_newscope = {'"             write identifier             write "':"             rhs             write "};"             writeNewline-    writeIndentedLn "_scope.prototype = this;"+    writeIndentedLn "_scope = _merge(this, _newscope);"     writeIndentedLn "(function(){"-    withIndent $ writeStatement stmt+    withIndent $ do+        writeIndentedLn "var _scope = null; var _newscope = null;"+        inner     writeIndentedLn "}).apply(_scope);"  writeSwitch :: Expression -> [(Expression, Statement)] -> PWS ()@@ -242,7 +284,7 @@ writeExpression :: Expression -> PWS () writeExpression expr =     case expr of-        StringLiteral str -> write $ singleQuoteString str+        StringLiteral str -> write $ quoteJavascriptString str          IntLiteral i -> write $ show i         FloatLiteral i -> write $ show i@@ -370,8 +412,8 @@             write "))"  -singleQuoteString :: String -> String-singleQuoteString str =+quoteJavascriptString :: String -> String+quoteJavascriptString str =     "'" ++ escape str ++ "'"     where         escapeChar '\'' = "\\'"

@@ -0,0 +1,164 @@+{-#LANGUAGE TypeSynonymInstances, FlexibleInstances #-}+module Text.HPaco.Writers.JsonLisp+( writeJsonLisp+)+where++import Control.Monad.RWS+import Text.HPaco.AST.AST+import Text.HPaco.AST.Expression+import Text.HPaco.AST.Statement+import Text.HPaco.Writer+import Data.List+import Data.Maybe++-- Stubbing these types for now; we might need them later.+data JsonLispWriterState =+    JsonLispWriterState { jwsAST :: AST+                        }+data WriterOptions = WriterOptions++type JWS = RWS WriterOptions String JsonLispWriterState++writeJsonLisp :: Writer+writeJsonLisp ast =+    let (s, w) = execRWS (write ast) WriterOptions (JsonLispWriterState ast)+    in w++class JWSWrite a where+    write :: a -> JWS ()++instance JWSWrite (JWS ()) where+    write = id++instance JWSWrite String where+    write = tell++instance JWSWrite Statement where+    write = writeStatement++instance JWSWrite Expression where+    write = writeExpression++instance JWSWrite AST where+    write = writeAST++writeIndent :: JWS ()+writeIndent = return ()++wrapList :: JWS a -> JWS a+wrapList inner = do+    write "["+    x <- inner+    write "]"+    return x++writeList :: [JWS ()] -> JWS ()+writeList ws = do+    wrapList $ sequence_ $ intersperse (write ", ") ws++writes :: JWSWrite a => [a] -> JWS ()+writes = writeList . map write++writeWithHead :: JWSWrite b => String -> [b] -> JWS ()+writeWithHead h xs = writeList ((writeExpression $ StringLiteral h):map write xs)++cullStatements stmts =+    catMaybes $ map toMay stmts+    where+        toMay NullStatement = Nothing+        toMay (SourcePositionStatement {}) = Nothing+        toMay x = Just x++writeAST :: AST -> JWS ()+writeAST ast = do+    writeWithHead "progn" (map writeDef (astDefs ast) ++ [ write $ astRootStatement ast ])++writeDef :: (String, Statement) -> JWS ()+writeDef (defName, stmt) = do+    writeWithHead "def" [ write $ StringLiteral defName, write stmt ]+    +writeStatement :: Statement -> JWS ()+writeStatement stmt = do+    writeIndent+    case stmt of+        StatementSequence ss -> writeWithHead "do" $ cullStatements ss+        PrintStatement expr -> writeWithHead "print" [expr]+            -- case expr of+            --     EscapeExpression _ _ -> writeWithHead "print" [expr]+            --     StringLiteral _ -> writeWithHead "print" [expr]+            --     IntLiteral _ -> writeWithHead "print" [expr]+            --     FloatLiteral _ -> writeWithHead "print" [expr]+            --     otherwise -> wrapList $ write "flatten " >> writeWithHead "print" [expr]+        NullStatement -> return ()+        IfStatement expr true false -> writeList [ (write $ StringLiteral "if"), write expr, write true, write false ]+        LetStatement identifier expr stmt -> writeList [ (write $ StringLiteral "let"), write $ StringLiteral identifier, write expr, write stmt ]+        ForStatement iter identifier expr stmt -> writeList [ (write $ StringLiteral "let"), write $ StringLiteral identifier, write expr, write stmt ]+        SwitchStatement masterExpr branches -> writeWithHead "switch" (map writeSwitchBranch branches)+        CallStatement identifier -> do+            writeWithHead "calldef" [StringLiteral identifier]+            -- ast <- gets jwsAST+            -- let body = fromMaybe NullStatement $ lookup identifier $ astDefs ast+            -- writeStatement body+        SourcePositionStatement fn ln -> return ()+        where+            writeSwitchBranch (expr, stmt) = writeWithHead "case" [ write expr, write stmt ]++writeExpression :: Expression -> JWS ()+writeExpression expr =+    case expr of+        StringLiteral str -> write (quoteString str)+        IntLiteral i -> write (show i)+        FloatLiteral f -> write (show f)+        BooleanLiteral True -> write "true"+        BooleanLiteral False -> write "false"+        VariableReference x -> writeWithHead "getval" [StringLiteral x]+        ListExpression xs -> writeWithHead "list" xs+        AListExpression xs -> writeWithHead "alist" $ map writePair xs+        EscapeExpression EscapeHTML x -> writeWithHead "html" [x]+        EscapeExpression EscapeURL x -> writeWithHead "urlencode" [x]+        FunctionCallExpression fn args -> writeWithHead "call" (fn:args)+        BinaryExpression (Flipped op) lhs rhs -> writeExpression $ BinaryExpression op rhs lhs+        BinaryExpression op lhs rhs ->+            let optk = (binaryOperatorToken op) in+            case op of+                OpMember ->+                    writeWithHead optk [ rhs, lhs ]+                otherwise ->+                    writeWithHead optk [ lhs, rhs ]+        UnaryExpression op lhs -> writeWithHead (unaryOperatorToken op) [ lhs ]+        where+            writePair (a, b) = writeWithHead "pair" [a, b]+            binaryOperatorToken :: BinaryOperator -> String+            binaryOperatorToken OpEquals = "eq"+            binaryOperatorToken OpNotEquals = "neq"+            binaryOperatorToken OpLooseEquals = "eq~"+            binaryOperatorToken OpLooseNotEquals = "neq~"+            binaryOperatorToken OpGreater = "gt"+            binaryOperatorToken OpLess = "lt"+            binaryOperatorToken OpNotGreater = "lte"+            binaryOperatorToken OpNotLess = "gte"+            binaryOperatorToken OpPlus = "add"+            binaryOperatorToken OpMinus = "sub"+            binaryOperatorToken OpMul = "mul"+            binaryOperatorToken OpDiv = "div"+            binaryOperatorToken OpMod = "mod"+            binaryOperatorToken OpMember = "getval"+            binaryOperatorToken OpBooleanAnd = "and"+            binaryOperatorToken OpBooleanOr = "or"+            binaryOperatorToken OpBooleanXor = "xor"+            binaryOperatorToken OpInList = "in"+            unaryOperatorToken :: UnaryOperator -> String+            unaryOperatorToken OpNot = "not"+++quoteString :: String -> String+quoteString str =+    "\"" ++ escape str ++ "\""+    where+        escapeChar '\"' = "\\\""+        escapeChar '\n' = "\\n"+        escapeChar '\t' = "\\t"+        escapeChar '\r' = "\\r"+        escapeChar x = [x]+        escape = concat . map escapeChar

@@ -12,6 +12,7 @@ import Data.List (intersperse) import Data.Maybe import Data.Typeable+import Data.Char import Text.HPaco.AST.AST import Text.HPaco.AST.Expression import Text.HPaco.AST.Statement@@ -40,23 +41,24 @@  data OutputMode = PHP | Html +type ScopeMap = [M.Map String String]+ data PHPWriterState =     PHPWriterState { pwsIndent :: Int-                   , pwsLocalScope :: [M.Map String Integer]+                   , pwsLocalScope :: ScopeMap                    , pwsNextLocalVariableID :: Integer                    , pwsAST :: AST                    , pwsOutputMode :: OutputMode+                   , pwsEscapeFilter :: String -> String                    }  defaultPHPWriterState =     PHPWriterState { pwsIndent = 0                    , pwsLocalScope = []                    , pwsNextLocalVariableID = 0-                   , pwsAST = AST-                                { astRootStatement = NullStatement-                                , astDefs = []-                                }+                   , pwsAST = defAST                    , pwsOutputMode = Html+                   , pwsEscapeFilter = id                    }  type PWS = RWS WriterOptions String PHPWriterState@@ -69,12 +71,23 @@ writeAST :: AST -> PWS () writeAST ast = do     writeHeader+    writeDefs $ astDefs ast     writeStatement $ astRootStatement ast     writeFooter  write :: String -> PWS ()-write = tell+write str = do+    f <- gets pwsEscapeFilter+    tell $ f str +withFilter :: (String -> String) -> PWS a -> PWS a+withFilter f ac = do+    f0 <- gets pwsEscapeFilter+    modify (\s -> s { pwsEscapeFilter = f0 . f })+    r <- ac+    modify (\s -> s { pwsEscapeFilter = f0 })+    return r+ getOutputMode :: PWS OutputMode getOutputMode = gets pwsOutputMode @@ -83,7 +96,7 @@     m0 <- getOutputMode     modify (\s -> s { pwsOutputMode = m })     case (m0, m) of-        (Html, PHP) -> write "<?php" >> writeNewline+        (Html, PHP) -> write "<?php "         (PHP, Html) -> write "?>"         otherwise -> return () @@ -99,7 +112,14 @@ popScope :: PWS () popScope = modify (\s -> s { pwsLocalScope = tail (pwsLocalScope s) }) -scopeResolve :: String -> PWS (Maybe Integer)+getScope :: PWS ScopeMap+getScope = gets pwsLocalScope++setScope :: ScopeMap -> PWS ()+setScope newScope = modify (\s -> s { pwsLocalScope = newScope })+++scopeResolve :: String -> PWS (Maybe String) scopeResolve key = do     scopeStack <- gets pwsLocalScope     return $ resolve key scopeStack@@ -124,17 +144,28 @@     modify (\s -> s { pwsNextLocalVariableID = 1 + pwsNextLocalVariableID s })     return id -toVarname :: Integer -> String-toVarname i = "_lv" ++ show i+toVarname :: String -> String+toVarname i = "_lv" ++ i -defineVariable :: String -> PWS Integer+defineVariable :: String -> PWS String defineVariable key = do-    vid <- nextVarID+    vidInt <- nextVarID+    let vid = show vidInt ++ "_" ++ sanitizeIdentifier key     scope <- gets pwsLocalScope >>= \x -> return $ head x     let scope' =  M.insert key vid . M.delete key $ scope     modify (\s -> s { pwsLocalScope = scope':tail (pwsLocalScope s) })     return vid +-- Filter an arbitrary string to become a valid PHP identifier tail+sanitizeIdentifier :: String -> String+sanitizeIdentifier str =+    map sanitizeIdentifierChar str+    where+        sanitizeIdentifierChar c =+            if isAlphaNum c+                then c+                else '_'+ withIndent :: PWS a -> PWS a withIndent a = do     pushIndent@@ -169,7 +200,6 @@     let src = BS8.unpack $(embedFile "snippets/php/preamble.php")     setOutputMode Html     write src-    writeNewline  writeHeader :: PWS () writeHeader = do@@ -177,10 +207,10 @@     includePreamble <- woIncludePreamble `liftM` ask     wrapMode <- woWrapMode `liftM` ask -    setOutputMode PHP-     when includePreamble writePreamble +    setOutputMode PHP+     case wrapMode of         WrapFunction -> do             let funcName =@@ -220,10 +250,41 @@     writeIndentedLn "$_scope = array();"     writePushScope -writePushScope = do-    vid <- resolveVariable "."-    writeIndentedLn $ "$_scope = new _S($" ++ vid ++ ", $_scope);"+writeDefs defs = do+    mapM_ writeDef defs +withSealedScope inner = do+    outerScope <- getScope+    setScope []+    result <- inner+    setScope outerScope+    return result++writeDef (ident, stmt) = do+    setOutputMode PHP+    wrapMode <- woWrapMode `liftM` ask+    writeIndent+    case wrapMode of+        WrapClass -> write "private static $_macro_"+        otherwise -> write "$_macro_"+    write ident+    write " = '"+    writeNewline+    withFilter evalQuoteString $ withIndent $ writeStatement stmt+    setOutputMode PHP+    writeIndentedLn "';"++writePushScope = writePushScopeVar "."++writePushScopeVar var = do+    vid <- resolveVariable var+    let str = if var == "."+                then+                    "$_scope = new _S($" ++ vid ++ ", $_scope);"+                else+                    "$_scope = new _S(array('" ++ var ++ "' => $" ++ vid ++ "), $_scope);"+    writeIndentedLn str+ writePopScope =     writeIndentedLn "if ($_scope instanceof _S) { $_scope = $_scope->p; } else { $_scope = array(); }" @@ -265,12 +326,25 @@         NullStatement -> return ()         IfStatement { } -> writeIf stmt         LetStatement identifier expr stmt -> writeLet identifier expr stmt-        ForStatement identifier expr stmt -> writeFor identifier expr stmt+        ForStatement iter identifier expr stmt -> writeFor iter identifier expr stmt         SwitchStatement masterExpr branches -> writeSwitch masterExpr branches         CallStatement identifier -> do-            ast <- gets pwsAST-            let body = fromMaybe NullStatement $ lookup identifier $ astDefs ast-            writeStatement body+            wrapMode <- woWrapMode `liftM` ask+            writeIndent+            write "eval("+            when (wrapMode == WrapClass) $ write "self::"+            write "$_macro_"+            write identifier+            write ");"+            writeNewline+        SourcePositionStatement fn ln -> do+            writeIndent+            write "/* "+            write fn+            write ":"+            write $ show ln+            write " */"+            writeNewline  writeIf :: Statement -> PWS () writeIf (IfStatement cond true false) = do@@ -290,23 +364,18 @@  writeLet :: String -> Expression -> Statement -> PWS () writeLet identifier expr stmt = do-    writeIndent-    write "$_tmp = "-    writeExpression expr-    write ";"-    writeNewline     pushScope     id <- defineVariable identifier      writeIndent     write "$"     write $ toVarname id-    write " = $_tmp;"+    write " = "+    writeExpression expr+    write ";"     writeNewline -    if identifier == "."-        then writePushScope-        else return ()+    writePushScopeVar identifier      writeStatement stmt @@ -317,13 +386,11 @@     writeNewline      popScope-    if identifier == "."-        then writePopScope-        else return ()+    writePopScope  -writeFor :: String -> Expression -> Statement -> PWS ()-writeFor identifier expr stmt = do+writeFor :: Maybe String -> String -> Expression -> Statement -> PWS ()+writeFor iter identifier expr stmt = do     pushScope     id <- defineVariable identifier @@ -338,16 +405,20 @@     withIndent $ do         writeIndent         write "foreach ($_iteree as $"+        case iter of+            Just k -> do+                kid <- defineVariable k+                write $ toVarname kid+                write " => $"+            otherwise -> return ()         write $ toVarname id         write ") {"         writeNewline          withIndent $ do-            when (identifier == ".")-                writePushScope+            writePushScopeVar identifier             writeStatement stmt-            when (identifier == ".")-                writePushScope+            writePopScope          writeIndentedLn "}" @@ -416,7 +487,7 @@             vid <- maybeResolveVariable vn             write $ maybe                 ("_r($_scope, '" ++ vn ++ "')")-                (\v -> "(isset($" ++ v ++ ") ? $" ++ v ++ " : null)")+                (\v -> "(isset($" ++ v ++ ") ? $" ++ v ++ " : _r($_scope, '" ++ vn ++ "'))")                 vid          EscapeExpression mode e -> do@@ -498,3 +569,10 @@         escapeChar '$' = "\\$"         escapeChar x = [x]         escape = concat . map escapeChar++evalQuoteString :: String -> String+evalQuoteString =+    concat . map escapeChar+    where+        escapeChar '\'' = "\\\'"+        escapeChar x = [x]

@@ -15,9 +15,11 @@ import qualified Data.Variant as V import Data.Maybe import qualified Data.List as List+import qualified Data.List.Split as Split import Control.Monad.State import Safe import Text.HPaco.Writers.Run.Encode+import Text.HPaco.Writers.Run.Library import Text.HPaco.AST import Text.HPaco.AST.AST import Text.HPaco.AST.Statement@@ -65,9 +67,12 @@     runStatement $ if b then true else false runStatement (LetStatement ident expr stmt) =     runExpression expr >>= \e -> withIdentifiedScope ident e (runStatement stmt)-runStatement (ForStatement ident expr stmt) = do+runStatement (ForStatement Nothing ident expr stmt) = do     es <- runExpression expr     sequence_ $ vmap (\e -> withIdentifiedScope ident e (runStatement stmt)) es+runStatement (ForStatement (Just iter) ident expr stmt) = do+    es <- runExpression expr+    sequence_ $ vamap (\(k, v) -> withIdentifiedScope iter k $ withIdentifiedScope ident v (runStatement stmt)) es runStatement (SwitchStatement expr branches) = do     ev <- runExpression expr     tests <- mapM runExpression $ map fst branches@@ -79,6 +84,7 @@     ast <- gets rsAST     let body = fromMaybe NullStatement $ List.lookup identifier $ astDefs ast     runStatement body+runStatement SourcePositionStatement {} = return ()  -- Scope helpers @@ -133,19 +139,11 @@ runExpression (VariableReference varname) = getVar varname runExpression (FunctionCallExpression (VariableReference "library") (libnameExpr:_)) = do     libname <- runExpression libnameExpr-    loadLibrary $ V.flatten libname+    return $ loadLibrary $ V.flatten libname runExpression (FunctionCallExpression fn argExprs) = do     func <- runExpression fn     args <- mapM runExpression argExprs     return $ V.call func args--loadLibrary :: String -> Run Variant-loadLibrary "std" =-    return $-        AList [ ( String "count", wrapf1 (Integer . fromIntegral . List.length . V.toAList) )-              , ( String "join", wrapf (\(sep:lst:_) -> String . List.concat . List.intersperse (V.flatten sep) . map V.flatten . V.values $ lst) )-              ]-loadLibrary other = return Null  applyBinaryOperation :: BinaryOperator -> Variant -> Variant -> Variant applyBinaryOperation OpPlus = (+)

@@ -0,0 +1,50 @@+module Text.HPaco.Writers.Run.Library+    ( loadLibrary+    )+where++import Data.Variant as V+import Data.Variant.ToFrom+import qualified Data.List.Split as Split+import Data.List as List+import Data.Tuple (swap)++join :: String -> [String] -> String+join sep lst = List.concat $ List.intersperse sep lst++split :: String -> String -> [String]+split sep str = Split.splitOn sep str++map_ :: [Variant] -> Variant+map_ (fv:xsv:_) =+    let f = case fv of+                Function ff -> (\a -> ff [a])+                otherwise -> id+        xs = V.values xsv+        ks = V.keys xsv+    in AList $ zip ks $ map f xs+map_ _ = V.Null++zip_ :: [Variant] -> Variant+zip_ (k:v:_) =+    let ka = values k+        kv = values v+    in AList $ zip ka kv+zip_ _ = V.Null++loadLibrary :: String -> Variant+loadLibrary "list" =+        AList [ ( String "count", Function (toVariant . length . toAList . head) )+              , ( String "sort", Function (toVariant . map swap . List.sort . map swap . toAList . head) )+              , ( String "zip", Function zip_ )+              ]+loadLibrary "string" =+        AList [ ( String "join", toVariant join )+              , ( String "split", toVariant split )+              ]+loadLibrary "std" =+        V.merge (loadLibrary "list") (loadLibrary "string")+loadLibrary "fp" =+        AList [ ( String "map", Function map_ )+              ]+loadLibrary other = Null

@@ -1,5 +1,5 @@ name:                hpaco-lib-version:             0.11.0.6+version:             0.16.1.0 synopsis:            Modular template compiler library description:         Template compiler library, compiles template code into                      PHP or Javascript, or interprets it directly.@@ -20,11 +20,18 @@ library   exposed-modules: Text.HPaco.Optimizer                  , Text.HPaco.Readers.Paco+                 , Text.HPaco.Readers.Paco.ParserInternals+                 , Text.HPaco.Readers.Paco.Basics+                 , Text.HPaco.Readers.Paco.Expressions+                 , Text.HPaco.Readers.Paco.Statements                  , Text.HPaco.Writers.Javascript+                 , Text.HPaco.Writers.JsonLisp+                 , Text.HPaco.Writers.Dependencies                  , Text.HPaco.Writers.Run                  , Text.HPaco.Writers.PHP                  , Text.HPaco.Writers.Internal.WrapMode                  , Text.HPaco.Writers.Run.Encode+                 , Text.HPaco.Writers.Run.Library                  , Text.HPaco.AST                  , Text.HPaco.AST.Statement                  , Text.HPaco.AST.Identifier@@ -33,6 +40,7 @@                  , Text.HPaco.Writer                  , Text.HPaco.Reader                  , Data.Variant+                 , Data.Variant.ToFrom   -- other-modules:          build-depends:       base == 4.*                ,       bytestring == 0.9.*

@@ -1,3 +1,20 @@+	var _clone = function (obj){+		if(obj == null || typeof(obj) != 'object')+			return obj;+		var temp = obj.constructor();+		for(var key in obj)+			temp[key] = _clone(obj[key]);+		return temp;+	}+	var _merge = function(p,c) {+		if(c == null || typeof(c) != 'object')+			return c;+		var res = _clone(p);+		for(var key in c)+			res[key] = _clone(c[key]);+		return res;+	}+ 	var _htmlencode = function(str){ 		return String(str) 			.replace(/&/g, '&amp;')@@ -14,6 +31,16 @@ 		} 		return String(str); 	};+	var _a = function(a) {+		if (Array.isArray(a)) return a;+		if (typeof(a) === 'object') {+			var aa = [];+			for (var p in a) {+				aa.push(a[p]);+			}+		}+		return [];+	} 	var _in = function(a,b) { 		if (!Array.isArray(b)){return false;} 		for (var i = 0; i < b.length; ++i) { if (a == b[i]) return true; }@@ -21,10 +48,46 @@ 	}; 	var _loadlib = function (libname) { 		switch (libname) {+			case 'list':+				return {+					'count' : function(a){return _a(a).length;},+					'sort' : function(a){return _a(a).sort();},+					'zip' : function(k,v){+								var ka = _a(k);+								var va = _a(v);+								var o = {};+								for (var i = 0; i < ka.length && i < va.length; ++i) {+									o[ka[i]] = va[i];+								}+								return o;+							}+				};+			case 'string':+				return {+					'join' : function(s,a){return _a(a).join(s);},+					'split' : function(s,a){return _f(a).split(s);}+				}; 			case 'std':+				return _merge(_loadlib('string'), _loadlib('list'));+			case 'fp': 				return {-					'count' : function(a){return a.length;}-,					'join' : function(s,a){return a.join(s);}+					'map' : function(f,a){+						if (Array.isArray(a)) {+							var o = [];+							for (var i = 0; i < a.length; ++i) {+								o.push(f(a[i]));+							}+							return o;+						}+						if (typeof(a) === 'object') {+							var o = {};+							for(p in a) {+								o[p] = f(a[p]);+							}+							return o;+						}+						return null;+					} 				}; 			default: throw new Exception('No such library: ' + libname); 		}

@@ -28,18 +28,17 @@ 		public function __toString() { return '<<function>>'; } 	} }-if (!class_exists('_LL', false)) {-	class _LL {-		public function __invoke($libname) {-			switch ($libname) {-				case 'std':-					return array(-						'count' => new _LF('count'),-						'join' => new _LF('implode'),-					);-				default: throw new Exception('No such library: ' . $libname);-			}+if (!class_exists('_AF', false)) {+	class _AF {+		public function __isset($key) {+			return is_callable($key); 		}+		public function __get($key) {+			if (is_callable($key))+				return new _LF($key);+			else+				return null;+		} 	} } if (!is_callable('_r')) {@@ -71,6 +70,39 @@ 		return (string)$val; 	} }+if (!class_exists('_LL', false)) {+	class _LL {+		 +		public function __invoke($libname) {+			switch ($libname) {+				case 'std':+					return array_merge($this->__invoke('string'), $this->__invoke('list'));+				case 'list':+					return array(+						'count' => new _LF('count'),+						'sort' => new _LF(function($a){sort($a);return $a;}),+						'zip' => new _LF('array_combine'),+					);+				case 'string':+					return array(+						'join' => new _LF(function($sep,$arr){if(!is_array($arr)) return array();return implode(_f($sep),$arr);}),+						'split' => new _LF(function($sep, $str){return explode(_f($sep),_f($str));}),+					);+				case 'fp':+					return array(+						'map' => new _LF(function($f,$a){+												return array_map(+													function($x) use ($f) {return _call($f,array($x));},+													$a);+											}),+						);+				case 'php.all_functions':+					return new _AF();+				default: throw new Exception('No such library: ' . $libname);+			}+		}+	}+} if (!is_callable('_call')) { 	function _call($func, $args) { 		if ($func instanceof FunctionPointer || $func instanceof _LL || $func instanceof _LF) {@@ -79,3 +111,4 @@ 		return null; 	} }+?>