HSmarty 0.2.0.3 → 0.4.0

raw patch · 6 files changed

+282/−131 lines, 6 filesdep +Globdep +bytestringdep +filepathdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: Glob, bytestring, filepath

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• HSmarty.cabal +13/−7
• LICENSE +1/−1
• src/Text/HSmarty/Parser/Smarty.hs +34/−4
• src/Text/HSmarty/Render/Engine.hs +187/−117
• src/Text/HSmarty/Types.hs +30/−1
• test/Text/HSmarty/Parser/SmartyTest.hs +17/−1

@@ -1,5 +1,5 @@ name:                HSmarty-version:             0.2.0.3+version:             0.4.0 synopsis:            Small template engine description:         Haskell implementation of a subset of the PHP-Smarty template language Homepage:            https://github.com/agrafix/HSmarty@@ -8,12 +8,13 @@ license-file:        LICENSE author:              Alexander Thiemann <mail@athiemann.net> maintainer:          Alexander Thiemann <mail@athiemann.net>-copyright:           (c) 2013 - 2015 by Alexander Thiemann+copyright:           (c) 2013 - 2020 by Alexander Thiemann category:            Text build-type:          Simple-cabal-version:       >=1.8+cabal-version:       >=1.10 data-dir:            data data-files:          test.tpl+tested-with:         GHC==8.8.4  Library   hs-source-dirs:    src@@ -21,26 +22,31 @@                      Text.HSmarty.Parser.Smarty,                      Text.HSmarty.Parser.Util,                      Text.HSmarty.Types-  other-modules:     Text.HSmarty.Render.Engine+  other-modules:     Text.HSmarty.Render.Engine, Paths_HSmarty   Ghc-Options:       -Wall+  default-language:  Haskell2010   build-depends:                      HTTP,                      aeson >=0.8,                      attoparsec >=0.11,                      attoparsec-expr >=0.1.1,-                     base >= 4 && < 5,+                     base >= 4.8 && < 5,                      mtl >=2.2,                      scientific >=0.3,                      text >=1.2,                      unordered-containers >=0.2,-                     vector >=0.10+                     vector >=0.10,+                     Glob >= 0.7,+                     filepath,+                     bytestring  Test-Suite TestHSmarty   hs-source-dirs:    test-  other-modules:     Text.HSmarty.Parser.SmartyTest+  other-modules:     Text.HSmarty.Parser.SmartyTest, Paths_HSmarty   Type:              exitcode-stdio-1.0   Main-Is:           Tests.hs   Ghc-Options:       -Wall+  default-language:  Haskell2010   build-depends:                      HSmarty,                      HTF,

@@ -1,4 +1,4 @@-Copyright (c) 2013, Alexander Thiemann <mail@agrafix.net>+Copyright (c) 2013 - 2020, Alexander Thiemann <mail@thiemann.at>  All rights reserved. 

@@ -2,18 +2,18 @@ {-# LANGUAGE RankNTypes #-} module Text.HSmarty.Parser.Smarty where -import Text.HSmarty.Types import Text.HSmarty.Parser.Util+import Text.HSmarty.Types +import Control.Applicative import Data.Attoparsec.Text import Data.Char-import Control.Applicative  import qualified Data.Aeson as A import qualified Data.Attoparsec.Expr as E import qualified Data.Text as T -parseSmarty :: Monad m => FilePath -> T.Text -> m Smarty+parseSmarty :: MonadFail m => FilePath -> T.Text -> m Smarty parseSmarty fp t =     either fail mk $ parseOnly pRoot t     where@@ -30,6 +30,9 @@     SmartyText <$> pLiteral <|>     SmartyIf <$> pIf <|>     SmartyForeach <$> pForeach <|>+    SmartyCapture <$> pCapture <|>+    SmartyScope <$> pScope <|>+    SmartyFun <$> pFunDef <|>     braced (char '{') (char '}') (SmartyPrint <$> pExpr <*> many pPrintDirective) <|>     SmartyText <$> (takeWhile1 (/='{')) @@ -67,7 +70,7 @@  pName :: Parser T.Text pName =-    identP isAlpha isAlphaNum+    identP (\c -> isAlpha c || c == '_') (\c -> isAlphaNum c || c == '_')  pLiteral :: Parser T.Text pLiteral =@@ -96,6 +99,33 @@ pClose :: T.Text -> Parser T.Text pClose t =     string $ T.concat [ "{/", t, "}" ]++pLet :: Parser Let+pLet =+    Let+    <$> (string "{$" *> pName <* char '=')+    <*> pExpr <* char '}'++pScope :: Parser Scope+pScope =+    Scope <$> (pOpen "scope" *> many pStmt <* pClose "scope")++pCapture :: Parser Capture+pCapture =+    Capture+    <$> ((string "{capture name=" *> space_) *> stringP <* char '}')+    <*> (many pStmt <* pClose "capture")++pFunDef :: Parser FunctionDef+pFunDef =+    FunctionDef+    <$> ((string "{function name=" *> space_) *> stringP)+    <*> (many pArg <* char '}')+    <*> (many pStmt <* pClose "function")+    where+      pArg =+          (,) <$> (space_ *> pName <* stripSpace (char '='))+              <*> pExpr  pIf :: Parser If pIf =

@@ -1,36 +1,39 @@+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE DoAndIfThenElse #-} module Text.HSmarty.Render.Engine-    ( TemplateParam, ParamMap-    , mkParam+    ( ParamMap, mkParam     , SmartyCtx, SmartyError(..)-    , prepareTemplate, applyTemplate-    , renderTemplate+    , prepareTemplate, prepareTemplates+    , applyTemplate+    , applyTemplateFromJson     ) where -import Text.HSmarty.Types+import Control.Monad import Text.HSmarty.Parser.Smarty+import Text.HSmarty.Types+import qualified Data.Text.Lazy as TL -import Data.Scientific-import Control.Applicative import Control.Monad.Except+import Control.Monad.Identity import Data.Char (ord) import Data.Maybe+import Data.Scientific import Data.Vector ((!?)) import Network.HTTP.Base (urlEncode)+import System.FilePath+import System.FilePath.Glob import qualified Data.Aeson as A+import qualified Data.ByteString.Lazy as BSL import qualified Data.HashMap.Strict as HM import qualified Data.Text as T+import qualified Data.Text.Encoding as T import qualified Data.Text.IO as T+import qualified Data.Text.Lazy.Builder as TLB import qualified Data.Vector as V --- | An template param, construct using 'mkParam'-newtype TemplateParam-      = TemplateParam { unTemplateParam :: A.Value }-        deriving (Show, Eq)- data TemplateVar    = TemplateVar    { tv_value :: A.Value@@ -38,57 +41,98 @@    }    deriving (Show, Eq) -type Env = HM.HashMap T.Text TemplateVar- -- | Maps template variables to template params-type ParamMap = HM.HashMap T.Text TemplateParam+type ParamMap = HM.HashMap T.Text A.Value type PropMap = HM.HashMap T.Text A.Value -type EvalM a = ExceptT SmartyError IO a+mkParam :: A.ToJSON a => a -> A.Value+mkParam = A.toJSON +type EvalM m a = ExceptT SmartyError m a+ newtype SmartyCtx-    = SmartyCtx { _unSmartyCtx :: Smarty }-      deriving (Show, Eq)+    = SmartyCtx+    { unSmartyCtx :: HM.HashMap FilePath Smarty+    } deriving (Show, Eq) +data Env =+    Env+    { e_var :: HM.HashMap T.Text TemplateVar+    , e_fun :: HM.HashMap T.Text ([SmartyStmt], [(T.Text, A.Value)])+    , e_ctx :: SmartyCtx+    } 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)+mkEnv :: ParamMap -> SmartyCtx -> Env+mkEnv pm ctx =+    Env+    { e_var = HM.map (\init' -> TemplateVar init' HM.empty) pm+    , e_fun = HM.empty+    , e_ctx = ctx+    }  -- | Parse and compile a template prepareTemplate :: FilePath -> IO SmartyCtx prepareTemplate fp =     do ct <- T.readFile fp-       SmartyCtx <$> parseSmarty fp ct+       tpl <- HM.singleton fp <$> parseSmarty fp ct+       pure $ SmartyCtx tpl +-- | Parse and compiles templates matching a glob in a directiry+prepareTemplates :: String -> FilePath -> IO SmartyCtx+prepareTemplates pat dir =+    do files <- globDir1 (compile pat) dir+       let dirDropper =+               makeRelative dir+       ctx <-+           foldM (\hm f ->+                      do ct <- T.readFile f >>= parseSmarty f+                         pure (HM.insert (dirDropper f) ct hm)+                 ) mempty files+       pure $ SmartyCtx ctx+ -- | 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+applyTemplateFromJson :: A.ToJSON a => FilePath -> SmartyCtx -> a -> Either SmartyError T.Text+applyTemplateFromJson a b c =+  case A.toJSON c of+    A.Object hm -> runIdentity $ runExceptT $ applyTemplate' a b hm+    x -> Left (SmartyError $ T.pack $ show x ++ " is not a json object, need an object at top level") --- | Render a template using the specified ParamMap.--- 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 ctx <- prepareTemplate fp-       applyTemplate ctx mp+-- | Fill a template with values and print it as Text+applyTemplate :: FilePath -> SmartyCtx -> ParamMap -> Either SmartyError T.Text+applyTemplate a b c =+    runIdentity $ runExceptT $ applyTemplate' a b c -applyPrintDirective :: T.Text -> PrintDirective -> EvalM T.Text-applyPrintDirective t "urlencode" =-    return $ T.pack $ urlEncode $ T.unpack t-applyPrintDirective t "nl2br" =-    return $ T.replace "\n" "<br />" t-applyPrintDirective t "escape" =-    return $ T.pack $ htmlEscape $ T.unpack t+applyTemplate' :: Monad m => FilePath -> SmartyCtx -> ParamMap -> ExceptT SmartyError m T.Text+applyTemplate' template ctx mp =+    do getTpl <-+           case HM.lookup template (unSmartyCtx ctx) of+             Just ok -> pure ok+             Nothing ->+                 throwError (SmartyError $ T.pack $ "Template " ++ template ++ " not compiled")+       evalTpl (mkEnv mp ctx) getTpl++txtPdHelper ::+    Monad m => Env -> Expr -> (T.Text -> T.Text) -> ExceptT SmartyError m Expr+txtPdHelper env expr go =+    do t <- exprToText env expr+       return $ ExprLit $ A.String $ go t++applyPrintDirective :: Monad m => Env -> Expr -> PrintDirective -> EvalM m Expr+applyPrintDirective env expr "json" =+    do evaled <- evalExpr env expr+       pure $ ExprLit $ A.String $ T.decodeUtf8 $ BSL.toStrict $ A.encode evaled+applyPrintDirective env expr "urlencode" =+    txtPdHelper env expr (T.pack . urlEncode . T.unpack)+applyPrintDirective env expr "nl2br" =+    txtPdHelper env expr (T.replace "\n" "<br />")+applyPrintDirective env expr "escape" =+    txtPdHelper env expr (T.pack . htmlEscape . T.unpack)     where+      forbidden :: String       forbidden = "<&\">'/"       htmlEscape :: String -> String       htmlEscape [] = []@@ -98,59 +142,85 @@                       , htmlEscape xs                       ]           else x : htmlEscape xs-applyPrintDirective _ pd =+applyPrintDirective _ _ pd =     throwError $ SmartyError $     T.concat [ "Unknown print directive `"              , pd              , "`"              ] -evalTpl :: Env -> Smarty -> EvalM T.Text+evalTpl :: Monad m => Env -> Smarty -> EvalM m T.Text evalTpl env (Smarty _ tpl) =-    evalBody env tpl+    snd <$> seqStmts env tpl -evalStmt :: Env -> SmartyStmt -> EvalM T.Text-evalStmt _ (SmartyText t) = return t-evalStmt _ (SmartyComment _) = return T.empty+evalStmt :: Monad m => Env -> SmartyStmt -> EvalM m (Env, T.Text)+evalStmt env (SmartyScope sc) =+    do (_, body) <- seqStmts env (s_stmts sc)+       pure (env, body)+evalStmt env (SmartyFun fd) =+    do args <-+           forM (fd_defArgs fd) $ \(n, expr) ->+           do r <- evalExpr env expr+              pure (n, r)+       let fun =+               HM.insert (fd_name fd) (fd_body fd, args) (e_fun env)+       pure (env { e_fun = fun }, T.empty)+evalStmt env (SmartyCapture cap) =+    do (_, body) <- seqStmts env (c_stmts cap)+       let eVars =+               HM.insert (c_name cap) (TemplateVar (A.String body) mempty) (e_var env)+       pure (env { e_var = eVars }, T.empty)+evalStmt env (SmartyLet l) =+    do r <- evalExpr env (l_expr l)+       let eVars =+               HM.insert (l_name l) (TemplateVar r mempty) (e_var env)+       pure (env { e_var = eVars }, T.empty)+evalStmt env (SmartyText t) = return (env, t)+evalStmt env (SmartyComment _) = return (env, T.empty) evalStmt env (SmartyPrint expr directives) =-    do t <- exprToText env expr-       foldM applyPrintDirective t directives+    do e <- foldM (applyPrintDirective env) expr directives+       (,) <$> pure env <*> exprToText env e evalStmt env (SmartyIf (If cases elseBody)) =     do evaledCases <- mapM (\(cond, body) ->                                 do r <- evalExpr env cond-                                   b <- evalBody env body+                                   (_, b) <- seqStmts env body                                    case r of-                                     (A.Bool True) ->-                                         return $ Just b-                                     _ ->+                                     (A.Bool False) ->                                          return Nothing+                                     A.Null -> return Nothing+                                     (A.Array v) | null v -> return Nothing+                                     _ ->+                                         return $ Just b                            ) cases        case catMaybes evaledCases of          (x:_) ->-             return x+             return (env, x)          _ ->              case elseBody of                Just elseB ->-                   evalBody env elseB+                   (,) <$> pure env <*> (snd <$> seqStmts env elseB)                Nothing ->-                   return T.empty-+                   return (env, T.empty) evalStmt env (SmartyForeach (Foreach source mKey val body elseBody)) =     do evaledSource <- evalExpr env source        (preparedSource, size) <- mkForeachInput evaledSource        if size == 0        then case elseBody of-              Just b -> evalBody env b-              Nothing -> return T.empty+              Just b -> (,) <$> pure env <*> (snd <$> seqStmts env b)+              Nothing -> return (env, T.empty)        else do runs <- mapM (evalForeachBody env mKey val body) preparedSource-               return $ T.concat runs+               return (env, T.concat runs) -evalBody :: Env -> [SmartyStmt] -> EvalM T.Text-evalBody env stmt =-    do b <- mapM (evalStmt env) stmt-       return $ T.concat b+seqStmts :: Monad m => Env -> [SmartyStmt] -> EvalM m (Env, T.Text)+seqStmts env stmt =+    do let go (ebase, tb) st =+               do (e, t) <- evalStmt ebase st+                  pure (e, tb <> TLB.fromText t)+       (e', tb) <-+           foldM go (env, mempty) stmt+       return (e', TL.toStrict $ TLB.toLazyText tb) -exprToText :: Env -> Expr -> EvalM T.Text+exprToText :: Monad m => Env -> Expr -> EvalM m T.Text exprToText env expr =     do evaled <- evalExpr env expr        case evaled of@@ -164,17 +234,22 @@          A.Array a ->              return $ T.pack $ show a -evalForeachBody :: Env -> Maybe T.Text -> T.Text -> [ SmartyStmt ] -> ( A.Value, A.Value, PropMap ) -> EvalM T.Text-evalForeachBody env mKey item body (keyVal, itemVal, props) =-    let env' = HM.insert item (TemplateVar itemVal props) env+evalForeachBody ::+    Monad m+    => Env -> Maybe T.Text -> T.Text -> [ SmartyStmt ]+    -> ( A.Value, A.Value, PropMap )+    -> EvalM m T.Text+evalForeachBody envFull mKey item body (keyVal, itemVal, props) =+    let env = e_var envFull+        env' = HM.insert item (TemplateVar itemVal props) env         env'' =             case mKey of               Just key -> HM.insert key (TemplateVar keyVal HM.empty) env'               Nothing -> env'-    in evalBody env'' body+    in snd <$> seqStmts (envFull { e_var = env'' }) body  -mkForeachInput :: A.Value -> EvalM ( [ ( A.Value, A.Value, PropMap ) ], Int)+mkForeachInput :: Monad m => A.Value -> EvalM m ( [ ( A.Value, A.Value, PropMap ) ], Int) mkForeachInput (A.Array vec) =     return $ ( V.toList $ V.imap (\idx el ->                                       ( A.Number (fromIntegral idx)@@ -213,36 +288,22 @@       size = fromIntegral size'       idx = fromIntegral idx' -str :: T.Text -> A.Value -> EvalM T.Text+str :: Monad m => T.Text -> A.Value -> EvalM m T.Text str _ (A.String x) = return x str desc _ = throwError $ SmartyError $ T.concat [ "`", desc, "` is not a string!" ] -int :: T.Text -> A.Value -> EvalM Int-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 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 :: (Eq a, Show a, Monad m) => T.Text -> a -> [(a, A.Value)] -> (A.Value -> EvalM m b) -> EvalM m b ifExists msg key env fun =     case lookup key env of       Just x -> fun x       Nothing ->           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 :: Monad m => T.Text -> T.Text -> [(T.Text, A.Value)] -> EvalM m T.Text lookupStr funName key env =     ifExists (T.concat ["Param for `", funName, "`"]) key env (str key) -evalFunCall :: Env -> T.Text -> [ (T.Text, Expr) ] -> EvalM A.Value+evalFunCall :: Monad m => Env -> T.Text -> [ (T.Text, Expr) ] -> EvalM m A.Value evalFunCall env "include" args =     do evaledArgs <- mapM (\(k, expr) ->                                do val <- evalExpr env expr@@ -252,28 +313,37 @@        let otherArgs = filter (\(k, _) ->                                    not $ k `elem` [ "include" ]                               ) evaledArgs-           asTplParams = HM.fromList $ map (\(k, v) -> (k, TemplateParam v)) otherArgs-       content <- liftIO $ renderTemplate (T.unpack filename) asTplParams-       case content of-         Right c ->-             return $ A.String c-         Left e ->-             throwError $ SmartyError $ T.concat ["Include failed. Error: ", unSmartyError e]-evalFunCall _ fname _ =-    throwError $ SmartyError $-    T.concat [ "Call to undefined function "-             , fname-             ]+           asTplParams = HM.fromList $ map (\(k, v) -> (k, v)) otherArgs+       A.String <$> applyTemplate' (T.unpack filename) (e_ctx env) asTplParams+evalFunCall env fname args =+    case HM.lookup fname (e_fun env) of+      Just (fBody, fDefArgs) ->+          do localArgs <-+                 forM args $ \(n, expr) ->+                 do r <- evalExpr env expr+                    pure (n, r)+             let myArgs =+                     fmap (\v -> TemplateVar v mempty) $+                     HM.fromList localArgs `HM.union` HM.fromList fDefArgs+                 callEnv =+                     myArgs `HM.union` e_var env+             (_, res) <- seqStmts (env { e_var = callEnv }) fBody+             return (A.String res)+      Nothing ->+          throwError $ SmartyError $+          T.concat [ "Call to undefined function "+                   , fname+                   ]  -evalExpr :: Env -> Expr -> EvalM A.Value+evalExpr :: Monad m => Env -> Expr -> EvalM m A.Value evalExpr _ (ExprLit v) = return v evalExpr env (ExprBin op) =     evalBinOp env op evalExpr env (ExprFun funCall) =     evalFunCall env (f_name funCall) (f_args funCall) evalExpr env (ExprVar v) =-    case HM.lookup varName env of+    case HM.lookup varName (e_var env) of       Just tplVar ->           case v of             (Variable { v_prop = Just propReq }) ->@@ -315,7 +385,7 @@     where       varName = v_name v -walkIndex :: T.Text -> A.Value -> A.Value -> EvalM A.Value+walkIndex :: Monad m => T.Text -> A.Value -> A.Value -> EvalM m A.Value walkIndex vname (A.Number idx) (A.Array arr) =     case arr !? (fromJust $ toBoundedInteger idx) of       Just val -> return val@@ -338,7 +408,7 @@              , "`. Index is not an integer or value not an array!"              ] -walkPath :: T.Text -> [T.Text] -> A.Value -> EvalM A.Value+walkPath :: Monad m => T.Text -> [T.Text] -> A.Value -> EvalM m A.Value walkPath _ [] val = return val walkPath vname (path:xs) (A.Object obj) =     case HM.lookup path obj of@@ -360,7 +430,7 @@              , "`"              ] -evalBinOp :: Env -> BinOp -> EvalM A.Value+evalBinOp :: Monad m => Env -> BinOp -> EvalM m A.Value evalBinOp env (BinEq a b) =     boolResOp (\x y -> return $ x == y) (a, b) env evalBinOp env (BinNot e) =@@ -392,7 +462,7 @@     calcOp "Div" (/) (x, y) env  -boolOp :: T.Text -> (Bool -> Bool -> Bool) -> (Expr, Expr) -> Env -> EvalM A.Value+boolOp :: Monad m => T.Text -> (Bool -> Bool -> Bool) -> (Expr, Expr) -> Env -> EvalM m A.Value boolOp d op exprs env =     boolResOp bOp exprs env     where@@ -400,17 +470,17 @@           return $ a `op` b       bOp _ _ = throwError $ SmartyError $ T.concat [ "Tried ", d, "Op and on two non boolean values" ] -numOp :: T.Text -> (Scientific -> Scientific -> Bool) -> (Expr, Expr) -> Env -> EvalM A.Value+numOp :: Monad m => T.Text -> (Scientific -> Scientific -> Bool) -> (Expr, Expr) -> Env -> EvalM m A.Value numOp =     numGenOp boolResOp -calcOp :: T.Text -> (Scientific -> Scientific -> Scientific) -> (Expr, Expr) -> Env -> EvalM A.Value+calcOp :: Monad m => T.Text -> (Scientific -> Scientific -> Scientific) -> (Expr, Expr) -> Env -> EvalM m A.Value calcOp =     numGenOp numResOp -numGenOp :: ((A.Value -> A.Value -> EvalM a)-                 -> (Expr, Expr) -> Env -> EvalM A.Value)-         -> T.Text -> (Scientific -> Scientific -> a) -> (Expr, Expr) -> Env -> EvalM A.Value+numGenOp :: Monad m => ((A.Value -> A.Value -> EvalM m a)+                 -> (Expr, Expr) -> Env -> EvalM m A.Value)+         -> T.Text -> (Scientific -> Scientific -> a) -> (Expr, Expr) -> Env -> EvalM m A.Value numGenOp fun d op exprs env =     fun nOp exprs env     where@@ -418,15 +488,15 @@           return $ a `op` b       nOp _ _ = throwError $ SmartyError $ T.concat [ "Tried ", d, "Op and on two non numeric values" ] -numResOp :: (A.Value -> A.Value -> EvalM Scientific)-       -> (Expr, Expr) -> Env -> EvalM A.Value+numResOp :: Monad m => (A.Value -> A.Value -> EvalM m Scientific)+       -> (Expr, Expr) -> Env -> EvalM m A.Value numResOp fun (a, b) env =     do a' <- evalExpr env a        b' <- evalExpr env b        A.Number <$> fun a' b' -boolResOp :: (A.Value -> A.Value -> EvalM Bool)-       -> (Expr, Expr) -> Env -> EvalM A.Value+boolResOp :: Monad m => (A.Value -> A.Value -> EvalM m Bool)+       -> (Expr, Expr) -> Env -> EvalM m A.Value boolResOp fun (a, b) env =     do a' <- evalExpr env a        b' <- evalExpr env b

@@ -1,9 +1,10 @@ {-# OPTIONS_GHC -fwarn-unused-imports -fwarn-incomplete-patterns #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StrictData #-} module Text.HSmarty.Types where -import qualified Data.Text as T import qualified Data.Aeson as A+import qualified Data.Text as T  data Smarty    = Smarty@@ -18,7 +19,11 @@    | SmartyComment T.Text    | SmartyIf If    | SmartyForeach Foreach+   | SmartyCapture Capture+   | SmartyLet Let    | SmartyPrint Expr [ PrintDirective ]+   | SmartyScope Scope+   | SmartyFun FunctionDef    deriving (Eq, Show)  data Expr@@ -58,6 +63,30 @@    | BinMul Expr Expr    | BinDiv Expr Expr    deriving (Eq, Show)++data Let+    = Let+    { l_name :: T.Text+    , l_expr :: Expr+    } deriving (Show, Eq)++data Scope+    = Scope+    { s_stmts :: [SmartyStmt]+    } deriving (Show, Eq)++data Capture+    = Capture+    { c_name :: T.Text+    , c_stmts :: [SmartyStmt]+    } deriving (Show, Eq)++data FunctionDef+    = FunctionDef+    { fd_name :: T.Text+    , fd_defArgs :: [(T.Text, Expr)]+    , fd_body :: [SmartyStmt]+    } deriving (Show, Eq)  data If    = If

@@ -45,7 +45,23 @@  test_varParser :: IO () test_varParser =-    parserTest pVar "$hallo.sub@prop" (Variable "hallo" ["sub"] Nothing (Just "prop"))+    do parserTest pVar "$hallo.sub@prop" (Variable "hallo" ["sub"] Nothing (Just "prop"))+       parserTest pVar "$hallo.foo_bar" (Variable "hallo" ["foo_bar"] Nothing Nothing)++test_if :: IO ()+test_if =+    do parserTest pIf "{if $var@last}Bye{/if}" expect+       parserTest pIf "{if ($var@last)}Bye{/if}" expect+    where+      expect =+          If+          { if_cases =+                  [( ExprVar (Variable "var" [] Nothing (Just "last"))+                   , [SmartyText "Bye"]+                   )+                  ]+          , if_else = Nothing+          }  test_rootParser :: IO () test_rootParser =