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 +31/−1
- Text/HPaco/Writers/Internal/CodeWriter.hs +144/−0
- Text/HPaco/Writers/Javascript.hs +46/−92
- Text/HPaco/Writers/JsonLisp.hs +1/−2
- Text/HPaco/Writers/PHP.hs +92/−136
- hpaco-lib.cabal +2/−1
- snippets/php/preamble.php +0/−1
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; } }-?>