hpaco-lib 0.22.0.0 → 0.22.4.0

raw patch · 2 files changed

+62/−122 lines, 2 filesdep +aesondep ~splitPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: aeson

Dependency ranges changed: split

API changes (from Hackage documentation)

Files

• Text/HPaco/Writers/JsonLisp.hs +59/−120
• hpaco-lib.cabal +3/−2

@@ -11,121 +11,34 @@ 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-                        }--type JWS = RWS WriterOptions String JsonLispWriterState--writeJsonLisp :: Writer-writeJsonLisp ast =-    let (s, w) = execRWS (write ast) defaultWriterOptions (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 =-    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 =-    mapMaybe toMay stmts-    where-        toMay NullStatement = Nothing-        toMay (SourcePositionStatement {}) = Nothing-        toMay x = Just x--writeAST :: AST -> JWS ()-writeAST ast =-    writeWithHead "progn" (map writeDef (astDefs ast) ++ [ write $ astRootStatement ast ])+import Data.Aeson+import Data.ByteString.Lazy.Char8 (unpack) -writeDef :: (String, Statement) -> JWS ()-writeDef (defName, stmt) =-    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 ->-            writeWithHead "calldef" [StringLiteral identifier]-        SourcePositionStatement fn ln -> return ()-        where-            writeSwitchBranch (expr, stmt) = writeWithHead "case" [ write expr, write stmt ]+(<:>) :: (ToJSON a, ToJSON b) => a -> [b] -> [Value]+x <:> xs = toJSON x : map toJSON xs+infixr 4 <:> -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)-        TernaryExpression expr true false -> writeList [ write $ StringLiteral "if", write expr, write true, write false ]-        BinaryExpression (Flipped op) lhs rhs -> writeExpression $ BinaryExpression op rhs lhs+instance ToJSON Expression where+    toJSON expr = toJSON $ case expr of+        StringLiteral str -> toJSON str+        IntLiteral i -> toJSON i+        FloatLiteral f -> toJSON f+        BooleanLiteral b -> toJSON b+        VariableReference x -> toJSON ("getval", x)+        ListExpression xs -> toJSON $ "list" <:> xs+        AListExpression xs -> toJSON $ "alist" <:> xs+        EscapeExpression EscapeHTML x -> toJSON $ ("html", x)+        EscapeExpression EscapeURL x -> toJSON $ ("urlencode", x)+        FunctionCallExpression fn args -> toJSON $ "call" <:> fn <:> args+        TernaryExpression expr true false -> toJSON $ ("if", expr, true, false)+        BinaryExpression (Flipped op) lhs rhs -> toJSON $ 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 ]+            toJSON $ case op of+                OpMember -> (optk, rhs, lhs)+                otherwise -> (optk, lhs, rhs)+        UnaryExpression op lhs -> toJSON (unaryOperatorToken op, lhs)         where-            writePair (a, b) = writeWithHead "pair" [a, b]             binaryOperatorToken :: BinaryOperator -> String             binaryOperatorToken OpEquals = "eq"             binaryOperatorToken OpNotEquals = "neq"@@ -150,14 +63,40 @@             unaryOperatorToken :: UnaryOperator -> String             unaryOperatorToken OpNot = "not" +instance ToJSON Statement where+    toJSON stmt = toJSON $ case stmt of+        StatementSequence ss -> toJSON $ "do" <:> cullStatements ss+        PrintStatement expr -> toJSON $ ("print", expr)+        IfStatement expr true false -> toJSON $ ("if", expr, true, false)+        LetStatement identifier expr stmt -> toJSON $ ("let", identifier, expr, stmt)+        ForStatement iter identifier expr stmt -> toJSON $ "for" <:> iter <:> identifier <:> expr <:> [stmt]+        SwitchStatement masterExpr branches -> +            toJSON $ "switch" <:> masterExpr <:> [ ("case", e, s) | (e,s) <- branches ]+        CallStatement identifier -> toJSON $ ("calldef", identifier)+        SourcePositionStatement fn ln -> Null+        NullStatement -> toJSON ["nop"] -quoteString :: String -> String-quoteString str =-    "\"" ++ escape str ++ "\""-    where-        escapeChar '\"' = "\\\""-        escapeChar '\n' = "\\n"-        escapeChar '\t' = "\\t"-        escapeChar '\r' = "\\r"-        escapeChar x = [x]-        escape = concatMap escapeChar+instance ToJSON (String, Statement) where+    toJSON (name, body) = toJSON $ "def" <:> name <:> [body]++instance ToJSON AST where+    toJSON AST { astRootStatement = stmt, astDefs = defs } =+        toJSON $ (toJSON "progn" <:> map toJSON defs) ++ [toJSON stmt]++cullStatements stmts =+    mapMaybe toMay stmts+        where+            toMay NullStatement = Nothing+            toMay (SourcePositionStatement {}) = Nothing+            toMay (StatementSequence []) = Nothing+            toMay x = Just x++-- Stubbing these types for now; we might need them later.+data JsonLispWriterState =+    JsonLispWriterState { jwsAST :: AST+                        }++type JWS = RWS WriterOptions String JsonLispWriterState++writeJsonLisp :: Writer+writeJsonLisp = unpack . encode . toJSON

@@ -1,5 +1,5 @@ name:                hpaco-lib-version:             0.22.0.0+version:             0.22.4.0 synopsis:            Modular template compiler library description:         Template compiler library, compiles template code into                      PHP or Javascript, or interprets it directly.@@ -54,6 +54,7 @@                ,       transformers == 0.3.*                ,       strict == 0.3.*                ,       filepath >= 1.1 && < 1.4-               ,       split >= 0.1 && < 0.2+               ,       split >= 0.1 && < 0.3                ,       safe >= 0.3.3 && < 0.4                ,       file-embed == 0.0.4.*+               ,       aeson == 0.6.*