hpaco-lib 0.16.2.0 → 0.18.0.0

raw patch · 16 files changed

+577/−228 lines, 16 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Text/HPaco/AST/AST.hs +32/−1
• Text/HPaco/Optimizer.hs +52/−11
• Text/HPaco/Readers/Capo/Statements.hs +215/−0
• Text/HPaco/Readers/Common.hs +102/−0
• Text/HPaco/Readers/Paco.hs +25/−11
• Text/HPaco/Readers/Paco/Basics.hs +2/−79
• Text/HPaco/Readers/Paco/Expressions.hs +15/−18
• Text/HPaco/Readers/Paco/Include.hs +30/−0
• Text/HPaco/Readers/Paco/Statements.hs +13/−14
• Text/HPaco/Writer.hs +3/−1
• Text/HPaco/Writers/Dependencies.hs +1/−1
• Text/HPaco/Writers/Internal/CodeWriter.hs +1/−1
• Text/HPaco/Writers/Javascript.hs +19/−21
• Text/HPaco/Writers/JsonLisp.hs +10/−13
• Text/HPaco/Writers/PHP.hs +53/−56
• hpaco-lib.cabal +4/−1

@@ -2,10 +2,13 @@  import Text.HPaco.AST.Statement import Text.HPaco.AST.Identifier (Identifier)+import Data.Maybe (fromMaybe) +type Def = (Identifier, Statement)+ data AST =     AST { astRootStatement :: Statement-        , astDefs :: [(Identifier,Statement)]+        , astDefs :: [Def]         , astDeps :: [String]         }         deriving (Show)@@ -16,3 +19,31 @@         , astDefs = []         , astDeps = []         }++walkStatement :: (Statement -> Maybe a) -> Statement -> [a]+walkStatement f stmt =+    case f stmt of+        Just x -> [x]+        Nothing -> recurse+    where recurse =+            case stmt of+                StatementSequence stmts -> concatMap (walkStatement f) stmts+                IfStatement _ tb fb -> walkStatement f tb ++ walkStatement f fb+                LetStatement _ _ s -> walkStatement f s+                ForStatement _ _ _ s -> walkStatement f s+                SwitchStatement _ branches -> concat [ walkStatement f s | (e, s) <- branches ]+                otherwise -> []++mapStatement :: (Statement -> Maybe Statement) -> Statement -> Statement+mapStatement f stmt =+    fromMaybe recurse (f stmt)+    where+        g = mapStatement f+        recurse =+            case stmt of+                StatementSequence stmts -> StatementSequence $ map g stmts+                IfStatement e tb fb -> IfStatement e (g tb) (g fb)+                LetStatement a b s -> LetStatement a b (g s)+                ForStatement a b c s -> ForStatement a b c (g s)+                SwitchStatement e branches -> SwitchStatement e [ (c, g s) | (c, s) <- branches ]+                otherwise -> stmt

@@ -1,22 +1,63 @@+{-#LANGUAGE TupleSections #-} module Text.HPaco.Optimizer-            ( optimize-            )+--            ( optimize+--            ) where  import Text.HPaco.AST.AST import Text.HPaco.AST.Expression import Text.HPaco.AST.Statement import qualified Text.HPaco.Writers.Run as Run-import Data.Variant+import Data.Variant hiding (lookup, elem) import Control.Monad.State+import Control.Applicative import System.IO.Unsafe (unsafePerformIO)+import Text.HPaco.AST.Identifier (Identifier)+import Data.Maybe+import Control.Arrow ( (***) )+import qualified Control.Arrow as Arrow  optimize :: AST -> AST-optimize ast = ast -                { astRootStatement = optimizeStatement . astRootStatement $ ast -                , astDefs = map (\(i, s) -> (i, optimizeStatement s)) . astDefs $ ast-                }+optimize = expandDefs . optimizeASTStatements . optimizeASTDefs +-- Statically expand macros+--++expandDefs :: AST -> AST+expandDefs ast =+    ast { astRootStatement = goStatement [] $ astRootStatement ast+        , astDefs = [ (i, goStatement [i] s) | (i, s) <- astDefs ast ]+        }+    where+        goStatement :: [Identifier] -> Statement -> Statement+        goStatement identPath stmt = fromMaybe stmt $ goRaw identPath stmt++        goRaw :: [Identifier] -> Statement -> Maybe Statement+        goRaw identPath (CallStatement ident) | ident `elem` identPath =+            Just $ CallStatement ident+        goRaw identPath (CallStatement ident) =+            lookup ident (astDefs ast) >>= goRaw (ident:identPath)+        goRaw identPath stmt =+            case stmt of+                PrintStatement _ -> Just stmt+                NullStatement -> Just stmt+                SourcePositionStatement _ _ -> Just stmt+                otherwise -> Nothing++optimizeASTDefs :: AST -> AST+optimizeASTDefs (AST { astRootStatement = rs, astDeps = deps, astDefs = defs }) =+    AST {+        astRootStatement = rs,+        astDeps = deps,+        astDefs = [ (i, optimizeStatement s) | (i, s) <- defs ]+    }++optimizeASTStatements :: AST -> AST+optimizeASTStatements ast =+    ast { astRootStatement = optimizeStatement . astRootStatement $ ast +        , astDefs = map (Arrow.second optimizeStatement) . astDefs $ ast+        }+ optimizeStatement :: Statement -> Statement  -- Reduce constants@@ -36,7 +77,7 @@     let xs' = fusePrints $ filter (/= NullStatement) (map optimizeStatement xs)     in case xs' of         -- flatten nested statement sequences-        (StatementSequence ss):rem -> optimizeStatement . StatementSequence $ ss ++ rem+        StatementSequence ss:rem -> optimizeStatement . StatementSequence $ ss ++ rem         -- reduce statement sequences with only one statement in them down         -- to that single statement         s:[] -> s@@ -64,14 +105,14 @@  optimizeStatement (SwitchStatement e branches) =     let e' = optimizeExpression e-        branches' = map (\(k,v) -> (optimizeExpression k, optimizeStatement v)) branches+        branches' = map (optimizeExpression *** optimizeStatement) branches     in SwitchStatement e' branches'  optimizeStatement s = s   fusePrints :: [Statement] -> [Statement]-fusePrints ((PrintStatement (StringLiteral lhs)):(PrintStatement (StringLiteral rhs)):rem) =+fusePrints (PrintStatement (StringLiteral lhs):PrintStatement (StringLiteral rhs):rem) =     fusePrints $ PrintStatement (StringLiteral $ lhs ++ rhs):fusePrints rem fusePrints (s:rem) = s:fusePrints rem fusePrints [] = []@@ -106,4 +147,4 @@ fromVariant (Double d) = FloatLiteral d fromVariant (Bool b) = BooleanLiteral b fromVariant (List xs) = ListExpression $ map fromVariant xs-fromVariant (AList xs) = AListExpression $ map (\(k,v) -> (fromVariant k, fromVariant v)) xs+fromVariant (AList xs) = AListExpression $ map (fromVariant *** fromVariant) xs

@@ -0,0 +1,215 @@+{-#LANGUAGE TupleSections #-}+module Text.HPaco.Readers.Capo.Statements+( statements, statement )+where++import Control.Monad+import Control.Monad.IO.Class+import Control.Applicative ( (<$>), (<*>) )+import Text.HPaco.Reader+import Text.HPaco.Readers.Paco.Basics+import Text.HPaco.Readers.Paco.ParserInternals+import Text.HPaco.Readers.Common hiding (Parser)+import Text.HPaco.Readers.Paco.Expressions+import Text.HPaco.Readers.Paco.Include+import Text.HPaco.AST.AST+import Text.HPaco.AST.Statement+import Text.HPaco.AST.Expression+import Control.Exception (throw)+import System.IO (withFile, IOMode (ReadMode))+import System.IO.Strict+import System.FilePath++statements :: Parser [Statement]+statements = do+    ss_+    stmts <- manySepBy statement ss_+    ss_+    return stmts++statement =+    try defStatement+    <|> try callStatement+    <|> try letStatement+    <|> standaloneStatement++letStatement = do+    (ident, expr) <- withSemicolon assignment+    ss_+    body <- option [NullStatement] statements+    -- TODO: warn if null statement+    return $ LetStatement ident expr $ StatementSequence body++defStatement = do+    keyword "def"+    ss_+    defName <- identifier+    ss_+    char '='+    ss_+    body <- standaloneStatement+    addDef defName body+    return NullStatement++callStatement = do+    CallStatement <$> withSemicolon identifier++assignment :: Parser (String, Expression)+assignment =+    (,) <$> identifier <*> (betweenSpaces (char '=') >> expression)++betweenSpaces a = do+    ss_+    v <- a+    ss_+    return v++-- A standalone statement can appear at any level of the parse tree; it does+-- not need to be explicitly enclosed in a block.+standaloneStatement =+    try lineComment+    <|> try blockComment+    <|> try printStatement+    <|> try printHtmlStatement+    <|> try printUrlStatement+    <|> try ifStatement+    <|> try withStatement+    <|> try forStatement+    <|> try switchStatement+    <|> try includeStatement+    <|> try block+    <?> "Statement"++lineComment = do+    string "//"+    many (noneOf ['\n'])+    char '\n'+    return NullStatement++blockComment = do+    string "/*"+    manyTill (try (discard blockComment) <|> discard anyChar) (try $ string "*/")+    return NullStatement++printStatement = printStatementBase "print" id+printHtmlStatement = printStatementBase "printHtml" (EscapeExpression EscapeHTML)+printUrlStatement = printStatementBase "printUrl" (EscapeExpression EscapeURL)++printStatementBase kw enc =+    withSemicolon $+        StatementSequence . map (PrintStatement . enc) <$>+            (ss_ >> keyword kw >> ss_ >> (parenthesized  $ manySepBy expression (betweenSpaces $ char ',')))++includeStatement :: Parser Statement+includeStatement = do+    ss_+    keyword "include"+    ss_+    filename <- (parenthesized . betweenSpaces) anyQuotedString+    ss_+    char ';'+    ss_+    performInclude filename Nothing++ifStatement = do+    ss_+    keyword "if"+    cond <- parenthesized expression+    true <- standaloneStatement+    false <- option NullStatement $ try falseBranch+    return $ IfStatement cond true false+    where falseBranch = do+            ss_+            keyword "else"+            assertEndOfWord+            ss_+            standaloneStatement++switchStatement = do+    ss_+    keyword "switch"+    SwitchStatement <$> parenthesized expression <*> switchBody+    where+        switchBody = braced $ many switchCase+        switchCase = do+            ss_+            keyword "case"+            ss_+            expr <- expression+            ss_+            char ':'+            body <- StatementSequence <$> statements+            ss_+            optional $ withSemicolon $ keyword "break"+            ss_+            return (expr, body)+    +withStatement =+    withOrFor "with" letAssignment foldLetStatement+    where+        letAssignment = try assignment <|> try ( (".",) <$> expression)+        foldLetStatement :: [(String, Expression)] -> Statement -> Statement+        foldLetStatement assignments body =+            foldr combineAssignment body assignments+            where combineAssignment (ident, expr) stmt = LetStatement ident expr stmt++forStatement =+    withOrFor "for" forAssignment foldForStatement+    where+        forAssignment = try complexForAssignment <|> try ( (Nothing, ".",) <$> expression )+        complexForAssignment = do+            expr <- expression+            ss_+            discard (keyword "as") <|> discard (string ":")+            ss_+            ident1 <- identifier+            ident2 <- optionMaybe $ do+                            ss_+                            string "=>" <|> string "->"+                            ss_+                            identifier+            case ident2 of+                Nothing -> return (Nothing, ident1, expr)+                Just valIdent -> return (Just ident1, valIdent, expr)+        foldForStatement :: [(Maybe String, String, Expression)] -> Statement -> Statement+        foldForStatement assignments body =+            foldr combineAssignment body assignments+            where combineAssignment (keyIdent, valueIdent, expr) stmt = ForStatement keyIdent valueIdent expr stmt++withOrFor :: String -> Parser a -> ([a] -> Statement -> Statement) -> Parser Statement+withOrFor kw a combine = do+    keyword kw+    assignments <- parenthesized $ manySepBy a (ss_ >> char ',' >> ss_)+    body <- standaloneStatement+    return $ combine assignments body++block = StatementSequence <$> braced statements++keyword :: String -> Parser ()+keyword str = do+    string str+    assertEndOfWord++assertEndOfWord :: Parser ()+assertEndOfWord = notFollowedBy $ letter <|> digit <|> char '_'++withSemicolon :: Parser a -> Parser a+withSemicolon p = do+    v <- p +    ss_ +    char ';' +    return v++parenthesized = bracedWith '(' ')'+braced = bracedWith '{' '}'++bracedWith :: Char -> Char -> Parser a -> Parser a+bracedWith l r p = do+    ss_+    char l+    ss_+    val <- p+    ss_+    char r+    ss_+    return val

@@ -0,0 +1,102 @@+module Text.HPaco.Readers.Common+    ( module Text.Parsec.Combinator+    , module Text.Parsec.Char+    , module Text.Parsec.Prim+    , module Text.Parsec.String+    , Parser+    , ss, ss_+    , discard+    , manySepBy+    , braces+    , identifier+    , path+    , anyQuotedString, singleQuotedString, doubleQuotedString+    , assertStartOfInput+    , assertStartOfLine+    )+where++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++type Parser s a = ParsecT String s IO a++-- Auxiliary parsers++ss :: a -> Parser s a+ss a = skipMany space >> return a++ss_ :: Parser s ()+ss_ = ss ()++braces :: Parser s a -> Parser s a+braces inner = do+    char '{'+    ss_+    v <- inner+    ss_+    char '}'+    return v++identifier :: Parser s 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 s Char+escapedChar = do+    char '\\'+    c2 <- anyChar+    return $ case c2 of+                'n' -> '\n'+                'r' -> '\r'+                'b' -> '\b'+                't' -> '\t'+                otherwise -> c2++discard :: Parser s a -> Parser s ()+discard p = p >> return ()++manySepBy :: Parser s a -> Parser s b -> Parser s [a]+manySepBy elem sep = do+    h <- try elem+    t <- many (try $ sep >> elem)+    return $ h:t++assertStartOfInput :: Parser s ()+assertStartOfInput = do+    pos <- getPosition+    if sourceLine pos == 1 && sourceColumn pos == 1+        then return ()+        else unexpected "start of input"++assertStartOfLine :: Parser s ()+assertStartOfLine = do+    pos <- getPosition+    if sourceColumn pos == 1+        then return ()+        else unexpected "start of line"++path :: Parser s String+path = many1 $ try $ noneOf " \t\r\n%()"

@@ -1,5 +1,6 @@ module Text.HPaco.Readers.Paco     ( readPaco+    , readCapo     ) where @@ -8,7 +9,8 @@ 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.Readers.Paco.Statements as PacoStatements+import Text.HPaco.Readers.Capo.Statements as CapoStatements import Text.HPaco.AST.AST import Text.HPaco.AST.Statement import Text.HPaco.AST.Expression@@ -17,28 +19,40 @@ import System.IO.Strict import System.FilePath -readPaco :: Reader-readPaco filename =+readPaco = readRaw pacoDocument+readCapo = readRaw capoDocument++readRawAuto parser filename =+    case (takeExtension filename) of+        ".capo" -> readCapo filename+        ".paco" -> readPaco filename+        otherwise -> readRaw parser filename++readRaw :: Parser AST -> Reader+readRaw parser filename =     let pstate = defaultPacoState                     { psBasePath = takeDirectory filename                     , psIncludeExtension = renull $ takeExtension filename-                    , psHandleInclude = readPaco+                    , psHandleInclude = readRawAuto parser                     }-    in readPacoWithState pstate filename+    in readRawWithState parser pstate filename     where renull "" = Nothing           renull x = Just x -readPacoWithState :: PacoState -> Reader-readPacoWithState pstate filename src = do-    result <- runParserT document pstate filename src+readRawWithState :: Parser AST -> PacoState -> Reader+readRawWithState parser pstate filename src = do+    result <- runParserT parser pstate filename src     either         throw         return         result -document :: Parser AST-document = do-    stmts <- statements+pacoDocument = document PacoStatements.statements+capoDocument = document CapoStatements.statements++document :: Parser [Statement] -> Parser AST+document pstatements = do+    stmts <- pstatements     eof     pstate <- getState     return $ AST 

@@ -3,17 +3,12 @@     , module Text.Parsec.Char     , module Text.Parsec.Prim     , module Text.Parsec.String-    , ss, ss_-    , braces-    , identifier-    , anyQuotedString, singleQuotedString, doubleQuotedString-    , discard-    , manySepBy-    , assertStartOfLine, assertStartOfInput+    , module Text.HPaco.Readers.Common     ) where  import Text.HPaco.Readers.Paco.ParserInternals+import Text.HPaco.Readers.Common hiding (Parser) import Text.Parsec.Char import Text.Parsec.Combinator import Text.Parsec.Pos (SourcePos, sourceLine, sourceColumn, sourceName)@@ -21,75 +16,3 @@ 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"

@@ -4,9 +4,7 @@ where  import Control.Monad-import Text.HPaco.Readers.Paco.Basics-import Text.HPaco.Readers.Paco.ParserInternals-import Text.HPaco.AST.Statement+import Text.HPaco.Readers.Common import Text.HPaco.AST.Expression  expression = booleanExpression@@ -46,10 +44,9 @@         [("*", OpMul), ("/", OpDiv), ("%", OpMod)]         (try traditionalFunctionCallExpression <|> postfixExpression) -binaryExpression :: [(String, BinaryOperator)] -> (Parser Expression) -> Parser Expression+binaryExpression :: [(String, BinaryOperator)] -> Parser s Expression -> Parser s Expression binaryExpression opMap innerParser = do-    let rem :: Parser (BinaryOperator, Expression)-        rem = do+    let rem = do             ss_             opStr <- foldl1 (<|>) $ map (try . string . fst) opMap             ss_@@ -93,13 +90,13 @@         <|> try indexPostfix         <|> try functionCallPostfix -memberAccessPostfix :: Parser (Expression -> Expression)+memberAccessPostfix :: Parser s (Expression -> Expression) memberAccessPostfix = do     char '.'     expr <- StringLiteral `liftM` identifier     return $ \l -> BinaryExpression OpMember l expr -indexPostfix :: Parser (Expression -> Expression)+indexPostfix :: Parser s (Expression -> Expression) indexPostfix = do     ss_     char '['@@ -108,7 +105,7 @@     ss_     return $ \l -> BinaryExpression OpMember l e -functionCallPostfix :: Parser (Expression -> Expression)+functionCallPostfix :: Parser s (Expression -> Expression) functionCallPostfix = do     char '('     args <- manySepBy (try expression) (try $ ss_ >> char ',' >> ss_)@@ -116,7 +113,7 @@     char ')'     return $ \l -> FunctionCallExpression l args -simpleExpression :: Parser Expression+simpleExpression :: Parser s Expression simpleExpression  =  floatLiteral                  <|> intLiteral                  <|> stringLiteral@@ -125,7 +122,7 @@                  <|> varRefExpr                  <|> bracedExpression -bracedExpression :: Parser Expression+bracedExpression :: Parser s Expression bracedExpression = do     char '('     ss_@@ -134,7 +131,7 @@     char ')'     return inner -listExpression :: Parser Expression+listExpression :: Parser s Expression listExpression = do     char '['     ss_@@ -144,7 +141,7 @@     char ']'     return $ ListExpression items -alistExpression :: Parser Expression+alistExpression :: Parser s Expression alistExpression = do     char '{'     ss_@@ -154,7 +151,7 @@     char '}'     return $ AListExpression items     where-        elem :: Parser (Expression, Expression)+        elem :: Parser s (Expression, Expression)         elem = do             ss_             key <- expression@@ -163,14 +160,14 @@             ss_             return (key, value) -intLiteral :: Parser Expression+intLiteral :: Parser s 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 :: Parser s Expression floatLiteral = do     str <- (try dpd <|> try pd)     return . FloatLiteral . read $ str@@ -189,12 +186,12 @@             let str = "0." ++ fracpart             return $ if sign == '-' then sign:str else str -stringLiteral :: Parser Expression+stringLiteral :: Parser s Expression stringLiteral = do     str <- anyQuotedString     return . StringLiteral $ str -varRefExpr :: Parser Expression+varRefExpr :: Parser s Expression varRefExpr = do     id <- (string "." <|> identifier)     return $ VariableReference id

@@ -0,0 +1,30 @@+module Text.HPaco.Readers.Paco.Include+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.HPaco.AST.Identifier++performInclude :: String -> Maybe (Identifier, Expression) -> Parser Statement+performInclude basename innerContext = do+    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+

@@ -11,10 +11,13 @@ import Text.HPaco.Readers.Paco.Basics import Text.HPaco.Readers.Paco.ParserInternals import Text.HPaco.Readers.Paco.Expressions+import Text.HPaco.Readers.Paco.Include+import Text.HPaco.Readers.Common hiding (Parser) import Text.HPaco.AST.AST import Text.HPaco.AST.Statement import Text.HPaco.AST.Expression import Text.Parsec.Pos (SourcePos, sourceLine, sourceColumn, sourceName)+import qualified Text.HPaco.Readers.Capo.Statements as CapoStatements  statements :: Parser [Statement] statements =@@ -28,6 +31,7 @@ statement = try ifStatement            <|> try withStatement           <|> try switchStatement+          <|> try inlineCapoStatement           <|> try forStatement           <|> try defStatement           <|> try callStatement@@ -54,20 +58,8 @@ 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+    performInclude basename innerContext     where-        path :: Parser String-        path = many1 $ try $ noneOf " \t\r\n%"-         inner :: Parser (String, Maybe (String, Expression))         inner = do             basename <- path@@ -75,6 +67,7 @@             innerContext <- optionMaybe $ try (ss_ >> string "with" >> ss_ >> letPair)             return (basename, innerContext) + interpolateStatement :: Parser Statement interpolateStatement = do     char '{'@@ -122,6 +115,13 @@                     stmts <- statements                     return . StatementSequence $ stmts +inlineCapoStatement :: Parser Statement+inlineCapoStatement = do+    simpleTag "capo"+    stmts <- CapoStatements.statements+    simpleTag "endcapo"+    return $ StatementSequence stmts+ withStatement :: Parser Statement withStatement = withOrForStatement (\(n,v) -> LetStatement n v) "with" letPairs @@ -232,4 +232,3 @@ escapeMode :: Parser (Maybe EscapeMode) escapeMode = (char '!' >> return Nothing)           <|> (char '@' >> return (Just EscapeURL))-

@@ -21,6 +21,7 @@                   , woWrapMode :: WrapMode                   , woExposeAllFunctions :: Bool                   , woWriteFunc :: String+                  , woSourcePositionComments :: Bool                   }  defaultWriterOptions =@@ -31,8 +32,9 @@                   , woWrapMode = WrapNone                   , woExposeAllFunctions = False                   , woWriteFunc = ""+                  , woSourcePositionComments = False                   }  instance CodeWriterOptions WriterOptions where     cwoIndent = woIndentStr-    cwoNewline = \_ -> "\n"+    cwoNewline = const "\n"

@@ -5,4 +5,4 @@  writeDependencies :: String -> AST -> String writeDependencies fn ast =-    fn ++ ": " ++ (concat $ intersperse " " (astDeps ast)) ++ "\n"+    fn ++ ": " ++ unwords (astDeps ast) ++ "\n"

@@ -89,7 +89,7 @@ writeIndent = do     indentLevel <- gets cwsGetIndent     indentStr <- asks cwoIndent-    write $ concat $ take indentLevel $ repeat indentStr+    write $ concat $ replicate indentLevel indentStr  endl :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m () endl = asks cwoNewline >>= write

@@ -85,7 +85,8 @@         otherwise -> return ()     writeIndented "(function(){"     pushIndent-    writePreamble+    includePreamble <- asks woIncludePreamble+    when includePreamble writePreamble   writeFooter :: PWS ()@@ -118,19 +119,18 @@         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+        CallStatement identifier ->             writeIndented $ "_macro_" ++ identifier ++ ".apply(this);"         SourcePositionStatement fn ln -> do-            writeIndent-            write "/* "-            write fn-            write ":"-            write $ show ln-            write " */"-            endl+            c <- asks woSourcePositionComments+            when c $ do+                writeIndent+                write "/* "+                write fn+                write ":"+                write $ show ln+                write " */"+                endl  writeIf :: Statement -> PWS () writeIf (IfStatement cond true false) = do@@ -141,12 +141,10 @@     endl     withIndent $ writeStatement true     writeIndented "}"-    if false == NullStatement-        then return ()-        else do-                writeIndented "else {"-                withIndent $ writeStatement false-                writeIndented "}"+    unless (false == NullStatement) $ do+        writeIndented "else {"+        withIndent $ writeStatement false+        writeIndented "}"  writeLet :: String -> Expression -> Statement -> PWS () writeLet identifier expr stmt =@@ -189,7 +187,7 @@         writeIndented "}"     writeIndented "}).apply(this);" -writeWithScope :: String -> (PWS ()) -> (PWS ()) -> PWS ()+writeWithScope :: String -> PWS () -> PWS () -> PWS () writeWithScope identifier rhs inner = do     if identifier == "."         then do@@ -264,7 +262,7 @@                 write " : "                 writeExpression value -        VariableReference vn -> do+        VariableReference vn ->             if vn == "."                 then write "this"                 else do@@ -375,4 +373,4 @@         escapeChar '\t' = "' + \"\\t\" + '"         escapeChar '\r' = "' + \"\\r\" + '"         escapeChar x = [x]-        escape = concat . map escapeChar+        escape = concatMap escapeChar

@@ -53,28 +53,28 @@     return x  writeList :: [JWS ()] -> JWS ()-writeList ws = do+writeList ws =     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)+writeWithHead h xs = writeList (writeExpression (StringLiteral h):map write xs)  cullStatements stmts =-    catMaybes $ map toMay stmts+    mapMaybe toMay stmts     where         toMay NullStatement = Nothing         toMay (SourcePositionStatement {}) = Nothing         toMay x = Just x  writeAST :: AST -> JWS ()-writeAST ast = do+writeAST ast =     writeWithHead "progn" (map writeDef (astDefs ast) ++ [ write $ astRootStatement ast ])  writeDef :: (String, Statement) -> JWS ()-writeDef (defName, stmt) = do+writeDef (defName, stmt) =     writeWithHead "def" [ write $ StringLiteral defName, write stmt ]      writeStatement :: Statement -> JWS ()@@ -90,15 +90,12 @@             --     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 ]+        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+        CallStatement identifier ->             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 ]@@ -160,4 +157,4 @@         escapeChar '\t' = "\\t"         escapeChar '\r' = "\\r"         escapeChar x = [x]-        escape = concat . map escapeChar+        escape = concatMap escapeChar

@@ -60,8 +60,7 @@  writeAST :: AST -> PWS () writeAST ast = do-    writeHeader-    writeDefs $ astDefs ast+    writeHeader ast     writeStatement $ astRootStatement ast     writeFooter @@ -72,7 +71,7 @@ -- open/close tags for you. Should only be used when the PHP tags have been -- written using other means already. unsafeSetOutputMode :: OutputMode -> PWS ()-unsafeSetOutputMode m = do+unsafeSetOutputMode m =     modify (\s -> s { pwsOutputMode = m })  setOutputMode :: OutputMode -> PWS ()@@ -110,7 +109,7 @@     return $ resolve key scopeStack     where         resolve key scopes =-            let mr = catMaybes $ map (M.lookup key) scopes+            let mr = mapMaybe (M.lookup key) scopes             in if null mr then Nothing else (Just . head) mr  resolveVariable :: String -> PWS String@@ -157,8 +156,8 @@     unsafeSetOutputMode PHP     write src -writeHeader :: PWS ()-writeHeader = do+writeHeader :: AST -> PWS ()+writeHeader ast = do     templateName <- woTemplateName `liftM` ask     includePreamble <- woIncludePreamble `liftM` ask     wrapMode <- woWrapMode `liftM` ask@@ -174,6 +173,7 @@                         then "runTemplate"                         else "runTemplate_" ++ templateName             writeLn $ "function " ++ funcName ++ "($context) {"+            withIndent $ writeDefs $ astDefs ast             pushIndent         WrapClass -> do             let className =@@ -181,34 +181,46 @@                         then "Template"                         else "Template_" ++ templateName             writeLn $ "class " ++ className ++ " {"+            writeDefs $ astDefs ast             pushIndent             writeLn $ "public function __invoke($context) {"             pushIndent-        otherwise -> return ()+        otherwise -> writeDefs $ astDefs ast     pushScope     vid <- defineVariable "."     writeLn "if (isset($context)) {"-    withIndent $ do-        writeIndent-        write "$"-        write $ toVarname vid-        write " = $context;"-        endl+    withIndent $ writeVarAssignment vid $ write "$context"     writeLn "}"     writeLn "else {"-    withIndent $ do-        writeIndent-        write "$"-        write $ toVarname vid-        write " = array();"-        endl+    withIndent $ writeVarAssignment vid $ write "array()"     writeLn "}"     writeLn "$_scope = array();"     writePushScope +writeVar vid = do+    write "$"+    write $ toVarname vid++writeVarAssignment vid rhs = writeAssignment (writeVar vid) rhs++writeAssignment lhs rhs = do+    writeIndent+    lhs+    write " = "+    rhs+    write ";"+    endl+     writeDefs defs = do     mapM_ writeDef defs +writeUnsetVar id = do+    writeIndent+    write "unset($"+    write $ toVarname id+    write ");";+    endl+ withSealedScope inner = do     outerScope <- getScope     setScope []@@ -296,14 +308,16 @@             write identifier             write ");"             endl-        SourcePositionStatement fn ln -> return ()-            -- writeIndent-            -- write "/* "-            -- write fn-            -- write ":"-            -- write $ show ln-            -- write " */"-            -- endl+        SourcePositionStatement fn ln -> do+            c <- asks woSourcePositionComments+            when c $ do+                writeIndent+                write "/* "+                write fn+                write ":"+                write $ show ln+                write " */"+                endl  writeIf :: Statement -> PWS () writeIf (IfStatement cond true false) = do@@ -326,23 +340,13 @@     pushScope     id <- defineVariable identifier -    writeIndent-    write "$"-    write $ toVarname id-    write " = "-    writeExpression expr-    write ";"-    endl+    writeVarAssignment id $ writeExpression expr      writePushScopeVar identifier      writeStatement stmt -    writeIndent-    write "unset($"-    write $ toVarname id-    write ");";-    endl+    writeUnsetVar id      popScope     writePopScope@@ -351,16 +355,12 @@ writeFor :: Maybe String -> String -> Expression -> Statement -> PWS () writeFor iter identifier expr stmt = do     pushScope-    id <- defineVariable identifier -    writeIndent-    write "$_iteree = "-    writeExpression expr-    write ";"-    endl+    writeAssignment (write "$_iteree") (writeExpression expr)      writeLn "if (is_array($_iteree) || ($_iteree instanceof Traversable)) {" +    id <- defineVariable identifier     withIndent $ do         writeIndent         write "foreach ($_iteree as $"@@ -381,11 +381,7 @@          writeLn "}" -        writeIndent-        write "unset($"-        write $ toVarname id-        write ");";-        endl+        writeUnsetVar id      writeLn "}" @@ -464,16 +460,12 @@          BinaryExpression OpMember left right -> do             write "_r("-            writeExpression left-            write ", "-            writeExpression right+            writeExpressionPair left right             write ")"          BinaryExpression OpInList left right -> do             write "_in("-            writeExpression left-            write ", "-            writeExpression right+            writeExpressionPair left right             write ")"          BinaryExpression o left right -> do@@ -513,6 +505,11 @@             mapM_ (\e -> writeExpression e >> write ", ") args             write "))" +writeExpressionPair :: Expression -> Expression -> PWS ()+writeExpressionPair lhs rhs = do+    writeExpression lhs+    write ","+    writeExpression rhs  singleQuoteString :: String -> String singleQuoteString str =

@@ -1,5 +1,5 @@ name:                hpaco-lib-version:             0.16.2.0+version:             0.18.0.0 synopsis:            Modular template compiler library description:         Template compiler library, compiles template code into                      PHP or Javascript, or interprets it directly.@@ -19,11 +19,14 @@  library   exposed-modules: Text.HPaco.Optimizer+                 , Text.HPaco.Readers.Common                  , 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.Readers.Paco.Include+                 , Text.HPaco.Readers.Capo.Statements                  , Text.HPaco.Writers.Javascript                  , Text.HPaco.Writers.JsonLisp                  , Text.HPaco.Writers.Dependencies