HSmarty 0.2.0.2 → 0.2.0.3
raw patch · 8 files changed
+243/−180 lines, 8 filesdep +HSmartydep +scientificdep ~HTFdep ~aesondep ~attoparsec
Dependencies added: HSmarty, scientific
Dependency ranges changed: HTF, aeson, attoparsec, attoparsec-expr, mtl, text, unordered-containers, vector
Files
- HSmarty.cabal +33/−29
- data/test.tpl +12/−0
- src/Tests.hs +0/−8
- src/Text/HSmarty/Parser/Smarty.hs +3/−47
- src/Text/HSmarty/Render/Engine.hs +123/−84
- test.tpl +0/−12
- test/Tests.hs +8/−0
- test/Text/HSmarty/Parser/SmartyTest.hs +64/−0
HSmarty.cabal view
@@ -1,49 +1,53 @@ name: HSmarty-version: 0.2.0.2-synopsis: Haskell implementation of a subset of the PHP-Smarty template language+version: 0.2.0.3+synopsis: Small template engine+description: Haskell implementation of a subset of the PHP-Smarty template language Homepage: https://github.com/agrafix/HSmarty Bug-reports: https://github.com/agrafix/HSmarty/issues license: BSD3 license-file: LICENSE-author: Alexander Thiemann <mail@agrafix.net>-maintainer: mail@agrafix.net-copyright: (c) 2013 - 2014 by Alexander Thiemann+author: Alexander Thiemann <mail@athiemann.net>+maintainer: Alexander Thiemann <mail@athiemann.net>+copyright: (c) 2013 - 2015 by Alexander Thiemann category: Text build-type: Simple cabal-version: >=1.8-extra-source-files: test.tpl+data-dir: data+data-files: test.tpl Library hs-source-dirs: src- exposed-modules: Text.HSmarty- other-modules: Text.HSmarty.Parser.Smarty, Text.HSmarty.Parser.Util,- Text.HSmarty.Render.Engine, Text.HSmarty.Types- build-depends: base >= 4 && < 5,- vector ==0.10.*,- text,- unordered-containers ==0.2.*,- aeson ==0.6.*,- attoparsec ==0.11.*,- attoparsec-expr ==0.1.1,- mtl ==2.1.*,+ exposed-modules: Text.HSmarty,+ Text.HSmarty.Parser.Smarty,+ Text.HSmarty.Parser.Util,+ Text.HSmarty.Types+ other-modules: Text.HSmarty.Render.Engine+ Ghc-Options: -Wall+ build-depends: HTTP,- HTF >=0.12.2.2 && <0.13+ aeson >=0.8,+ attoparsec >=0.11,+ attoparsec-expr >=0.1.1,+ base >= 4 && < 5,+ mtl >=2.2,+ scientific >=0.3,+ text >=1.2,+ unordered-containers >=0.2,+ vector >=0.10 Test-Suite TestHSmarty- hs-source-dirs: src+ hs-source-dirs: test+ other-modules: Text.HSmarty.Parser.SmartyTest Type: exitcode-stdio-1.0 Main-Is: Tests.hs Ghc-Options: -Wall- build-depends: base >= 4 && < 5,- vector ==0.10.*,- text,- unordered-containers ==0.2.*,- aeson ==0.6.*,- attoparsec ==0.11.*,- attoparsec-expr ==0.1.1,- mtl ==2.1.*,- HTTP,- HTF >=0.12.2.2 && <0.13+ build-depends:+ HSmarty,+ HTF,+ aeson >=0.8,+ attoparsec >=0.11,+ base >= 4 && < 5,+ text >=1.2 source-repository head type: git
+ data/test.tpl view
@@ -0,0 +1,12 @@+{* test *}+<html>+<head>+ <title>{$title}</title>+</head>+<body>+{foreach $list as $item}+ <li>{$item}</li>+ <li>{$item@last}</li>+{/foreach}+</body>+</html>
− src/Tests.hs
@@ -1,8 +0,0 @@-{-# OPTIONS_GHC -F -pgmF htfpp #-}-module Main where--import Test.Framework-import {-@ HTF_TESTS @-} Text.HSmarty.Parser.Smarty--main :: IO ()-main = htfMain htf_importedTests
src/Text/HSmarty/Parser/Smarty.hs view
@@ -1,21 +1,14 @@-{-# OPTIONS_GHC -F -pgmF htfpp #-}-{-# OPTIONS_GHC -fwarn-unused-imports -fwarn-incomplete-patterns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-}-module Text.HSmarty.Parser.Smarty- ( parseSmarty- , htf_thisModulesTests- )-where+module Text.HSmarty.Parser.Smarty where import Text.HSmarty.Types import Text.HSmarty.Parser.Util - import Data.Attoparsec.Text import Data.Char import Control.Applicative-import Test.Framework+ import qualified Data.Aeson as A import qualified Data.Attoparsec.Expr as E import qualified Data.Text as T@@ -59,7 +52,7 @@ pLit = A.String <$> stringP <|> A.Bool <$> boolP <|>- A.Number <$> number+ A.Number <$> scientific pVar :: Parser Variable pVar =@@ -161,40 +154,3 @@ binary (stripSpace $ string s) wsym w = binary (between optSpace_ space_ $ string w)---- tests-parserTest :: forall b. (Eq b, Show b)- => Parser b -> T.Text -> b -> IO ()-parserTest parser input expected =- either fail comp $ parseOnly parser input- where- comp x =- assertEqual x expected--test_literalParser :: IO ()-test_literalParser =- parserTest pLiteral "{literal}abc{/literal}" "abc"--test_commentParser :: IO ()-test_commentParser =- parserTest pComment "{* some comment *}" " some comment "--test_varParser :: IO ()-test_varParser =- parserTest pVar "$hallo.sub@prop" (Variable "hallo" ["sub"] Nothing (Just "prop"))--test_rootParser :: IO ()-test_rootParser =- parserTest pRoot "{if true}{include file='hallo.tpl' var1=23}{else}Nothing{/if}" expect- where- expect = [SmartyIf- (If{if_cases =- [(ExprLit (A.Bool True),- [SmartyPrint- (ExprFun- (FunctionCall{f_name = "include",- f_args =- [("file", ExprLit (A.String "hallo.tpl")),- ("var1", ExprLit (A.Number 23))]}))- []])],- if_else = Just [SmartyText "Nothing"]})]
src/Text/HSmarty/Render/Engine.hs view
@@ -1,17 +1,21 @@-{-# OPTIONS_GHC -fwarn-unused-imports -fwarn-incomplete-patterns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE DoAndIfThenElse #-} module Text.HSmarty.Render.Engine- ( renderTemplate, mkParam, TemplateParam, ParamMap )+ ( TemplateParam, ParamMap+ , mkParam+ , SmartyCtx, SmartyError(..)+ , prepareTemplate, applyTemplate+ , renderTemplate+ ) where import Text.HSmarty.Types import Text.HSmarty.Parser.Smarty +import Data.Scientific import Control.Applicative-import Control.Monad.Error-import Data.Attoparsec.Text (Number(..))+import Control.Monad.Except import Data.Char (ord) import Data.Maybe import Data.Vector ((!?))@@ -40,26 +44,42 @@ type ParamMap = HM.HashMap T.Text TemplateParam type PropMap = HM.HashMap T.Text A.Value -type EvalM a = ErrorT T.Text IO a+type EvalM a = ExceptT SmartyError IO a -instance Error T.Text where- strMsg = T.pack+newtype SmartyCtx+ = SmartyCtx { _unSmartyCtx :: Smarty }+ deriving (Show, Eq) +newtype SmartyError+ = SmartyError { unSmartyError :: T.Text }+ deriving (Show, Eq)+ -- | Pack a value as a template param mkParam :: A.ToJSON a => a -> TemplateParam mkParam = TemplateParam . A.toJSON mkEnv :: ParamMap -> Env mkEnv =- HM.map (\init -> TemplateVar (unTemplateParam init) HM.empty)+ HM.map (\init' -> TemplateVar (unTemplateParam init') HM.empty) +-- | Parse and compile a template+prepareTemplate :: FilePath -> IO SmartyCtx+prepareTemplate fp =+ do ct <- T.readFile fp+ SmartyCtx <$> parseSmarty fp ct++-- | Fill a template with values and print it as Text+applyTemplate :: SmartyCtx -> ParamMap -> IO (Either SmartyError T.Text)+applyTemplate (SmartyCtx ctx) mp =+ runExceptT $ evalTpl (mkEnv mp) ctx+ -- | Render a template using the specified ParamMap.--- Results in either an error-message or the rendered template-renderTemplate :: FilePath -> ParamMap -> IO (Either T.Text T.Text)+-- Results in either an error-message or the rendered template.+-- DO NOT USE IN Production. Use `prepareTemplate` and `applyTemplate` instead.+renderTemplate :: FilePath -> ParamMap -> IO (Either SmartyError T.Text) renderTemplate fp mp =- do ct <- T.readFile fp- tpl <- parseSmarty fp ct- runErrorT $ evalTpl (mkEnv mp) tpl+ do ctx <- prepareTemplate fp+ applyTemplate ctx mp applyPrintDirective :: T.Text -> PrintDirective -> EvalM T.Text applyPrintDirective t "urlencode" =@@ -79,13 +99,14 @@ ] else x : htmlEscape xs applyPrintDirective _ pd =- throwError $ T.concat [ "Unknown print directive `"- , pd- , "`"- ]+ throwError $ SmartyError $+ T.concat [ "Unknown print directive `"+ , pd+ , "`"+ ] evalTpl :: Env -> Smarty -> EvalM T.Text-evalTpl env (Smarty filename tpl) =+evalTpl env (Smarty _ tpl) = evalBody env tpl evalStmt :: Env -> SmartyStmt -> EvalM T.Text@@ -155,9 +176,9 @@ mkForeachInput :: A.Value -> EvalM ( [ ( A.Value, A.Value, PropMap ) ], Int) mkForeachInput (A.Array vec) =- return $ ( V.toList $ V.imap (\idx elem ->- ( A.Number (I $ fromIntegral idx)- , elem+ return $ ( V.toList $ V.imap (\idx el ->+ ( A.Number (fromIntegral idx)+ , el , mkForeachMap idx fSize ) ) vec@@ -167,9 +188,9 @@ fSize = V.length vec mkForeachInput (A.Object hm) = let (_, input) =- HM.foldlWithKey' (\(idx, out) key elem ->+ HM.foldlWithKey' (\(idx, out) key el -> let newElem = ( A.String key- , elem+ , el , mkForeachMap idx hSize ) in (idx+1, newElem : out)@@ -178,15 +199,15 @@ where hSize = HM.size hm mkForeachInput _ =- throwError "Tried to iterate over non traversable type."+ throwError $ SmartyError "Tried to iterate over non traversable type." mkForeachMap :: Int -> Int -> PropMap mkForeachMap idx' size' =- HM.fromList [ ("index", A.Number (I idx))- , ("iteration", A.Number (I $ 1 + idx))+ HM.fromList [ ("index", A.Number idx)+ , ("iteration", A.Number $ 1 + idx) , ("first", A.Bool $ idx == 0) , ("last", A.Bool $ (idx+1) == size)- , ("total", A.Number (I size))+ , ("total", A.Number size) ] where size = fromIntegral size'@@ -194,22 +215,28 @@ str :: T.Text -> A.Value -> EvalM T.Text str _ (A.String x) = return x-str desc _ = throwError $ T.concat [ "`", desc, "` is not a string!" ]+str desc _ = throwError $ SmartyError $ T.concat [ "`", desc, "` is not a string!" ] int :: T.Text -> A.Value -> EvalM Int-int _ (A.Number (I x)) = return (fromIntegral x)-int desc _ = throwError $ T.concat [ "`", desc, "` is not an integer!" ]+int desc (A.Number x) =+ case floatingOrInteger x of+ Left _ -> throwError $ SmartyError $ T.concat [ "`", desc, "` is not an integer!" ]+ Right x' -> return x'+int desc _ = throwError $ SmartyError $ T.concat [ "`", desc, "` is not an integer!" ] dbl :: T.Text -> A.Value -> EvalM Double-dbl _ (A.Number (D x)) = return x-dbl desc _ = throwError $ T.concat [ "`", desc, "` is not a double!" ]+dbl desc (A.Number x) =+ case floatingOrInteger x of+ Left x' -> return x'+ Right _ -> throwError $ SmartyError $ T.concat [ "`", desc, "` is not a double!" ]+dbl desc _ = throwError $ SmartyError $ T.concat [ "`", desc, "` is not a double!" ] ifExists :: (Eq a, Show a) => T.Text -> a -> [(a, A.Value)] -> (A.Value -> EvalM b) -> EvalM b ifExists msg key env fun = case lookup key env of Just x -> fun x Nothing ->- throwError $ T.concat [ "`", T.pack $ show key, "` is not given. ", msg]+ throwError $ SmartyError $ T.concat [ "`", T.pack $ show key, "` is not given. ", msg] lookupStr :: T.Text -> T.Text -> [(T.Text, A.Value)] -> EvalM T.Text lookupStr funName key env =@@ -222,7 +249,7 @@ return (k, val) ) args filename <- lookupStr "include" "file" evaledArgs- let otherArgs = filter (\arg@(k, _) ->+ let otherArgs = filter (\(k, _) -> not $ k `elem` [ "include" ] ) evaledArgs asTplParams = HM.fromList $ map (\(k, v) -> (k, TemplateParam v)) otherArgs@@ -231,11 +258,12 @@ Right c -> return $ A.String c Left e ->- throwError $ T.concat ["Include failed. Error: ", e]-evalFunCall env fname _ =- throwError $ T.concat [ "Call to undefined function "- , fname- ]+ throwError $ SmartyError $ T.concat ["Include failed. Error: ", unSmartyError e]+evalFunCall _ fname _ =+ throwError $ SmartyError $+ T.concat [ "Call to undefined function "+ , fname+ ] evalExpr :: Env -> Expr -> EvalM A.Value@@ -251,12 +279,15 @@ (Variable { v_prop = Just propReq }) -> case HM.lookup propReq (tv_props tplVar) of Just val -> return val- Nothing -> throwError $ T.concat [ "Property `"- , propReq- , "` is not defined for variable `"- , varName- , "`"- ]+ Nothing ->+ throwError $+ SmartyError $+ T.concat [ "Property `"+ , propReq+ , "` is not defined for variable `"+ , varName+ , "`"+ ] (Variable { v_path = path, v_index = mIdx }) -> let pathName = T.concat [ varName , if (length path > 0) then "." else T.empty@@ -275,51 +306,59 @@ Nothing ->- throwError $ T.concat [ "Variable `"- , varName- , "` is not defined"- ]+ throwError $+ SmartyError $+ T.concat [ "Variable `"+ , varName+ , "` is not defined"+ ] where varName = v_name v walkIndex :: T.Text -> A.Value -> A.Value -> EvalM A.Value-walkIndex vname (A.Number (I idx)) (A.Array arr) =- case arr !? (fromIntegral idx) of+walkIndex vname (A.Number idx) (A.Array arr) =+ case arr !? (fromJust $ toBoundedInteger idx) of Just val -> return val Nothing ->- throwError $ T.concat [ "Out of bounds. `"- , vname- , "["- , T.pack $ show idx- , "]` not defined."- ]+ throwError $+ SmartyError $+ T.concat [ "Out of bounds. `"+ , vname+ , "["+ , T.pack $ show idx+ , "]` not defined."+ ] walkIndex vname idx _ =- throwError $ T.concat [ "Can't access `"- , T.pack $ show idx- , "` in `"- , vname- , "`. Index is not an integer or value not an array!"- ]+ throwError $+ SmartyError $+ T.concat [ "Can't access `"+ , T.pack $ show idx+ , "` in `"+ , vname+ , "`. Index is not an integer or value not an array!"+ ] walkPath :: T.Text -> [T.Text] -> A.Value -> EvalM A.Value-walkPath vname [] val = return val+walkPath _ [] val = return val walkPath vname (path:xs) (A.Object obj) = case HM.lookup path obj of Just val -> walkPath (T.concat [vname, ".", path]) xs val Nothing ->- throwError $ T.concat [ "Variable `"- , vname- , "` doesn't have the key `"- , path- , "`"- ]-walkPath vname (path:xs) _ =- throwError $ T.concat [ "Variable `"- , vname- , "` is not a map! Can't lookup `"- , path- , "`"- ]+ throwError $ SmartyError $+ T.concat [ "Variable `"+ , vname+ , "` doesn't have the key `"+ , path+ , "`"+ ]+walkPath vname (path:_) _ =+ throwError $ SmartyError $+ T.concat [ "Variable `"+ , vname+ , "` is not a map! Can't lookup `"+ , path+ , "`"+ ] evalBinOp :: Env -> BinOp -> EvalM A.Value evalBinOp env (BinEq a b) =@@ -330,7 +369,7 @@ A.Bool a -> return (A.Bool $ not a) _ ->- throwError "Tried to evaluate a NOT on a non boolean value"+ throwError $ SmartyError "Tried to evaluate a NOT on a non boolean value" evalBinOp env (BinOr x y) = boolOp "Or" (||) (x, y) env evalBinOp env (BinAnd x y) =@@ -359,27 +398,27 @@ where bOp (A.Bool a) (A.Bool b) = return $ a `op` b- bOp _ _ = throwError $ T.concat [ "Tried ", d, "Op and on two non boolean values" ]+ bOp _ _ = throwError $ SmartyError $ T.concat [ "Tried ", d, "Op and on two non boolean values" ] -numOp :: T.Text -> (Number -> Number -> Bool) -> (Expr, Expr) -> Env -> EvalM A.Value+numOp :: T.Text -> (Scientific -> Scientific -> Bool) -> (Expr, Expr) -> Env -> EvalM A.Value numOp = numGenOp boolResOp -calcOp :: T.Text -> (Number -> Number -> Number) -> (Expr, Expr) -> Env -> EvalM A.Value+calcOp :: T.Text -> (Scientific -> Scientific -> Scientific) -> (Expr, Expr) -> Env -> EvalM A.Value calcOp = numGenOp numResOp numGenOp :: ((A.Value -> A.Value -> EvalM a) -> (Expr, Expr) -> Env -> EvalM A.Value)- -> T.Text -> (Number -> Number -> a) -> (Expr, Expr) -> Env -> EvalM A.Value+ -> T.Text -> (Scientific -> Scientific -> a) -> (Expr, Expr) -> Env -> EvalM A.Value numGenOp fun d op exprs env = fun nOp exprs env where nOp (A.Number a) (A.Number b) = return $ a `op` b- nOp _ _ = throwError $ T.concat [ "Tried ", d, "Op and on two non numeric values" ]+ nOp _ _ = throwError $ SmartyError $ T.concat [ "Tried ", d, "Op and on two non numeric values" ] -numResOp :: (A.Value -> A.Value -> EvalM Number)+numResOp :: (A.Value -> A.Value -> EvalM Scientific) -> (Expr, Expr) -> Env -> EvalM A.Value numResOp fun (a, b) env = do a' <- evalExpr env a
− test.tpl
@@ -1,12 +0,0 @@-{* test *}-<html>-<head>- <title>{$title}</title>-</head>-<body>-{foreach $list as $item}- <li>{$item}</li>- <li>{$item@last}</li>-{/foreach}-</body>-</html>
+ test/Tests.hs view
@@ -0,0 +1,8 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}+module Main where++import Test.Framework+import {-@ HTF_TESTS @-} Text.HSmarty.Parser.SmartyTest++main :: IO ()+main = htfMain htf_importedTests
+ test/Text/HSmarty/Parser/SmartyTest.hs view
@@ -0,0 +1,64 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+module Text.HSmarty.Parser.SmartyTest where++import Data.Attoparsec.Text+import Paths_HSmarty+import Test.Framework+import Text.HSmarty.Parser.Smarty+import Text.HSmarty.Types+import qualified Data.Aeson as A+import qualified Data.Text as T+import qualified Data.Text.IO as T++parserTest :: forall b. (Eq b, Show b)+ => Parser b -> T.Text -> b -> IO ()+parserTest parser input expected =+ either fail comp $ parseOnly parser input+ where+ comp x =+ assertEqual x expected++readDataFile :: String -> IO T.Text+readDataFile name =+ do fp <- getDataFileName name+ T.readFile fp++test_complex :: IO ()+test_complex =+ do testData <- readDataFile "test.tpl"+ case parseOnly pRoot testData of+ Left errMsg ->+ fail errMsg+ Right _ ->+ return ()+++test_literalParser :: IO ()+test_literalParser =+ parserTest pLiteral "{literal}abc{/literal}" "abc"++test_commentParser :: IO ()+test_commentParser =+ parserTest pComment "{* some comment *}" " some comment "++test_varParser :: IO ()+test_varParser =+ parserTest pVar "$hallo.sub@prop" (Variable "hallo" ["sub"] Nothing (Just "prop"))++test_rootParser :: IO ()+test_rootParser =+ parserTest pRoot "{if true}{include file='hallo.tpl' var1=23}{else}Nothing{/if}" expect+ where+ expect = [SmartyIf+ (If{if_cases =+ [(ExprLit (A.Bool True),+ [SmartyPrint+ (ExprFun+ (FunctionCall{f_name = "include",+ f_args =+ [("file", ExprLit (A.String "hallo.tpl")),+ ("var1", ExprLit (A.Number 23))]}))+ []])],+ if_else = Just [SmartyText "Nothing"]})]