packages feed

hpaco-lib 0.16.1.0 → 0.16.2.0

raw patch · 7 files changed

+316/−233 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Text.HPaco.Writers.Javascript: WriterOptions :: Bool -> String -> String -> WrapMode -> Bool -> String -> WriterOptions
- Text.HPaco.Writers.Javascript: data WriterOptions
- Text.HPaco.Writers.Javascript: defaultWriterOptions :: WriterOptions
- Text.HPaco.Writers.Javascript: woExposeAllFunctions :: WriterOptions -> Bool
- Text.HPaco.Writers.Javascript: woIndentStr :: WriterOptions -> String
- Text.HPaco.Writers.Javascript: woPrettyPrint :: WriterOptions -> Bool
- Text.HPaco.Writers.Javascript: woTemplateName :: WriterOptions -> String
- Text.HPaco.Writers.Javascript: woWrapMode :: WriterOptions -> WrapMode
- Text.HPaco.Writers.Javascript: woWriteFunc :: WriterOptions -> String
- Text.HPaco.Writers.PHP: WriterOptions :: Bool -> String -> String -> Bool -> WrapMode -> Bool -> WriterOptions
- Text.HPaco.Writers.PHP: data WriterOptions
- Text.HPaco.Writers.PHP: defaultWriterOptions :: WriterOptions
- Text.HPaco.Writers.PHP: woExposeAllFunctions :: WriterOptions -> Bool
- Text.HPaco.Writers.PHP: woIncludePreamble :: WriterOptions -> Bool
- Text.HPaco.Writers.PHP: woIndentStr :: WriterOptions -> String
- Text.HPaco.Writers.PHP: woPrettyPrint :: WriterOptions -> Bool
- Text.HPaco.Writers.PHP: woTemplateName :: WriterOptions -> String
- Text.HPaco.Writers.PHP: woWrapMode :: WriterOptions -> WrapMode
+ Text.HPaco.Writer: WriterOptions :: Bool -> String -> String -> Bool -> WrapMode -> Bool -> String -> WriterOptions
+ Text.HPaco.Writer: data WriterOptions
+ Text.HPaco.Writer: defaultWriterOptions :: WriterOptions
+ Text.HPaco.Writer: instance CodeWriterOptions WriterOptions
+ Text.HPaco.Writer: woExposeAllFunctions :: WriterOptions -> Bool
+ Text.HPaco.Writer: woIncludePreamble :: WriterOptions -> Bool
+ Text.HPaco.Writer: woIndentStr :: WriterOptions -> String
+ Text.HPaco.Writer: woPrettyPrint :: WriterOptions -> Bool
+ Text.HPaco.Writer: woTemplateName :: WriterOptions -> String
+ Text.HPaco.Writer: woWrapMode :: WriterOptions -> WrapMode
+ Text.HPaco.Writer: woWriteFunc :: WriterOptions -> String
+ Text.HPaco.Writers.Internal.CodeWriter: class CodeWriterOptions o
+ Text.HPaco.Writers.Internal.CodeWriter: class CodeWriterState s
+ Text.HPaco.Writers.Internal.CodeWriter: cwoIndent :: CodeWriterOptions o => o -> String
+ Text.HPaco.Writers.Internal.CodeWriter: cwoNewline :: CodeWriterOptions o => o -> String
+ Text.HPaco.Writers.Internal.CodeWriter: cwsGetFilters :: CodeWriterState s => s -> [Filter]
+ Text.HPaco.Writers.Internal.CodeWriter: cwsGetIndent :: CodeWriterState s => s -> Int
+ Text.HPaco.Writers.Internal.CodeWriter: cwsSetFilters :: CodeWriterState s => [Filter] -> s -> s
+ Text.HPaco.Writers.Internal.CodeWriter: cwsSetIndent :: CodeWriterState s => Int -> s -> s
+ Text.HPaco.Writers.Internal.CodeWriter: endl :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m ()
+ Text.HPaco.Writers.Internal.CodeWriter: popFilter :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m ()
+ Text.HPaco.Writers.Internal.CodeWriter: popIndent :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m ()
+ Text.HPaco.Writers.Internal.CodeWriter: pushFilter :: (Monad m, CodeWriterOptions o, CodeWriterState s) => (String -> String) -> CodeWriterT o s m ()
+ Text.HPaco.Writers.Internal.CodeWriter: pushIndent :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m ()
+ Text.HPaco.Writers.Internal.CodeWriter: runCodeWriter :: (CodeWriterOptions o, CodeWriterState s) => CodeWriter o s () -> o -> s -> String
+ Text.HPaco.Writers.Internal.CodeWriter: runCodeWriterT :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m () -> o -> s -> m String
+ Text.HPaco.Writers.Internal.CodeWriter: type CodeWriter o s a = RWS o String s a
+ Text.HPaco.Writers.Internal.CodeWriter: withBraces :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m a -> CodeWriterT o s m a
+ Text.HPaco.Writers.Internal.CodeWriter: withBracesLn :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m a -> CodeWriterT o s m a
+ Text.HPaco.Writers.Internal.CodeWriter: withBrackets :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m a -> CodeWriterT o s m a
+ Text.HPaco.Writers.Internal.CodeWriter: withBracketsLn :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m a -> CodeWriterT o s m a
+ Text.HPaco.Writers.Internal.CodeWriter: withFilter :: (Monad m, CodeWriterOptions o, CodeWriterState s) => (String -> String) -> CodeWriterT o s m a -> CodeWriterT o s m a
+ Text.HPaco.Writers.Internal.CodeWriter: withIndent :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m a -> CodeWriterT o s m a
+ Text.HPaco.Writers.Internal.CodeWriter: withParens :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m a -> CodeWriterT o s m a
+ Text.HPaco.Writers.Internal.CodeWriter: withParensLn :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m a -> CodeWriterT o s m a
+ Text.HPaco.Writers.Internal.CodeWriter: write :: (Monad m, CodeWriterOptions o, CodeWriterState s) => String -> CodeWriterT o s m ()
+ Text.HPaco.Writers.Internal.CodeWriter: writeIndent :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m ()
+ Text.HPaco.Writers.Internal.CodeWriter: writeIndented :: (Monad m, CodeWriterOptions o, CodeWriterState s) => String -> CodeWriterT o s m ()
+ Text.HPaco.Writers.Internal.CodeWriter: writeLn :: (Monad m, CodeWriterOptions o, CodeWriterState s) => String -> CodeWriterT o s m ()
+ Text.HPaco.Writers.Javascript: defJsWriterOptions :: WriterOptions
+ Text.HPaco.Writers.Javascript: instance CodeWriterState JavascriptWriterState
+ Text.HPaco.Writers.PHP: defPHPWriterOptions :: WriterOptions
+ Text.HPaco.Writers.PHP: instance CodeWriterState PHPWriterState

Files

Text/HPaco/Writer.hs view
@@ -1,8 +1,38 @@-module Text.HPaco.Writer (Writer) where+module Text.HPaco.Writer +    ( Writer+    , WriterOptions (..)+    , defaultWriterOptions+    ) where  import Text.HPaco.AST (AST)+import Text.HPaco.Writers.Internal.WrapMode+import Text.HPaco.Writers.Internal.CodeWriter  data WriterError =     WriterError { writerErrorMessage :: String }     deriving (Show) type Writer = AST -> String++data WriterOptions =+    WriterOptions { woPrettyPrint :: Bool+                  , woIndentStr :: String+                  , woTemplateName :: String+                  , woIncludePreamble :: Bool+                  , woWrapMode :: WrapMode+                  , woExposeAllFunctions :: Bool+                  , woWriteFunc :: String+                  }++defaultWriterOptions =+    WriterOptions { woPrettyPrint = False+                  , woIndentStr = "\t"+                  , woTemplateName = ""+                  , woIncludePreamble = True+                  , woWrapMode = WrapNone+                  , woExposeAllFunctions = False+                  , woWriteFunc = ""+                  }++instance CodeWriterOptions WriterOptions where+    cwoIndent = woIndentStr+    cwoNewline = \_ -> "\n"
+ Text/HPaco/Writers/Internal/CodeWriter.hs view
@@ -0,0 +1,144 @@+module Text.HPaco.Writers.Internal.CodeWriter+    ( CodeWriter+    , CodeWriterOptions (..)+    , CodeWriterState (..)+    , runCodeWriterT+    , runCodeWriter+    , write+    , writeIndent+    , writeIndented+    , writeLn+    , endl+    , pushIndent+    , popIndent+    , pushFilter+    , popFilter+    , withIndent+    , withFilter+    , withParens+    , withBrackets+    , withBraces+    , withParensLn+    , withBracketsLn+    , withBracesLn+    )+where++import Control.Monad.Identity+import Control.Monad.RWS+import Control.Monad.IO.Class+import Data.Monoid+import Safe+import Data.List++type CodeWriterT o s m a = RWST o String s m a+type CodeWriter o s a = RWS o String s a+-- CodeWriterT o s Identity a++class CodeWriterOptions o where+    cwoIndent :: o -> String+    cwoNewline :: o -> String++type Filter = String -> String++class CodeWriterState s where+    cwsGetIndent :: s -> Int+    cwsSetIndent :: Int -> s -> s+    cwsGetFilters :: s -> [ Filter ]+    cwsSetFilters :: [ Filter ] -> s -> s++cwsModifyIndent :: CodeWriterState s => Int -> s -> s+cwsModifyIndent d s = cwsSetIndent (cwsGetIndent s + d) s++cwsIncreaseIndent :: CodeWriterState s => s -> s+cwsIncreaseIndent = cwsModifyIndent 1++cwsDecreaseIndent :: CodeWriterState s => s -> s+cwsDecreaseIndent = cwsModifyIndent (-1)++cwsPushFilter x s =+    let xs = cwsGetFilters s+    in cwsSetFilters (x:xs) s++cwsPopFilter s =+    let x:xs = cwsGetFilters s+    in cwsSetFilters xs s++runCodeWriterT :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m () -> o -> s -> m String+runCodeWriterT a opts s = do+    (s, w) <- execRWST a opts s+    return w++runCodeWriter :: (CodeWriterOptions o, CodeWriterState s) => CodeWriter o s () -> o -> s -> String+runCodeWriter a o s =+    let (_, w) = execRWS a o s+    in w++write :: (Monad m, CodeWriterOptions o, CodeWriterState s) => String -> CodeWriterT o s m ()+write str = do+    filter <- foldl (.) id `liftM` gets cwsGetFilters+    tell $ filter str++writeLn :: (Monad m, CodeWriterOptions o, CodeWriterState s) => String -> CodeWriterT o s m ()+writeLn = between writeIndent endl . write++writeIndented :: (Monad m, CodeWriterOptions o, CodeWriterState s) => String -> CodeWriterT o s m ()+writeIndented str = writeIndent >> write str++writeIndent :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m ()+writeIndent = do+    indentLevel <- gets cwsGetIndent+    indentStr <- asks cwoIndent+    write $ concat $ take indentLevel $ repeat indentStr++endl :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m ()+endl = asks cwoNewline >>= write++pushIndent :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m ()+pushIndent = modify cwsIncreaseIndent++popIndent :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m ()+popIndent = modify cwsDecreaseIndent++pushFilter :: (Monad m, CodeWriterOptions o, CodeWriterState s) => (String -> String) -> CodeWriterT o s m ()+pushFilter f = modify (cwsPushFilter f)++popFilter :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m ()+popFilter = modify cwsPopFilter++surroundedBy :: (Monad m, CodeWriterOptions o, CodeWriterState s) => String -> String -> CodeWriterT o s m a -> CodeWriterT o s m a +surroundedBy l r = between (write l) (write r)++surroundedByLn :: (Monad m, CodeWriterOptions o, CodeWriterState s) => String -> String -> CodeWriterT o s m a -> CodeWriterT o s m a +surroundedByLn l r = between (writeLn l) (writeLn r)++between :: (Monad m, CodeWriterOptions o) => CodeWriterT o s m () -> CodeWriterT o s m () -> CodeWriterT o s m a -> CodeWriterT o s m a+between l r a = do+    l+    x <- a+    r+    return x++withIndent :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m a -> CodeWriterT o s m a +withIndent = between pushIndent popIndent++withFilter :: (Monad m, CodeWriterOptions o, CodeWriterState s) => (String -> String) -> CodeWriterT o s m a -> CodeWriterT o s m a+withFilter f = between (pushFilter f) popFilter++withParens :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m a -> CodeWriterT o s m a +withParens = surroundedBy "(" ")"++withBrackets :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m a -> CodeWriterT o s m a +withBrackets = surroundedBy "[" "]"++withBraces :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m a -> CodeWriterT o s m a +withBraces = surroundedBy "{" "}"++withParensLn :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m a -> CodeWriterT o s m a +withParensLn = surroundedByLn "(" ")"++withBracketsLn :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m a -> CodeWriterT o s m a +withBracketsLn = surroundedByLn "[" "]"++withBracesLn :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m a -> CodeWriterT o s m a +withBracesLn = surroundedByLn "{" "}"
Text/HPaco/Writers/Javascript.hs view
@@ -1,8 +1,7 @@ {-#LANGUAGE TemplateHaskell #-} module Text.HPaco.Writers.Javascript     ( writeJavascript-    , WriterOptions (..)-    , defaultWriterOptions+    , defJsWriterOptions     , WrapMode (..)     ) where@@ -17,26 +16,12 @@ import Text.HPaco.AST.Statement import Text.HPaco.Writer import Text.HPaco.Writers.Internal.WrapMode+import Text.HPaco.Writers.Internal.CodeWriter import qualified Data.ByteString.Char8 as BS8 import qualified Data.Map as M -data WriterOptions =-    WriterOptions { woPrettyPrint :: Bool-                  , woIndentStr :: String-                  , woTemplateName :: String-                  , woWrapMode :: WrapMode-                  , woExposeAllFunctions :: Bool-                  , woWriteFunc :: String-                  }--defaultWriterOptions =-    WriterOptions { woPrettyPrint = False-                  , woIndentStr = "\t"-                  , woTemplateName = ""-                  , woWrapMode = WrapNone-                  , woExposeAllFunctions = False-                  , woWriteFunc = "_write"-                  }+defJsWriterOptions =+    defaultWriterOptions { woWriteFunc = "_write" }  data JavascriptWriterState =     JavascriptWriterState@@ -52,6 +37,13 @@  type PWS = RWS WriterOptions String JavascriptWriterState +instance CodeWriterState JavascriptWriterState where+    cwsGetIndent = jwsIndent+    cwsSetIndent f s = s { jwsIndent = f }+    -- stubbing these out for now...+    cwsGetFilters s = []+    cwsSetFilters f = id+ writeJavascript :: WriterOptions -> Writer writeJavascript opts ast =     let (s, w) = execRWS (writeAST ast) opts defaultJavascriptWriterState { jwsAST = ast}@@ -67,53 +59,15 @@ writeDefs = mapM_ writeDef  writeDef (identifier, body) = do-    writeIndentedLn $ "var _macro_" ++ identifier ++ " = function() {"+    writeIndented $ "var _macro_" ++ identifier ++ " = function() {"     withIndent $ writeStatement body-    writeIndentedLn "};"--write :: String -> PWS ()-write = tell--pushIndent :: PWS ()-pushIndent = modify (\s -> s { jwsIndent = jwsIndent s + 1 })--popIndent :: PWS ()-popIndent = modify (\s -> s { jwsIndent = jwsIndent s - 1 })--withIndent :: PWS a -> PWS a-withIndent a = do-    pushIndent-    x <- a-    popIndent-    return x--writeIndent :: PWS ()-writeIndent = do-    pretty <- woPrettyPrint `liftM` ask-    istr <- woIndentStr `liftM` ask-    indent <- gets jwsIndent-    if pretty-        then write $ concat $ take indent $ repeat istr-        else return ()--writeNewline :: PWS ()-writeNewline = do-    pretty <- woPrettyPrint `liftM` ask-    if pretty-        then write "\n"-        else write " "--writeIndented :: String -> PWS ()-writeIndented str = writeIndent >> write str--writeIndentedLn :: String -> PWS ()-writeIndentedLn str = writeIndent >> write str >> writeNewline+    writeIndented "};"  writePreamble :: PWS () writePreamble = do     let src = BS8.unpack $(embedFile "snippets/js/preamble.js")     write src-    writeNewline+    endl  writeHeader :: PWS () writeHeader = do@@ -126,10 +80,10 @@                     if null templateName                         then "runTemplate"                         else "runTemplate_" ++ templateName-            writeIndentedLn $ "function " ++ funcName ++ "(context) {"+            writeIndented $ "function " ++ funcName ++ "(context) {"             pushIndent         otherwise -> return ()-    writeIndentedLn "(function(){"+    writeIndented "(function(){"     pushIndent     writePreamble @@ -139,12 +93,12 @@     wrapMode <- woWrapMode `liftM` ask      popIndent-    writeIndentedLn "}).apply(context);"+    writeIndented "}).apply(context);"      case wrapMode of         WrapFunction -> do             popIndent-            writeIndentedLn "}"+            writeIndented "}"         otherwise -> return ()  writeStatement :: Statement -> PWS ()@@ -157,7 +111,7 @@             write $ wfunc ++ "(_f("             writeExpression expr             write "));"-            writeNewline+            endl         NullStatement -> return ()         IfStatement { } -> writeIf stmt         LetStatement identifier expr stmt -> writeLet identifier expr stmt@@ -168,7 +122,7 @@             -- ast <- gets jwsAST             -- let body = fromMaybe NullStatement $ lookup identifier $ astDefs ast             -- writeStatement body-            writeIndentedLn $ "_macro_" ++ identifier ++ ".apply(this);"+            writeIndented $ "_macro_" ++ identifier ++ ".apply(this);"         SourcePositionStatement fn ln -> do             writeIndent             write "/* "@@ -176,7 +130,7 @@             write ":"             write $ show ln             write " */"-            writeNewline+            endl  writeIf :: Statement -> PWS () writeIf (IfStatement cond true false) = do@@ -184,15 +138,15 @@     write "if ("     writeExpression cond     write ") {"-    writeNewline+    endl     withIndent $ writeStatement true-    writeIndentedLn "}"+    writeIndented "}"     if false == NullStatement         then return ()         else do-                writeIndentedLn "else {"+                writeIndented "else {"                 withIndent $ writeStatement false-                writeIndentedLn "}"+                writeIndented "}"  writeLet :: String -> Expression -> Statement -> PWS () writeLet identifier expr stmt =@@ -214,26 +168,26 @@  writeFor_ :: String -> Expression -> PWS () -> PWS () writeFor_ identifier expr writeInner = do-    writeIndentedLn "(function(){"+    writeIndented "(function(){"     withIndent $ do         writeIndent         write "var _iteree = "         writeExpression expr         write ";"-        writeNewline-        writeIndentedLn "if (Array.isArray(_iteree)) {"+        endl+        writeIndented "if (Array.isArray(_iteree)) {"         withIndent $ do-            writeIndentedLn "for (var _index = 0; _index < _iteree.length; ++_index) {"+            writeIndented "for (var _index = 0; _index < _iteree.length; ++_index) {"             writeInner-            writeIndentedLn "}"-        writeIndentedLn "}"-        writeIndentedLn "else {"+            writeIndented "}"+        writeIndented "}"+        writeIndented "else {"         withIndent $ do-            writeIndentedLn "for (var _index in _iteree) {"+            writeIndented "for (var _index in _iteree) {"             writeInner-            writeIndentedLn "}"-        writeIndentedLn "}"-    writeIndentedLn "}).apply(this);"+            writeIndented "}"+        writeIndented "}"+    writeIndented "}).apply(this);"  writeWithScope :: String -> (PWS ()) -> (PWS ()) -> PWS () writeWithScope identifier rhs inner = do@@ -243,7 +197,7 @@             write "_newscope = "             rhs             write ";"-            writeNewline+            endl         else do             writeIndent             write "_newscope = {'"@@ -251,13 +205,13 @@             write "':"             rhs             write "};"-            writeNewline-    writeIndentedLn "_scope = _merge(this, _newscope);"-    writeIndentedLn "(function(){"+            endl+    writeIndented "_scope = _merge(this, _newscope);"+    writeIndented "(function(){"     withIndent $ do-        writeIndentedLn "var _scope = null; var _newscope = null;"+        writeIndented "var _scope = null; var _newscope = null;"         inner-    writeIndentedLn "}).apply(_scope);"+    writeIndented "}).apply(_scope);"  writeSwitch :: Expression -> [(Expression, Statement)] -> PWS () writeSwitch masterExpr branches = do@@ -265,10 +219,10 @@     write "switch ("     writeExpression masterExpr     write ") {"-    writeNewline+    endl     withIndent $         mapM writeSwitchBranch branches-    writeIndentedLn "}"+    writeIndented "}"     where         writeSwitchBranch :: (Expression, Statement) -> PWS ()         writeSwitchBranch (expr, stmt) = do@@ -276,10 +230,10 @@             write "case "             writeExpression expr             write ":"-            writeNewline+            endl             withIndent $ do                 writeStatement stmt-                writeIndentedLn "break;"+                writeIndented "break;"  writeExpression :: Expression -> PWS () writeExpression expr =
Text/HPaco/Writers/JsonLisp.hs view
@@ -16,13 +16,12 @@ 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)+    let (s, w) = execRWS (write ast) defaultWriterOptions (JsonLispWriterState ast)     in w  class JWSWrite a where
Text/HPaco/Writers/PHP.hs view
@@ -1,8 +1,7 @@ {-#LANGUAGE TemplateHaskell #-} module Text.HPaco.Writers.PHP     ( writePHP-    , WriterOptions (..)-    , defaultWriterOptions+    , defPHPWriterOptions     , WrapMode (..)     ) where@@ -18,38 +17,24 @@ import Text.HPaco.AST.Statement import Text.HPaco.Writer import Text.HPaco.Writers.Internal.WrapMode+import Text.HPaco.Writers.Internal.CodeWriter import qualified Data.ByteString.Char8 as BS8 import qualified Data.Map as M -data WriterOptions =-    WriterOptions { woPrettyPrint :: Bool-                  , woIndentStr :: String-                  , woTemplateName :: String-                  , woIncludePreamble :: Bool-                  , woWrapMode :: WrapMode-                  , woExposeAllFunctions :: Bool-                  }--defaultWriterOptions =-    WriterOptions { woPrettyPrint = False-                  , woIndentStr = "\t"-                  , woTemplateName = ""-                  , woIncludePreamble = True-                  , woWrapMode = WrapNone-                  , woExposeAllFunctions = False-                  }- data OutputMode = PHP | Html  type ScopeMap = [M.Map String String] +defPHPWriterOptions =+    defaultWriterOptions { woWriteFunc = "print" }+ data PHPWriterState =     PHPWriterState { pwsIndent :: Int                    , pwsLocalScope :: ScopeMap                    , pwsNextLocalVariableID :: Integer                    , pwsAST :: AST                    , pwsOutputMode :: OutputMode-                   , pwsEscapeFilter :: String -> String+                   , pwsEscapeFilters :: [String -> String]                    }  defaultPHPWriterState =@@ -58,15 +43,20 @@                    , pwsNextLocalVariableID = 0                    , pwsAST = defAST                    , pwsOutputMode = Html-                   , pwsEscapeFilter = id+                   , pwsEscapeFilters = []                    } +instance CodeWriterState PHPWriterState where+    cwsGetIndent = pwsIndent+    cwsSetIndent f s = s { pwsIndent = f }+    cwsGetFilters = pwsEscapeFilters+    cwsSetFilters f s = s { pwsEscapeFilters = f }+ type PWS = RWS WriterOptions String PHPWriterState  writePHP :: WriterOptions -> Writer writePHP opts ast =-    let (s, w) = execRWS (writeAST ast) opts defaultPHPWriterState { pwsAST = ast}-    in w+    runCodeWriter (writeAST ast) opts defaultPHPWriterState { pwsAST = ast}  writeAST :: AST -> PWS () writeAST ast = do@@ -75,36 +65,32 @@     writeStatement $ astRootStatement ast     writeFooter -write :: String -> PWS ()-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 +-- Unsafe, because it doesn't take care of writing appropriate PHP+-- 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+    modify (\s -> s { pwsOutputMode = m })+ setOutputMode :: OutputMode -> PWS () setOutputMode m = do     m0 <- getOutputMode-    modify (\s -> s { pwsOutputMode = m })+    unsafeSetOutputMode m     case (m0, m) of         (Html, PHP) -> write "<?php "-        (PHP, Html) -> write "?>"+        (PHP, Html) -> write " ?>\n"         otherwise -> return () -pushIndent :: PWS ()-pushIndent = modify (\s -> s { pwsIndent = pwsIndent s + 1 })--popIndent :: PWS ()-popIndent = modify (\s -> s { pwsIndent = pwsIndent s - 1 })+withOutputMode :: OutputMode -> PWS a -> PWS a+withOutputMode m a = do+    m0 <- getOutputMode+    setOutputMode m+    x <- a+    setOutputMode m0+    return x  pushScope :: PWS () pushScope = modify (\s -> s { pwsLocalScope = M.empty:pwsLocalScope s })@@ -118,7 +104,6 @@ setScope :: ScopeMap -> PWS () setScope newScope = modify (\s -> s { pwsLocalScope = newScope }) - scopeResolve :: String -> PWS (Maybe String) scopeResolve key = do     scopeStack <- gets pwsLocalScope@@ -166,39 +151,10 @@                 then c                 else '_' -withIndent :: PWS a -> PWS a-withIndent a = do-    pushIndent-    x <- a-    popIndent-    return x--writeIndent :: PWS ()-writeIndent = do-    pretty <- woPrettyPrint `liftM` ask-    istr <- woIndentStr `liftM` ask-    indent <- gets pwsIndent-    if pretty-        then write $ concat $ take indent $ repeat istr-        else return ()--writeNewline :: PWS ()-writeNewline = do-    pretty <- woPrettyPrint `liftM` ask-    if pretty-        then write "\n"-        else write " "--writeIndented :: String -> PWS ()-writeIndented str = writeIndent >> write str--writeIndentedLn :: String -> PWS ()-writeIndentedLn str = writeIndent >> write str >> writeNewline- writePreamble :: PWS () writePreamble = do     let src = BS8.unpack $(embedFile "snippets/php/preamble.php")-    setOutputMode Html+    unsafeSetOutputMode PHP     write src  writeHeader :: PWS ()@@ -217,37 +173,37 @@                     if null templateName                         then "runTemplate"                         else "runTemplate_" ++ templateName-            writeIndentedLn $ "function " ++ funcName ++ "($context) {"+            writeLn $ "function " ++ funcName ++ "($context) {"             pushIndent         WrapClass -> do             let className =                     if null templateName                         then "Template"                         else "Template_" ++ templateName-            writeIndentedLn $ "class " ++ className ++ " {"+            writeLn $ "class " ++ className ++ " {"             pushIndent-            writeIndentedLn $ "public function __invoke($context) {"+            writeLn $ "public function __invoke($context) {"             pushIndent         otherwise -> return ()     pushScope     vid <- defineVariable "."-    writeIndentedLn "if (isset($context)) {"+    writeLn "if (isset($context)) {"     withIndent $ do         writeIndent         write "$"         write $ toVarname vid         write " = $context;"-        writeNewline-    writeIndentedLn "}"-    writeIndentedLn "else {"+        endl+    writeLn "}"+    writeLn "else {"     withIndent $ do         writeIndent         write "$"         write $ toVarname vid         write " = array();"-        writeNewline-    writeIndentedLn "}"-    writeIndentedLn "$_scope = array();"+        endl+    writeLn "}"+    writeLn "$_scope = array();"     writePushScope  writeDefs defs = do@@ -269,10 +225,10 @@         otherwise -> write "$_macro_"     write ident     write " = '"-    writeNewline+    endl     withFilter evalQuoteString $ withIndent $ writeStatement stmt     setOutputMode PHP-    writeIndentedLn "';"+    writeLn "';"  writePushScope = writePushScopeVar "." @@ -283,10 +239,10 @@                     "$_scope = new _S($" ++ vid ++ ", $_scope);"                 else                     "$_scope = new _S(array('" ++ var ++ "' => $" ++ vid ++ "), $_scope);"-    writeIndentedLn str+    writeLn str  writePopScope =-    writeIndentedLn "if ($_scope instanceof _S) { $_scope = $_scope->p; } else { $_scope = array(); }"+    writeLn "if ($_scope instanceof _S) { $_scope = $_scope->p; } else { $_scope = array(); }"  writeFooter :: PWS () writeFooter = do@@ -295,12 +251,12 @@     case wrapMode of         WrapFunction -> do             popIndent-            writeIndentedLn "}"+            writeLn "}"         WrapClass -> do             popIndent-            writeIndentedLn "}"+            writeLn "}"             popIndent-            writeIndentedLn "}"+            writeLn "}"         otherwise -> return ()  writeIndentedStatement :: Statement -> PWS ()@@ -309,20 +265,23 @@  writeStatement :: Statement -> PWS () writeStatement stmt = do-    -- writeIndent >> write "/* " >> write (show stmt) >> write " */" >> writeNewline+    -- writeIndent >> write "/* " >> write (show stmt) >> write " */" >> endl     case stmt of         StatementSequence ss -> mapM_ writeStatement ss         PrintStatement expr -> do             writeIndent-            write "echo "-            case expr of-                EscapeExpression _ _ -> writeExpression expr-                StringLiteral _ -> writeExpression expr-                IntLiteral _ -> writeExpression expr-                FloatLiteral _ -> writeExpression expr-                otherwise -> write "_f(" >> writeExpression expr >> write ")"+            write "print"+            withParens $+                case expr of+                    EscapeExpression _ _ -> writeExpression expr+                    StringLiteral _ -> writeExpression expr+                    IntLiteral _ -> writeExpression expr+                    FloatLiteral _ -> writeExpression expr+                    otherwise -> do+                        write "_f"+                        withParens $ writeExpression expr             write ";"-            writeNewline+            endl         NullStatement -> return ()         IfStatement { } -> writeIf stmt         LetStatement identifier expr stmt -> writeLet identifier expr stmt@@ -336,15 +295,15 @@             write "$_macro_"             write identifier             write ");"-            writeNewline-        SourcePositionStatement fn ln -> do-            writeIndent-            write "/* "-            write fn-            write ":"-            write $ show ln-            write " */"-            writeNewline+            endl+        SourcePositionStatement fn ln -> return ()+            -- writeIndent+            -- write "/* "+            -- write fn+            -- write ":"+            -- write $ show ln+            -- write " */"+            -- endl  writeIf :: Statement -> PWS () writeIf (IfStatement cond true false) = do@@ -352,15 +311,15 @@     write "if ("     writeExpression cond     write ") {"-    writeNewline+    endl     withIndent $ writeStatement true-    writeIndentedLn "}"+    writeLn "}"     if false == NullStatement         then return ()         else do-                writeIndentedLn "else {"+                writeLn "else {"                 withIndent $ writeStatement false-                writeIndentedLn "}"+                writeLn "}"  writeLet :: String -> Expression -> Statement -> PWS () writeLet identifier expr stmt = do@@ -373,7 +332,7 @@     write " = "     writeExpression expr     write ";"-    writeNewline+    endl      writePushScopeVar identifier @@ -383,7 +342,7 @@     write "unset($"     write $ toVarname id     write ");";-    writeNewline+    endl      popScope     writePopScope@@ -398,9 +357,9 @@     write "$_iteree = "     writeExpression expr     write ";"-    writeNewline+    endl -    writeIndentedLn "if (is_array($_iteree) || ($_iteree instanceof Traversable)) {"+    writeLn "if (is_array($_iteree) || ($_iteree instanceof Traversable)) {"      withIndent $ do         writeIndent@@ -413,22 +372,22 @@             otherwise -> return ()         write $ toVarname id         write ") {"-        writeNewline+        endl          withIndent $ do             writePushScopeVar identifier             writeStatement stmt             writePopScope -        writeIndentedLn "}"+        writeLn "}"          writeIndent         write "unset($"         write $ toVarname id         write ");";-        writeNewline+        endl -    writeIndentedLn "}"+    writeLn "}"      popScope @@ -438,10 +397,10 @@     write "switch ("     writeExpression masterExpr     write ") {"-    writeNewline+    endl     withIndent $         mapM writeSwitchBranch branches-    writeIndentedLn "}"+    writeLn "}"     where         writeSwitchBranch :: (Expression, Statement) -> PWS ()         writeSwitchBranch (expr, stmt) = do@@ -449,10 +408,10 @@             write "case "             writeExpression expr             write ":"-            writeNewline+            endl             withIndent $ do                 writeStatement stmt-                writeIndentedLn "break;"+                writeLn "break;"  writeExpression :: Expression -> PWS () writeExpression expr =@@ -535,20 +494,17 @@                             OpBooleanAnd -> "&&"                             OpBooleanOr -> "||"                             OpBooleanXor -> " xor "-            write "("-            writeExpression left-            write opstr-            writeExpression right-            write ")"+            withParens $ do+                writeExpression left+                write opstr+                writeExpression right          UnaryExpression o e -> do             let opstr = case o of                             OpNot -> "!"-            write "("-            write opstr-            write "("-            writeExpression e-            write "))"+            withParens $ do+                write opstr+                withParens $ writeExpression e          FunctionCallExpression fn args -> do             write "_call("
hpaco-lib.cabal view
@@ -1,5 +1,5 @@ name:                hpaco-lib-version:             0.16.1.0+version:             0.16.2.0 synopsis:            Modular template compiler library description:         Template compiler library, compiles template code into                      PHP or Javascript, or interprets it directly.@@ -30,6 +30,7 @@                  , Text.HPaco.Writers.Run                  , Text.HPaco.Writers.PHP                  , Text.HPaco.Writers.Internal.WrapMode+                 , Text.HPaco.Writers.Internal.CodeWriter                  , Text.HPaco.Writers.Run.Encode                  , Text.HPaco.Writers.Run.Library                  , Text.HPaco.AST
snippets/php/preamble.php view
@@ -111,4 +111,3 @@ 		return null; 	} }-?>