ert 0.0.1.0 → 0.0.1.1
raw patch · 6 files changed
+1115/−1083 lines, 6 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Data.EasyTpl: instance Eq BinaryOperator
- Data.EasyTpl: instance Eq Control
- Data.EasyTpl: instance Eq Expression
- Data.EasyTpl: instance Eq Template
- Data.EasyTpl: instance Eq TemplateToken
- Data.EasyTpl: instance Eq UnaryOperator
- Data.EasyTpl: instance Show BinaryOperator
- Data.EasyTpl: instance Show Control
- Data.EasyTpl: instance Show Expression
- Data.EasyTpl: instance Show Template
- Data.EasyTpl: instance Show TemplateToken
- Data.EasyTpl: instance Show UnaryOperator
Files
- Data/EasyTpl.hs +0/−1060
- ert.cabal +23/−23
- library/Data/EasyTpl.hs +538/−0
- library/Data/EasyTpl/Parser.hs +239/−0
- library/Data/EasyTpl/Render.hs +250/−0
- library/Data/EasyTpl/Types.hs +65/−0
− Data/EasyTpl.hs
@@ -1,1060 +0,0 @@-{-# OPTIONS_HADDOCK -ignore-exports #-}-{-|-Module : Data.EasyTpl-Description : Easy Template compiler and renderer.-Copyright : (c) Kayo, 2014-License : GPL-3-Maintainer : kayo@illumium.org-Stability : experimental-Portability : POSIX--This module implements compiler and renderer for easy runtime templates.-It can be used for advanced code preprocessing or simple substitution of some variables in string.--Since template engine uses /Aeson's/ 'Value' type, you must use types, which have 'ToJSON' instances, for rendering it.-Also you can use 'Object' with variables as fields.---}--module Data.EasyTpl (- -- * Usage example- -- $usageExample- - -- * Template format- -- $docFormat-- -- ** Statements- -- $docStatements-- -- ** Expressions- -- $docExpressions- - -- * Template examples- - -- ** Assets json- -- $exampleStr- - -- ** EJS-like template- -- $exampleEjs- - -- * Types- Template- , TemplateToken- -- ** Json types- , Value(..)- , ByteString- , HashMap- , Vector- -- * Functions- -- ** Compile and render- , compile- , render- , compile'- , render'- -- ** Parsers- , parseTemplate- , parseTemplate'- , parseExpression- -- ** Utily- , defaultData- ) where--import Data.Aeson (Value(..), ToJSON)-import qualified Data.Aeson as J-import qualified Data.Aeson.Parser as JP-import qualified Data.Aeson.Encode as JE-import Data.ByteString (ByteString)-import qualified Data.ByteString as BS-import qualified Data.ByteString.Char8 as BSC-import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Lazy as LT-import qualified Data.Text.Lazy.Builder as LTB-import qualified Data.Text.Encoding as TE-import Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as H-import Data.Vector (Vector)-import qualified Data.Vector as V--import Data.Attoparsec.ByteString.Char8-import Data.Attoparsec.Expr-import qualified Data.Attoparsec.Text as AT--#ifdef WITH_REGEX-import Text.Regex (Regex)-import qualified Text.Regex as RE-#endif--import Data.Tuple (swap)-import Data.Fixed (mod')--import Prelude hiding (takeWhile)--import Control.Applicative ((<$>), (<*>), (<*), (*>), (<|>))---- | Compiled template.-newtype Template = Template [TemplateToken] -- ^ Template consists of tokens- deriving (Show, Eq)---- | Template token.-data TemplateToken = ContentToken ByteString -- ^ Chunk or raw content as is- | LiteralToken Expression -- ^ Computable expression for substitution- | ControlToken Control Template -- ^ Control block structure with sub-template- deriving (Show, Eq)---- | Control structure.-data Control = Condition Expression -- ^ Conditional statement with expression- | Iteration (Text, Text) Expression -- ^ Iterational statement with variables and expression- deriving (Show, Eq)---- | Expression.-data Expression = Constant Value --- | Variable Text- | Range Expression Expression Expression-#ifdef WITH_REGEX- | Regexp ByteString Bool Bool-#endif- | UnaryOperation UnaryOperator Expression- | BinaryOperation BinaryOperator Expression Expression- deriving (Show, Eq)---- | Unary operator-data UnaryOperator = GetLength -- ^ Length operator `#` (#value)- | Stringify -- ^ Stringify operator `\@` (\@value)- | Evaluate -- ^ Evaluate operator `=` (value=)- | LogicNot -- ^ Logical not operator `!` (!value)- | Negate -- ^ Numeric negate operator `-` (-value)- | ToNumber -- ^ Numeric cast operator `+` (+value)- | NotNull -- ^ Not null test operator `?` (value?)- deriving (Show, Eq)---- | Binary operator-data BinaryOperator = LogicOr -- ^ Logical or operator `||`- | LogicAnd -- ^ Logical and operator `&&`- | Equal -- ^ Generic equality operator `==`- | NotEqual -- ^ Generic non-equality operator `!=`- | LessThan -- ^ Lesser than operator `<`- | GreatThan -- ^ Greater than operator `>`- | LessEqual -- ^ Lesser or equal operator `<=`- | GreatEqual -- ^ Greater or equal operator `>=`- | Substract -- ^ Numeric substract operator `-`- | Append -- ^ Generic append operator `+`- | Multiply -- ^ Generic multiply operator `*`- | Divide -- ^ Generic divide operator `/`- | IntDivide -- ^ Generic integral divide operator `:`- | Module -- ^ Numeric module operator `%`- | Power -- ^ Numeric power operator `^`- | GetField -- ^ Container get field operator `.` | `[` `]` (object.field, object[field_name], array[index])-#ifdef WITH_REGEX- | RegexTest -- ^ Regular expression test operator `~` (string ~ /regex/ => bool)- | RegexMatch -- ^ Regular expression match operator `~>` (string ~> /regex/ => null | [matches])- | RegexSplit -- ^ Regular expression split operator `~:` (string ~: /regex/ => [pieces])-#endif- deriving (Show, Eq)---- | Default data for render.--- Empty data for using with standalone render.-defaultData :: Value-defaultData = Object H.empty---- | Compile template from string.-compile' :: String -> Either String Template-compile' = compile . BSC.pack---- | Compile template from ByteString.-compile :: ByteString -> Either String Template-compile = parseOnly parseTemplate---- | Render template to string.-render' :: (ToJSON e) => Template -> e -> String-render' tpl = BSC.unpack . render tpl---- | Render template to ByteString.-render :: (ToJSON e) => Template -> e -> ByteString-render tpl env = renderTemplate tpl $ J.toJSON env---- | Internal render template using hash with variables.-renderTemplate' :: Template -> HashMap Text Value -> ByteString-renderTemplate' tpl env = renderTemplate tpl $ Object env---- | Internal render template using value as variables.-renderTemplate :: Template -> Value -> ByteString-renderTemplate (Template tokens) env = BS.concat $ map (flip renderToken env) tokens---- | Internal render token.-renderToken :: TemplateToken -> Value -> ByteString--renderToken (ContentToken text) _ = text--renderToken (LiteralToken expr) env = getString $ toString $ evalExpression expr env- where- getString (String text) = TE.encodeUtf8 text- getString _ = ""--renderToken (ControlToken ctl tpl) env = renderControl ctl tpl env--renderControl :: Control -> Template -> Value -> ByteString--renderControl (Condition expr) tpl env@(Object _) = applyCondition $ toBoolean $ evalExpression expr env- where- applyCondition :: Value -> ByteString- applyCondition (Bool True) = renderTemplate tpl env- applyCondition _ = ""--renderControl (Iteration (keyVar, valVar) expr) tpl env'@(Object henv) = BS.concat $ applyIteration $ evalExpression expr env'- where- applyIteration :: Value -> [ByteString]- applyIteration (Array list) = V.toList $ V.imap applyIndex list- applyIteration (Object hash) = map applyField $ H.toList hash- applyIteration _ = []-- addLocal :: Text -> Value -> HashMap Text Value -> HashMap Text Value- addLocal var val env = if T.null var then env else H.insert var val env-- applyElement :: Value -> Value -> ByteString- applyElement key val = renderTemplate' tpl $ addLocal keyVar key $ addLocal valVar val henv- - applyIndex :: Int -> Value -> ByteString- applyIndex key val = applyElement (Number (fromIntegral key)) val- - applyField :: (Text, Value) -> ByteString- applyField (key, val) = applyElement (String key) val--renderControl _ _ _ = ""---- | Internal evaluate expression.-evalExpression :: Expression -> Value -> Value--evalExpression (Constant val) _ = val--evalExpression (Variable var) (Object henv) = maybe Null id $ H.lookup var henv-evalExpression (Variable _) _ = Null--evalExpression (Range from' to' step') env = genRange (toNumber $ evalExpression from' env)- (toNumber $ evalExpression to' env)- (toNumber $ evalExpression step' env)- where- genRange :: Value -> Value -> Value -> Value- genRange (Number from) (Number to) (Number step) =- Array $ V.fromList $ range from to step- genRange _ _ _ = Null- - range from to step | from > to = []- | otherwise = Number from : range (from + step) to step--evalExpression (UnaryOperation op' a') env = unary op' (evalExpression a' env)- where- unary :: UnaryOperator -> Value -> Value- - unary GetLength = getLength- unary Stringify = stringify- unary Evaluate = either (String . T.pack . ("Error: " ++)) (flip evalExpression env) . parseOnly parseExpression . toByteString- unary LogicNot = booleanOp not- unary Negate = numericOp (0 -)- unary ToNumber = numericOp id- unary NotNull = Bool . notNull-- notNull :: Value -> Bool- notNull Null = False- notNull _ = True-- booleanOp :: (Bool -> Bool) -> Value -> Value- booleanOp op a = case toBoolean a of- Bool b -> Bool $ op b- _ -> Null- - numericOp op a = case toNumber a of- Number n -> Number $ op n- _ -> Null-- toByteString a = case toString a of- String s -> TE.encodeUtf8 s- _ -> ""- -#ifdef WITH_REGEX-evalExpression (BinaryOperation op' a' (Regexp re ml cs)) env = apply op' $ toString $ evalExpression a' env- where- apply RegexTest (String s) = Bool $ maybe False (\_ -> True) $ match s- apply RegexMatch (String s) = maybe Null (Array . V.fromList . map (String . T.pack)) $ match s- apply RegexSplit (String s) = Array $ V.fromList $ map String $ split s- apply _ _ = Null- - match :: Text -> Maybe [String]- match = RE.matchRegex regex . T.unpack-- split :: Text -> [Text]- split = map T.pack . RE.splitRegex regex . T.unpack- - regex :: Regex- regex = RE.mkRegexWithOpts (BSC.unpack re) ml cs---- regexps is non-evaluatable-evalExpression (Regexp _ _ _) _ = Null-#endif--evalExpression (BinaryOperation op' a' b') env = binary op' (evalExpression a' env) (evalExpression b' env)- where- binary :: BinaryOperator -> Value -> Value -> Value- - binary Equal a = Bool . (a ==)- binary NotEqual a = Bool . (a /=)- - binary Append (String a) = applyToString $ String . T.append a- binary Multiply (String a) = applyToInteger $ String . flip T.replicate a- binary IntDivide (String a) = applyToString $ Array . V.fromList . map String . flip T.splitOn a- binary LessThan (String a) = applyToString $ Bool . (a <)- binary GreatThan (String a) = applyToString $ Bool . (a >)- binary LessEqual (String a) = applyToString $ Bool . (a <=)- binary GreatEqual (String a) = applyToString $ Bool . (a >=)- - binary GetField (String s) = applyToInteger (\i -> if i >= 0 && i < T.length s then String $ T.singleton $ T.index s i else Null)- - binary LessThan (Number a) = applyToNumber $ Bool . (a <)- binary GreatThan (Number a) = applyToNumber $ Bool . (a >)- binary LessEqual (Number a) = applyToNumber $ Bool . (a <=)- binary GreatEqual (Number a) = applyToNumber $ Bool . (a >=)- - binary GetField (Array a) = applyToInteger (maybe Null id . (V.!?) a)- binary GetField (Object a) = applyToString (maybe Null id . flip H.lookup a)- - binary op a = binary' op a- - binary' LogicOr = booleanOp (||)- binary' LogicAnd = booleanOp (&&)- - binary' Substract = numericOp (-)- binary' Append = numericOp (+)- binary' Multiply = numericOp (*)- binary' Divide = numericOp (/)- binary' IntDivide = numericOp' (/)- binary' Module = numericOp mod'- --binary' Power = numericOp pow- binary' _ = \_ _ -> Null- - numericOp op a b = case (toNumber a, toNumber b) of- (Number na, Number nb) -> Number $ op na nb- _ -> Null-- numericOp' op a b = case (toNumber a, toNumber b) of- (Number na, Number nb) -> Number $ fromIntegral ((round $ op na nb) :: Integer)- _ -> Null- - booleanOp op a b = case (toBoolean a, toBoolean b) of- (Bool ba, Bool bb) -> Bool $ op ba bb- _ -> Null- - applyToString fn v = case toString v of- String s -> fn s- _ -> Null-- applyToNumber fn v = case toNumber v of- Number n -> fn $ n- _ -> Null- - applyToInteger fn = applyToNumber (fn . round)- --- | Generic get length.-getLength :: Value -> Value-getLength (String text) = Number $ fromIntegral $ T.length text-getLength (Array list) = Number $ fromIntegral $ V.length list-getLength (Object hash) = Number $ fromIntegral $ H.size hash-getLength _ = Null---- | Cast value to boolean.-toBoolean :: Value -> Value-toBoolean bool@(Bool _) = bool-toBoolean (Number val) = Bool $ val /= I 0-toBoolean (String text) = Bool $ not $ T.null text-toBoolean Null = Bool False-toBoolean (Object hash) = Bool $ not $ H.null hash-toBoolean (Array list) = Bool $ not $ V.null list---- | Cast any value to number.--- Returns null if non-castable.-toNumber :: Value -> Value-toNumber val@(Number _) = val-toNumber (Bool bool) = Number $ if bool then 1 else 0-toNumber (String text) = getNumber' $ AT.parse AT.number text- where- getNumber' (AT.Done _ val) = Number val- getNumber' _ = Null-toNumber _ = Null---- | Cast any value to string.-toString :: Value -> Value-toString text@(String _) = text-toString (Number val) = String $ T.pack $ show val-toString Null = String "[null]"-toString (Bool _) = String "[bool]"-toString (Object _) = String "[object]"-toString (Array _) = String "[array]"---- | Stringify value to JSON.--- Stringify any value using JSON format by AESON encode.-stringify :: Value -> Value-stringify = String . LT.toStrict . LTB.toLazyText . JE.fromValue---- <% for key, value of iterable %>--- <% if condition %>--- <%= literal =%>--- <% end %>--- <% end %>---- | Template parser function.--- Use this for parsing templates.-parseTemplate :: Parser Template-parseTemplate = Template <$> parseTokens- where- parseTokens = do- end <- atEnd- case end of- True -> return []- _ -> (:) <$> parseToken <*> parseTokens---- | Less template parser.--- Used internally for parsing subtemplates.-parseTemplate' :: Parser Template-parseTemplate' = Template <$> many' parseToken---- | Template token parser.-parseToken :: Parser TemplateToken-parseToken = parseControl <|> parseLiteral <|> parseContent---- | Control token parser.-parseControl :: Parser TemplateToken-parseControl = ControlToken <$> blockOpen <*> parseTemplate' <* blockClose- where- blockOpen = "<%" *> spaces *> parseAction <* spaces <* "%>"- blockClose = "<%" >> spaces >> "end" >> spaces >> "%>"- - parseAction = parseCondition <|> parseIteration---- | Literal token parser.-parseLiteral :: Parser TemplateToken-parseLiteral = LiteralToken <$> ("<%=" *> parseExpression <* "%>") <?> "Invalid literal"---- | Content token parser.-parseContent :: Parser TemplateToken-parseContent = many1' getChunk >>= return . ContentToken . BS.concat- where- getChunk :: Parser ByteString- getChunk = (takeWhile1 (/= '<')) <|>- ((cat2 <$> char '<' <*> notChar '%') <|>- (cat2 <$> char '<' <* char '\\' <*> char '%') >>=- return . BSC.pack)-- cat2 a b = a:[b]---- | Condition control parser.--- `if ` expression => Condition expression-parseCondition :: Parser Control-parseCondition = Condition <$> ("if" *> spaces1 *> parseExpression)---- | Iteration control parser.--- `for ` ( value [`,` index] ` in` | field [`,` value] ` of` )-parseIteration :: Parser Control-parseIteration = Iteration <$> ("for" *> spaces1 *> (valueIndex <|> fieldValue))- <*> (spaces1 *> parseExpression)- where- valueIndex = swap <$> pair <* spaces1 <* "in"- fieldValue = pair <* spaces1 <* "of"- - pair = (,) <$> option "" parseIdentifier- <*> option "" (spaces *> char ',' *> spaces *> parseIdentifier)---- | Expression parser.--- Use this for parsing expressions.-parseExpression :: Parser Expression-parseExpression = spaces *> buildExpressionParser operatorTable parsePrimary <* spaces- where- operatorTable :: OperatorTable ByteString Expression- operatorTable = [ {-[ field '.' parseFieldName GetField- , block '[' ']' parseExpression GetField- ]- , -}- [ unary '?' True NotNull- ]- , [ unary '#' False GetLength- , unary '!' False LogicNot- , unary '-' False Negate- , unary '+' False ToNumber- ]- , [ binary '^' AssocRight Power- ]- , [ binary '*' AssocLeft Multiply - , binary '/' AssocLeft Divide- , binary ':' AssocLeft IntDivide- , binary '%' AssocLeft Module- ]- , [ binary '-' AssocLeft Substract- , binary '+' AssocLeft Append- ]- , [ binary' "~>" AssocNone RegexMatch -- !important: before ~- , binary' "~:" AssocNone RegexSplit -- !important: before ~- , binary '~' AssocNone RegexTest- ]- , [ binary' "==" AssocLeft Equal- , binary' "!=" AssocLeft NotEqual- , binary' "<=" AssocLeft LessEqual -- !important: before <- , binary' ">=" AssocLeft GreatEqual -- !important: before >- , binary '<' AssocLeft LessThan- , binary '>' AssocLeft GreatThan- ]- , [ binary' "||" AssocLeft LogicOr- , binary' "&&" AssocLeft LogicAnd- ]- , [ unary '=' True Evaluate- ]- , [ unary '@' False Stringify- ]- ]- {-- parseFieldName :: Parser Expression- parseFieldName = (Constant . String) <$> parseIdentifier-- field :: Char -> Parser Expression -> BinaryOperator -> Operator ByteString Expression- field op ex tp = Postfix (spaces *> char op *> spaces *> ex <* spaces >>=- return . flip (BinaryOperation tp))-- block :: Char -> Char -> Parser Expression -> BinaryOperator -> Operator ByteString Expression- block op cl ex tp = Postfix (spaces *> char op *> ex <* char cl <* spaces >>=- return . flip (BinaryOperation tp))- -}- unary :: Char -> Bool -> UnaryOperator -> Operator ByteString Expression- unary op po tp = (if po then Postfix else Prefix)- (spaces >> char op >> spaces >>- return (UnaryOperation tp))- - binary :: Char -> Assoc -> BinaryOperator -> Operator ByteString Expression- binary op ac tp = Infix (spaces >> char op >> spaces >>- return (BinaryOperation tp)) ac-- binary' :: Parser ByteString -> Assoc -> BinaryOperator -> Operator ByteString Expression- binary' op ac tp = Infix (spaces >> op >> spaces >>- return (BinaryOperation tp)) ac---- | Primary expression parser.--- A sequence of .field/[index] operations can be applied to primary expressions (excluding regular expressions).-parsePrimary :: Parser Expression-parsePrimary = ((parseParens- <|> parseVariable- <|> parseRange- <|> parseConstant) >>= parseFields)-#ifdef WITH_REGEX- <|> parseRegex-#endif---- | Parens primary expression.--- `(` expression `)` => expression-parseParens :: Parser Expression-parseParens = char '(' *> parseExpression <* char ')'---- | Variable primary expression.--- identifier => Variable identifier-parseVariable :: Parser Expression-parseVariable = Variable <$> parseIdentifier---- | Sequence of field/index operations--- `.` key@identifier | `[` key@expression `]` => BinaryOperation GetField topexpr key-parseFields :: Expression -> Parser Expression-parseFields prev = option prev ((parseField <|> parseIndex) >>= parseFields . BinaryOperation GetField prev)- where- parseField :: Parser Expression- parseField = spaces *> char '.' *> parseIdentifier <* spaces >>= return . Constant . String- - parseIndex :: Parser Expression- parseIndex = spaces *> char '[' *> parseExpression <* char ']' <* spaces---- | Range expression (array generator).--- `[` [from] `..` to [`,` step] `]` => Range from to step-parseRange :: Parser Expression-parseRange = char '[' *> (Range <$> option defaultFrom parseExpression <* ".." <*>- parseExpression <*> option defaultStep (char ',' *> parseExpression)) <* char ']'- where- defaultFrom = Constant $ Number 0- defaultStep = Constant $ Number 1--#ifdef WITH_REGEX--- | Regular expression (posix regex).--- `/` regex `/` [caseInsensitive@`i`] [multiLine@`m`] => Regexp regex !caseInsensitive multiLine-parseRegex :: Parser Expression-parseRegex = Regexp <$> (char '/' *> regexpBody <* char '/') <*> caseSensitive <*> multiLine- where- regexpBody :: Parser ByteString- regexpBody = many1' getChunk >>= return . BS.concat- - getChunk :: Parser ByteString- getChunk = (takeWhile1 (\c -> c /= '/' && c /= '\\')) <|>- (char '\\' >> char '/' >> return "/") <|>- (char '\\' >> return "\\")-- caseSensitive :: Parser Bool- caseSensitive = option True $ char 'i' >> return False-- multiLine :: Parser Bool- multiLine = option False $ char 'm' >> return True-#endif---- | Constant expression (environment independent).--- It's just a JSON value parsed by AESON.-parseConstant :: Parser Expression-parseConstant = Constant <$> JP.value'---- | Identifier--- Identifiers starts from `a-zA-Z` (alphabetic character), `_` (underscore) or `$` (dollar) and consists of `a-zA-Z0-9`, `_` or `$`.-parseIdentifier :: Parser Text-parseIdentifier = do- first <- firstChar- rest <- many' otherChar- return $ T.pack $ first : rest- where- firstChar = satisfy isAlpha_ascii <|> satisfy (inClass "_$")- otherChar = firstChar <|> satisfy isDigit---- | Skip zero or more spaces--- `space`*-spaces :: Parser ()-spaces = skipWhile isSpace---- | Skip one or more spaces--- `space`+-spaces1 :: Parser ()-spaces1 = skipSpace >> spaces--{- $usageExample--> import Data.Aeson-> import Data.EasyTpl (compile, render)-> import Data.ByteString (readFile, writeFile)->-> data TplVars = TplVars { ... }->-> instance ToJSON TplVars-> ...->-> main = do->-> template <- readFile "template.tpl" >>=-> either error return . compile->-> let result = render Template $ TplVars { ... }->-> writeFile "output.txt" result---}--{- $docFormat--Templates consists of:-- [Control structures] Entities, enclosed by @\<%@ and @%\>@.-- [Substitution expressions] Entities, enclosed by @\<%=@ and @%\>@.-- [Raw content] Anything not controls and literals, interprets as is.---}--{- $docStatements--Control structures:-- [@/if/@ control]-- @- \<% if /expression/ %\>- The content, which will be displayed, if result of /expression/ evaluation is /true/.- \<% end %\>- @-- [@/for/@ control]- - Basic form:-- @- \<% for /value/ /[,/ /index/ /]/ in /expression/ %\>- The content, which will be displayed for each entry in result of /expression/ evaluation.- Variables /value/ and (optional) /index/ contains entry value and number respectively.- \<% end %\>- @-- Alternative form:- - @- \<% for /field/ /[,/ /value/ /]/ in /expression/ %\>- The content, which will be displayed for each entry in result of /expression/ evaluation.- Variables /field/ and (optional) /value/ contains entry key and value respectively.- \<% end %\>- @-- The /expression/ must be iteratable, like /Array/ or /Object/.---}--{- $docExpressions--Expressions is:-- [Constants] Json Values, like /string/, /number/, /object/, /array/, /true/, /false/, /null/-- [Variables] Text entities, identified by name-- [Ranges] Generated arrays of integers-- [Regexps] Regular expressions, enclosed by @\/@ and @\/@ with @i@ and @m@ options.-- [Unary operators] Applied to single expression-- [Binary operators] Applied to twin expressions--/Prefix unary operations/:-- [Get length @#@] Applied to /string/, /object/, /array/. For anything other gives /null/.-- [Stringify @\@@] Converts value to /JSON/ string.-- [Logical not @!@] Inverts boolean value.-- [Numeric negate @-@] Negates numeric value.-- [To number @+@] Forces value to be a numeric.--/Postfix unary operations/:-- [Evaluate @=@] Evaluates string as expression.-- [Not null @?@] Tests value to not be a /null/.--/Generic binary operations/:-- [Equal @==@, Not equal @!=@] Tests values to be an equal.-- [Compare @\<@, @\>@, @\<=@, @\>=@] Compares values.--/Numeric binary operations/:-- [Arithmetic @+@, @-@, @*@, @/@] Simple calculations.-- [Integer division @:@, Extract module @\%@]--/String binary operations/:-- [Concat @+@] Concatenates two strings.-- [Split @:@] Splits string to array of strings by sepatator.-- [Repeat @*@] Repeats string N times.-- [Regex test @~@] Tests string to match regex.-- [Regex match @~\>@] Extract matches from string by appling regex.-- [Regex split @~:@] Split string to array of strings by regex.--/Logical binary operations/:-- [Logical and @&&@]-- [Logical or @||@]--/Container indexing operations/:-- [Get field @.@ /fieldName/] Extracts field, which identified by name.-- [Get index @\[@ /expression/ @\]@] Extracts field by number or evaluated name.-- This operations applyed sequentially to container types, like /string/, /array/, /object/.--/Range expressions/:-- @\[@ \[/from/\] @..@ /to/ \[, /step/\] @\]@-- This expressins generates arrays of numeric values in range /from/ including /to/ by /step/.-- By default /from/ is /0/, and /step/ is /1/.--/Regular expressions/:-- @\/@ /expression/ @\/@ \[/i/\] \[/m/\]-- Posix regular expressions are supported.-- * @i@-modifier forses case-insensitive mode.-- * @m@-modifier forces multiline mode.---}--{- $exampleStr--* Template:--> {<%-> for res, num in assets-> %>-> "<%=-> res.name-> %>": "<%-> if #root>0-> %><%=-> root-> %>/<%-> end-> %><%=-> prefix[res.type]-> %><%=-> res.name-> %><%-> if suffix[res.type]?-> %><%=-> suffix[res.type]-> %><%-> end-> %>"<%-> if num+1<#assets-> %>,<%-> end-> %><%-> end-> %>-> }--* Compiled template:--> (Template [-> ContentToken "{",-> ControlToken-> (Iteration ("num","res") (Variable "assets"))-> (Template [-> ContentToken "\n \"",-> LiteralToken-> (BinaryOperation GetField-> (Variable "res")-> (Constant (String "name"))),-> ContentToken "\": \"",-> ControlToken-> (Condition-> (BinaryOperation GreatThan-> (UnaryOperation GetLength-> (Variable "root"))-> (Constant (Number 0))))-> (Template [-> LiteralToken-> (Variable "root"),-> ContentToken "/"-> ]),-> LiteralToken-> (BinaryOperation GetField-> (Variable "prefix")-> (BinaryOperation GetField-> (Variable "res")-> (Constant (String "type")))),-> LiteralToken-> (BinaryOperation GetField-> (Variable "res")-> (Constant (String "name"))),-> ControlToken-> (Condition-> (UnaryOperation NotNull-> (BinaryOperation GetField-> (Variable "suffix")-> (BinaryOperation GetField-> (Variable "res")-> (Constant (String "type"))))))-> (Template [-> LiteralToken-> (BinaryOperation GetField-> (Variable "suffix")-> (BinaryOperation GetField-> (Variable "res")-> (Constant (String "type"))))]),-> ContentToken "\"",-> ControlToken-> (Condition-> (BinaryOperation LessThan-> (BinaryOperation Append-> (Variable "num")-> (Constant (Number 1)))-> (UnaryOperation GetLength-> (Variable "assets"))))-> (Template [-> ContentToken ","-> ])-> ]),-> ContentToken "\n}\n"-> ])--* Yaml Dataset:--> prefix:-> script: js/-> style: css/-> image: gfx/-> suffix:-> script: .min.js-> style: .min.css-> assets:-> - type: script-> name: client-> - type: style-> name: styles-> - type: style-> name: bootstrap-> - type: script-> name: react-> - type: image-> name: icons.png-> - type: image-> name: photo.jpg--* Render result:--> {-> "client": "js/client.min.js",-> "styles": "css/styles.min.css",-> "bootstrap": "css/bootstrap.min.css",-> "react": "js/react.min.js",-> "icons.png": "gfx/icons.png",-> "photo.jpg": "gfx/photo.jpg"-> }---}--{- $exampleEjs--* Template:--> <ul><%-> for item in items %>-> <li><%-> if item.url ~ /^http/-> %><a href="<%= item.url %>"<%-> if item.description?-> %> title="<%= item.description %>"<%-> end-> %>><%-> if item.title?-> %><%= item.title %><%-> end-> %><%-> if !(item.title?)-> %><%= (item.url ~> /[^\:]*\:\/\/([^\/]+)/)[0] %><%-> end-> %></a><%-> end-> %><%-> if !(item.url ~ /^http/)-> %><button link="<%= item.url %>"><%= item.title %></button><%-> end-> %></li><%-> end %>-> </ul>--* Compiled template:--> (Template [-> ContentToken "<ul>",-> ControlToken-> (Iteration ("","item") (Variable "items"))-> (Template [-> ContentToken "\n <li>",-> ControlToken-> (Condition-> (BinaryOperation RegexTest-> (BinaryOperation GetField-> (Variable "item")-> (Constant (String "url")))-> (Regexp "^http" True False)))-> (Template [-> ContentToken "<a href=\"",-> LiteralToken-> (BinaryOperation GetField-> (Variable "item")-> (Constant (String "url"))),-> ContentToken "\"",-> ControlToken-> (Condition-> (UnaryOperation NotNull-> (BinaryOperation GetField-> (Variable "item")-> (Constant (String "description")))))-> (Template [-> ContentToken " title=\"",-> LiteralToken-> (BinaryOperation GetField-> (Variable "item")-> (Constant (String "description"))),-> ContentToken "\""-> ]),-> ContentToken ">",-> ControlToken-> (Condition-> (UnaryOperation NotNull-> (BinaryOperation GetField-> (Variable "item")-> (Constant (String "title")))))-> (Template [-> LiteralToken-> (BinaryOperation GetField-> (Variable "item")-> (Constant (String "title")))-> ]),-> ControlToken-> (Condition-> (UnaryOperation LogicNot-> (UnaryOperation NotNull-> (BinaryOperation GetField-> (Variable "item")-> (Constant (String "title"))))))-> (Template [-> LiteralToken-> (BinaryOperation GetField-> (BinaryOperation RegexMatch-> (BinaryOperation GetField-> (Variable "item")-> (Constant (String "url")))-> (Regexp "[^\\:]*\\://([^/]+)" True False))-> (Constant (Number 0)))-> ]),-> ContentToken "</a>"-> ]),-> ControlToken-> (Condition-> (UnaryOperation LogicNot-> (BinaryOperation RegexTest-> (BinaryOperation GetField-> (Variable "item")-> (Constant (String "url")))-> (Regexp "^http" True False))))-> (Template [-> ContentToken "<button link=\"",LiteralToken (BinaryOperation GetField (Variable "item") (Constant (String "url"))),-> ContentToken "\">",-> LiteralToken (BinaryOperation GetField (Variable "item") (Constant (String "title"))),-> ContentToken "</button>"-> ]),-> ContentToken "</li>"-> ]),-> ContentToken "\n</ul>\n"-> ])--* Yaml Dataset:--> items:-> - url: /-> title: Front page-> - url: http://example.org/-> title: Example site-> - url: https://example.com/example.html-> description: External link-> - url: /about-> title: About--* Render result:--> <ul>-> <li><button link="/">Front page</button></li>-> <li><a href="http://example.org/">Example site</a></li>-> <li><a href="https://example.com/example.html" title="External link">example.com</a></li>-> <li><button link="/about">About</button></li>-> </ul>--}
ert.cabal view
@@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/ name: ert-version: 0.0.1.0+version: 0.0.1.1 synopsis: Easy Runtime Templates description: EJS-like template engine for Haskell. license: GPL-3@@ -10,30 +10,38 @@ author: K. maintainer: kayo@illumium.org -- copyright: +homepage: https://bitbucket.org/kayo/ert category: Text build-type: Simple -- extra-source-files: cabal-version: >=1.10 -Flag dev- Description: Turn on development settings.- Default: False+source-repository head+ type: git+ location: https://bitbucket.org/kayo/ert.git -Flag util- Description: Compiles console utily for testing and rendering templates.- Default: True+flag dev+ description: Turn on development settings.+ default: False -Flag yaml- Description: Compiles console utily with Yaml support.- Default: True+flag util+ description: Compiles console utily for testing and rendering templates.+ default: True -Flag regex- Description: Adds support of regex matching in expressions.- Default: True+flag yaml+ description: Compiles console utily with Yaml support.+ default: True +flag regex+ description: Adds support of regex matching in expressions.+ default: True+ library exposed-modules: Data.EasyTpl- -- other-modules: + hs-source-dirs: library+ other-modules: Data.EasyTpl.Types+ Data.EasyTpl.Parser+ Data.EasyTpl.Render default-extensions: OverloadedStrings CPP -- other-extensions: @@ -66,17 +74,9 @@ CPP build-depends: base , ert- , attoparsec >= 0.10.4.0 && < 0.11- , attoparsec-expr >= 0.1.1.1 && < 0.2 , bytestring >= 0.10.0.2 && < 0.11- , text >= 0.11.3.1 && < 0.12- , vector >= 0.10.0.1 && < 0.11- , unordered-containers >= 0.2.3.0 && < 0.3 , aeson >= 0.6.2.1 && < 0.7-- if flag(regex)- build-depends: regex-compat >= 0.95.1 && < 0.96- cpp-options: -DWITH_REGEX+ , attoparsec >= 0.10.4.0 && < 0.11 if flag(yaml) build-depends: yaml >= 0.8.9.1 && < 0.9
+ library/Data/EasyTpl.hs view
@@ -0,0 +1,538 @@+{-# OPTIONS_HADDOCK -ignore-exports #-}+{-|+Module : Data.EasyTpl+Description : Easy Template compiler and renderer.+Copyright : (c) Kayo, 2014+License : GPL-3+Maintainer : kayo@illumium.org+Stability : experimental+Portability : POSIX++This module implements compiler and renderer for easy runtime templates.+It can be used for advanced code preprocessing or simple substitution of some variables in string.++Since template engine uses /Aeson's/ 'Value' type, you must use types, which have 'ToJSON' instances, for rendering it.+Also you can use 'Object' with variables as fields.++-}++module Data.EasyTpl (+ -- * Usage example+ -- $usageExample+ + -- * Template format+ -- $docFormat++ -- ** Statements+ -- $docStatements++ -- ** Expressions+ -- $docExpressions+ + -- * Template examples+ + -- ** Assets json+ -- $exampleStr+ + -- ** EJS-like template+ -- $exampleEjs+ + -- * Types+ Template+ , TemplateToken+ -- ** Json types+ , Value(..)+ , ByteString+ , HashMap+ , Vector+ -- * Functions+ -- ** Compile and render+ , compile+ , render+ , compile'+ , render'+ -- ** Parsers+ , parseTemplate+ , parseTemplate'+ , parseExpression+ -- ** Utily+ , defaultData+ ) where++import Data.Aeson (Value(..), ToJSON, toJSON)+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BSC+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as H+import Data.Vector (Vector)++import Data.Attoparsec.ByteString.Char8 (parseOnly)++import Data.EasyTpl.Types+import Data.EasyTpl.Parser+import Data.EasyTpl.Render++-- | Default data for render.+-- Empty data for using with standalone render.+defaultData :: Value+defaultData = Object H.empty++-- | Compile template from string.+compile' :: String -> Either String Template+compile' = compile . BSC.pack++-- | Compile template from ByteString.+compile :: ByteString -> Either String Template+compile = parseOnly parseTemplate++-- | Render template to string.+render' :: (ToJSON e) => Template -> e -> String+render' tpl = BSC.unpack . render tpl++-- | Render template to ByteString.+render :: (ToJSON e) => Template -> e -> ByteString+render tpl env = renderTemplate tpl $ toJSON env++-- <% for key, value of iterable %>+-- <% if condition %>+-- <%= literal =%>+-- <% end %>+-- <% end %>++{- $usageExample++> import Data.Aeson+> import Data.EasyTpl (compile, render)+> import Data.ByteString (readFile, writeFile)+>+> data TplVars = TplVars { ... }+>+> instance ToJSON TplVars+> ...+>+> main = do+>+> template <- readFile "template.tpl" >>=+> either error return . compile+>+> let result = render Template $ TplVars { ... }+>+> writeFile "output.txt" result++-}++{- $docFormat++Templates consists of:++ [Control structures] Entities, enclosed by @\<%@ and @%\>@.++ [Substitution expressions] Entities, enclosed by @\<%=@ and @%\>@.++ [Raw content] Anything not controls and literals, interprets as is.++-}++{- $docStatements++Control structures:++ [@/if/@ control]++ @+ \<% if /expression/ %\>+ The content, which will be displayed, if result of /expression/ evaluation is /true/.+ \<% end %\>+ @++ [@/for/@ control]+ + Basic form:++ @+ \<% for /value/ /[,/ /index/ /]/ in /expression/ %\>+ The content, which will be displayed for each entry in result of /expression/ evaluation.+ Variables /value/ and (optional) /index/ contains entry value and number respectively.+ \<% end %\>+ @++ Alternative form:+ + @+ \<% for /field/ /[,/ /value/ /]/ in /expression/ %\>+ The content, which will be displayed for each entry in result of /expression/ evaluation.+ Variables /field/ and (optional) /value/ contains entry key and value respectively.+ \<% end %\>+ @++ The /expression/ must be iteratable, like /Array/ or /Object/.++-}++{- $docExpressions++Expressions is:++ [Constants] Json Values, like /string/, /number/, /object/, /array/, /true/, /false/, /null/++ [Variables] Text entities, identified by name++ [Ranges] Generated arrays of integers++ [Regexps] Regular expressions, enclosed by @\/@ and @\/@ with @i@ and @m@ options.++ [Unary operators] Applied to single expression++ [Binary operators] Applied to twin expressions++/Prefix unary operations/:++ [Get length @#@] Applied to /string/, /object/, /array/. For anything other gives /null/.++ [Stringify @\@@] Converts value to /JSON/ string.++ [Logical not @!@] Inverts boolean value.++ [Numeric negate @-@] Negates numeric value.++ [To number @+@] Forces value to be a numeric.++/Postfix unary operations/:++ [Evaluate @=@] Evaluates string as expression.++ [Not null @?@] Tests value to not be a /null/.++/Generic binary operations/:++ [Equal @==@, Not equal @!=@] Tests values to be an equal.++ [Compare @\<@, @\>@, @\<=@, @\>=@] Compares values.++/Numeric binary operations/:++ [Arithmetic @+@, @-@, @*@, @/@] Simple calculations.++ [Integer division @:@, Extract module @\%@]++/String binary operations/:++ [Concat @+@] Concatenates two strings.++ [Split @:@] Splits string to array of strings by sepatator.++ [Repeat @*@] Repeats string N times.++ [Regex test @~@] Tests string to match regex.++ [Regex match @~\>@] Extract matches from string by appling regex.++ [Regex split @~:@] Split string to array of strings by regex.++/Logical binary operations/:++ [Logical and @&&@]++ [Logical or @||@]++/Container indexing operations/:++ [Get field @.@ /fieldName/] Extracts field, which identified by name.++ [Get index @\[@ /expression/ @\]@] Extracts field by number or evaluated name.++ This operations applyed sequentially to container types, like /string/, /array/, /object/.++/Range expressions/:++ @\[@ \[/from/\] @..@ /to/ \[, /step/\] @\]@++ This expressins generates arrays of numeric values in range /from/ including /to/ by /step/.++ By default /from/ is /0/, and /step/ is /1/.++/Regular expressions/:++ @\/@ /expression/ @\/@ \[/i/\] \[/m/\]++ Posix regular expressions are supported.++ * @i@-modifier forses case-insensitive mode.++ * @m@-modifier forces multiline mode.++-}++{- $exampleStr++* Template:++> {<%+> for res, num in assets+> %>+> "<%=+> res.name+> %>": "<%+> if #root>0+> %><%=+> root+> %>/<%+> end+> %><%=+> prefix[res.type]+> %><%=+> res.name+> %><%+> if suffix[res.type]?+> %><%=+> suffix[res.type]+> %><%+> end+> %>"<%+> if num+1<#assets+> %>,<%+> end+> %><%+> end+> %>+> }++* Compiled template:++> (Template [+> ContentToken "{",+> ControlToken+> (Iteration ("num","res") (Variable "assets"))+> (Template [+> ContentToken "\n \"",+> LiteralToken+> (BinaryOperation GetField+> (Variable "res")+> (Constant (String "name"))),+> ContentToken "\": \"",+> ControlToken+> (Condition+> (BinaryOperation GreatThan+> (UnaryOperation GetLength+> (Variable "root"))+> (Constant (Number 0))))+> (Template [+> LiteralToken+> (Variable "root"),+> ContentToken "/"+> ]),+> LiteralToken+> (BinaryOperation GetField+> (Variable "prefix")+> (BinaryOperation GetField+> (Variable "res")+> (Constant (String "type")))),+> LiteralToken+> (BinaryOperation GetField+> (Variable "res")+> (Constant (String "name"))),+> ControlToken+> (Condition+> (UnaryOperation NotNull+> (BinaryOperation GetField+> (Variable "suffix")+> (BinaryOperation GetField+> (Variable "res")+> (Constant (String "type"))))))+> (Template [+> LiteralToken+> (BinaryOperation GetField+> (Variable "suffix")+> (BinaryOperation GetField+> (Variable "res")+> (Constant (String "type"))))]),+> ContentToken "\"",+> ControlToken+> (Condition+> (BinaryOperation LessThan+> (BinaryOperation Append+> (Variable "num")+> (Constant (Number 1)))+> (UnaryOperation GetLength+> (Variable "assets"))))+> (Template [+> ContentToken ","+> ])+> ]),+> ContentToken "\n}\n"+> ])++* Yaml Dataset:++> prefix:+> script: js/+> style: css/+> image: gfx/+> suffix:+> script: .min.js+> style: .min.css+> assets:+> - type: script+> name: client+> - type: style+> name: styles+> - type: style+> name: bootstrap+> - type: script+> name: react+> - type: image+> name: icons.png+> - type: image+> name: photo.jpg++* Render result:++> {+> "client": "js/client.min.js",+> "styles": "css/styles.min.css",+> "bootstrap": "css/bootstrap.min.css",+> "react": "js/react.min.js",+> "icons.png": "gfx/icons.png",+> "photo.jpg": "gfx/photo.jpg"+> }++-}++{- $exampleEjs++* Template:++> <ul><%+> for item in items %>+> <li><%+> if item.url ~ /^http/+> %><a href="<%= item.url %>"<%+> if item.description?+> %> title="<%= item.description %>"<%+> end+> %>><%+> if item.title?+> %><%= item.title %><%+> end+> %><%+> if !(item.title?)+> %><%= (item.url ~> /[^\:]*\:\/\/([^\/]+)/)[0] %><%+> end+> %></a><%+> end+> %><%+> if !(item.url ~ /^http/)+> %><button link="<%= item.url %>"><%= item.title %></button><%+> end+> %></li><%+> end %>+> </ul>++* Compiled template:++> (Template [+> ContentToken "<ul>",+> ControlToken+> (Iteration ("","item") (Variable "items"))+> (Template [+> ContentToken "\n <li>",+> ControlToken+> (Condition+> (BinaryOperation RegexTest+> (BinaryOperation GetField+> (Variable "item")+> (Constant (String "url")))+> (Regexp "^http" True False)))+> (Template [+> ContentToken "<a href=\"",+> LiteralToken+> (BinaryOperation GetField+> (Variable "item")+> (Constant (String "url"))),+> ContentToken "\"",+> ControlToken+> (Condition+> (UnaryOperation NotNull+> (BinaryOperation GetField+> (Variable "item")+> (Constant (String "description")))))+> (Template [+> ContentToken " title=\"",+> LiteralToken+> (BinaryOperation GetField+> (Variable "item")+> (Constant (String "description"))),+> ContentToken "\""+> ]),+> ContentToken ">",+> ControlToken+> (Condition+> (UnaryOperation NotNull+> (BinaryOperation GetField+> (Variable "item")+> (Constant (String "title")))))+> (Template [+> LiteralToken+> (BinaryOperation GetField+> (Variable "item")+> (Constant (String "title")))+> ]),+> ControlToken+> (Condition+> (UnaryOperation LogicNot+> (UnaryOperation NotNull+> (BinaryOperation GetField+> (Variable "item")+> (Constant (String "title"))))))+> (Template [+> LiteralToken+> (BinaryOperation GetField+> (BinaryOperation RegexMatch+> (BinaryOperation GetField+> (Variable "item")+> (Constant (String "url")))+> (Regexp "[^\\:]*\\://([^/]+)" True False))+> (Constant (Number 0)))+> ]),+> ContentToken "</a>"+> ]),+> ControlToken+> (Condition+> (UnaryOperation LogicNot+> (BinaryOperation RegexTest+> (BinaryOperation GetField+> (Variable "item")+> (Constant (String "url")))+> (Regexp "^http" True False))))+> (Template [+> ContentToken "<button link=\"",LiteralToken (BinaryOperation GetField (Variable "item") (Constant (String "url"))),+> ContentToken "\">",+> LiteralToken (BinaryOperation GetField (Variable "item") (Constant (String "title"))),+> ContentToken "</button>"+> ]),+> ContentToken "</li>"+> ]),+> ContentToken "\n</ul>\n"+> ])++* Yaml Dataset:++> items:+> - url: /+> title: Front page+> - url: http://example.org/+> title: Example site+> - url: https://example.com/example.html+> description: External link+> - url: /about+> title: About++* Render result:++> <ul>+> <li><button link="/">Front page</button></li>+> <li><a href="http://example.org/">Example site</a></li>+> <li><a href="https://example.com/example.html" title="External link">example.com</a></li>+> <li><button link="/about">About</button></li>+> </ul>+-}
+ library/Data/EasyTpl/Parser.hs view
@@ -0,0 +1,239 @@+module Data.EasyTpl.Parser where++import Data.Aeson (Value(..))+import Data.Aeson.Parser (value')+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC+import Data.Text (Text)+import qualified Data.Text as T++import Data.Attoparsec.ByteString.Char8+import Data.Attoparsec.Expr++import Data.Tuple (swap)++import Control.Applicative ((<$>), (<*>), (<*), (*>), (<|>))++import Data.EasyTpl.Types++-- | Template parser function.+-- Use this for parsing templates.+parseTemplate :: Parser Template+parseTemplate = Template <$> parseTokens+ where+ parseTokens = do+ end <- atEnd+ case end of+ True -> return []+ _ -> (:) <$> parseToken <*> parseTokens++-- | Less template parser.+-- Used internally for parsing subtemplates.+parseTemplate' :: Parser Template+parseTemplate' = Template <$> many' parseToken++-- | Template token parser.+parseToken :: Parser TemplateToken+parseToken = parseControl <|> parseLiteral <|> parseContent++-- | Control token parser.+parseControl :: Parser TemplateToken+parseControl = ControlToken <$> blockOpen <*> parseTemplate' <* blockClose+ where+ blockOpen = "<%" *> spaces *> parseAction <* spaces <* "%>"+ blockClose = "<%" >> spaces >> "end" >> spaces >> "%>"+ + parseAction = parseCondition <|> parseIteration++-- | Literal token parser.+parseLiteral :: Parser TemplateToken+parseLiteral = LiteralToken <$> ("<%=" *> parseExpression <* "%>") <?> "Invalid literal"++-- | Content token parser.+parseContent :: Parser TemplateToken+parseContent = many1' getChunk >>= return . ContentToken . BS.concat+ where+ getChunk :: Parser ByteString+ getChunk = (takeWhile1 (/= '<')) <|>+ ((cat2 <$> char '<' <*> notChar '%') <|>+ (cat2 <$> char '<' <* char '\\' <*> char '%') >>=+ return . BSC.pack)++ cat2 a b = a:[b]++-- | Condition control parser.+-- `if ` expression => Condition expression+parseCondition :: Parser Control+parseCondition = Condition <$> ("if" *> spaces1 *> parseExpression)++-- | Iteration control parser.+-- `for ` ( value [`,` index] ` in` | field [`,` value] ` of` )+parseIteration :: Parser Control+parseIteration = Iteration <$> ("for" *> spaces1 *> (valueIndex <|> fieldValue))+ <*> (spaces1 *> parseExpression)+ where+ valueIndex = swap <$> pair <* spaces1 <* "in"+ fieldValue = pair <* spaces1 <* "of"+ + pair = (,) <$> option "" parseIdentifier+ <*> option "" (spaces *> char ',' *> spaces *> parseIdentifier)++-- | Expression parser.+-- Use this for parsing expressions.+parseExpression :: Parser Expression+parseExpression = spaces *> buildExpressionParser operatorTable parsePrimary <* spaces+ where+ operatorTable :: OperatorTable ByteString Expression+ operatorTable = [ {-[ field '.' parseFieldName GetField+ , block '[' ']' parseExpression GetField+ ]+ , -}+ [ unary '?' True NotNull+ ]+ , [ unary '#' False GetLength+ , unary '!' False LogicNot+ , unary '-' False Negate+ , unary '+' False ToNumber+ ]+ , [ binary '^' AssocRight Power+ ]+ , [ binary '*' AssocLeft Multiply + , binary '/' AssocLeft Divide+ , binary ':' AssocLeft IntDivide+ , binary '%' AssocLeft Module+ ]+ , [ binary '-' AssocLeft Substract+ , binary '+' AssocLeft Append+ ]+ , [ binary' "~>" AssocNone RegexMatch -- !important: before ~+ , binary' "~:" AssocNone RegexSplit -- !important: before ~+ , binary '~' AssocNone RegexTest+ ]+ , [ binary' "==" AssocLeft Equal+ , binary' "!=" AssocLeft NotEqual+ , binary' "<=" AssocLeft LessEqual -- !important: before <+ , binary' ">=" AssocLeft GreatEqual -- !important: before >+ , binary '<' AssocLeft LessThan+ , binary '>' AssocLeft GreatThan+ ]+ , [ binary' "||" AssocLeft LogicOr+ , binary' "&&" AssocLeft LogicAnd+ ]+ , [ unary '=' True Evaluate+ ]+ , [ unary '@' False Stringify+ ]+ ]+ {-+ parseFieldName :: Parser Expression+ parseFieldName = (Constant . String) <$> parseIdentifier++ field :: Char -> Parser Expression -> BinaryOperator -> Operator ByteString Expression+ field op ex tp = Postfix (spaces *> char op *> spaces *> ex <* spaces >>=+ return . flip (BinaryOperation tp))++ block :: Char -> Char -> Parser Expression -> BinaryOperator -> Operator ByteString Expression+ block op cl ex tp = Postfix (spaces *> char op *> ex <* char cl <* spaces >>=+ return . flip (BinaryOperation tp))+ -}+ unary :: Char -> Bool -> UnaryOperator -> Operator ByteString Expression+ unary op po tp = (if po then Postfix else Prefix)+ (spaces >> char op >> spaces >>+ return (UnaryOperation tp))+ + binary :: Char -> Assoc -> BinaryOperator -> Operator ByteString Expression+ binary op ac tp = Infix (spaces >> char op >> spaces >>+ return (BinaryOperation tp)) ac++ binary' :: Parser ByteString -> Assoc -> BinaryOperator -> Operator ByteString Expression+ binary' op ac tp = Infix (spaces >> op >> spaces >>+ return (BinaryOperation tp)) ac++-- | Primary expression parser.+-- A sequence of .field/[index] operations can be applied to primary expressions (excluding regular expressions).+parsePrimary :: Parser Expression+parsePrimary = ((parseParens+ <|> parseVariable+ <|> parseRange+ <|> parseConstant) >>= parseFields)+#ifdef WITH_REGEX+ <|> parseRegex+#endif++-- | Parens primary expression.+-- `(` expression `)` => expression+parseParens :: Parser Expression+parseParens = char '(' *> parseExpression <* char ')'++-- | Variable primary expression.+-- identifier => Variable identifier+parseVariable :: Parser Expression+parseVariable = Variable <$> parseIdentifier++-- | Sequence of field/index operations+-- `.` key@identifier | `[` key@expression `]` => BinaryOperation GetField topexpr key+parseFields :: Expression -> Parser Expression+parseFields prev = option prev ((parseField <|> parseIndex) >>= parseFields . BinaryOperation GetField prev)+ where+ parseField :: Parser Expression+ parseField = spaces *> char '.' *> parseIdentifier <* spaces >>= return . Constant . String+ + parseIndex :: Parser Expression+ parseIndex = spaces *> char '[' *> parseExpression <* char ']' <* spaces++-- | Range expression (array generator).+-- `[` [from] `..` to [`,` step] `]` => Range from to step+parseRange :: Parser Expression+parseRange = char '[' *> (Range <$> option defaultFrom parseExpression <* ".." <*>+ parseExpression <*> option defaultStep (char ',' *> parseExpression)) <* char ']'+ where+ defaultFrom = Constant $ Number 0+ defaultStep = Constant $ Number 1++#ifdef WITH_REGEX+-- | Regular expression (posix regex).+-- `/` regex `/` [caseInsensitive@`i`] [multiLine@`m`] => Regexp regex !caseInsensitive multiLine+parseRegex :: Parser Expression+parseRegex = Regexp <$> (char '/' *> regexpBody <* char '/') <*> caseSensitive <*> multiLine+ where+ regexpBody :: Parser ByteString+ regexpBody = many1' getChunk >>= return . BS.concat+ + getChunk :: Parser ByteString+ getChunk = (takeWhile1 (\c -> c /= '/' && c /= '\\')) <|>+ (char '\\' >> char '/' >> return "/") <|>+ (char '\\' >> return "\\")++ caseSensitive :: Parser Bool+ caseSensitive = option True $ char 'i' >> return False++ multiLine :: Parser Bool+ multiLine = option False $ char 'm' >> return True+#endif++-- | Constant expression (environment independent).+-- It's just a JSON value parsed by AESON.+parseConstant :: Parser Expression+parseConstant = Constant <$> value'++-- | Identifier+-- Identifiers starts from `a-zA-Z` (alphabetic character), `_` (underscore) or `$` (dollar) and consists of `a-zA-Z0-9`, `_` or `$`.+parseIdentifier :: Parser Text+parseIdentifier = do+ first <- firstChar+ rest <- many' otherChar+ return $ T.pack $ first : rest+ where+ firstChar = satisfy isAlpha_ascii <|> satisfy (inClass "_$")+ otherChar = firstChar <|> satisfy isDigit++-- | Skip zero or more spaces+-- `space`*+spaces :: Parser ()+spaces = skipWhile isSpace++-- | Skip one or more spaces+-- `space`++spaces1 :: Parser ()+spaces1 = skipSpace >> spaces
+ library/Data/EasyTpl/Render.hs view
@@ -0,0 +1,250 @@+module Data.EasyTpl.Render where++import Data.Aeson (Value(..))+import qualified Data.Aeson.Encode as JE+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Lazy as LT+import qualified Data.Text.Lazy.Builder as LTB+import qualified Data.Text.Encoding as TE+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as H+import qualified Data.Vector as V++import Data.Attoparsec.ByteString.Char8+import qualified Data.Attoparsec.Text as AT++#ifdef WITH_REGEX+import Text.Regex (Regex)+import qualified Text.Regex as RE+#endif++import Data.Fixed (mod')+import Prelude hiding (takeWhile)++import Data.EasyTpl.Types+import Data.EasyTpl.Parser++-- | Internal render template using hash with variables.+renderTemplate' :: Template -> HashMap Text Value -> ByteString+renderTemplate' tpl env = renderTemplate tpl $ Object env++-- | Internal render template using value as variables.+renderTemplate :: Template -> Value -> ByteString+renderTemplate (Template tokens) env = BS.concat $ map (flip renderToken env) tokens++-- | Internal render token.+renderToken :: TemplateToken -> Value -> ByteString++renderToken (ContentToken text) _ = text++renderToken (LiteralToken expr) env = getString $ toString $ evalExpression expr env+ where+ getString (String text) = TE.encodeUtf8 text+ getString _ = ""++renderToken (ControlToken ctl tpl) env = renderControl ctl tpl env++renderControl :: Control -> Template -> Value -> ByteString++renderControl (Condition expr) tpl env@(Object _) = applyCondition $ toBoolean $ evalExpression expr env+ where+ applyCondition :: Value -> ByteString+ applyCondition (Bool True) = renderTemplate tpl env+ applyCondition _ = ""++renderControl (Iteration (keyVar, valVar) expr) tpl env'@(Object henv) = BS.concat $ applyIteration $ evalExpression expr env'+ where+ applyIteration :: Value -> [ByteString]+ applyIteration (Array list) = V.toList $ V.imap applyIndex list+ applyIteration (Object hash) = map applyField $ H.toList hash+ applyIteration _ = []++ addLocal :: Text -> Value -> HashMap Text Value -> HashMap Text Value+ addLocal var val env = if T.null var then env else H.insert var val env++ applyElement :: Value -> Value -> ByteString+ applyElement key val = renderTemplate' tpl $ addLocal keyVar key $ addLocal valVar val henv+ + applyIndex :: Int -> Value -> ByteString+ applyIndex key val = applyElement (Number (fromIntegral key)) val+ + applyField :: (Text, Value) -> ByteString+ applyField (key, val) = applyElement (String key) val++renderControl _ _ _ = ""++-- | Internal evaluate expression.+evalExpression :: Expression -> Value -> Value++evalExpression (Constant val) _ = val++evalExpression (Variable var) (Object henv) = maybe Null id $ H.lookup var henv+evalExpression (Variable _) _ = Null++evalExpression (Range from' to' step') env = genRange (toNumber $ evalExpression from' env)+ (toNumber $ evalExpression to' env)+ (toNumber $ evalExpression step' env)+ where+ genRange :: Value -> Value -> Value -> Value+ genRange (Number from) (Number to) (Number step) =+ Array $ V.fromList $ range from to step+ genRange _ _ _ = Null+ + range from to step | from > to = []+ | otherwise = Number from : range (from + step) to step++evalExpression (UnaryOperation op' a') env = unary op' (evalExpression a' env)+ where+ unary :: UnaryOperator -> Value -> Value+ + unary GetLength = getLength+ unary Stringify = stringify+ unary Evaluate = either (String . T.pack . ("Error: " ++)) (flip evalExpression env) . parseOnly parseExpression . toByteString+ unary LogicNot = booleanOp not+ unary Negate = numericOp (0 -)+ unary ToNumber = numericOp id+ unary NotNull = Bool . notNull++ notNull :: Value -> Bool+ notNull Null = False+ notNull _ = True++ booleanOp :: (Bool -> Bool) -> Value -> Value+ booleanOp op a = case toBoolean a of+ Bool b -> Bool $ op b+ _ -> Null+ + numericOp op a = case toNumber a of+ Number n -> Number $ op n+ _ -> Null++ toByteString a = case toString a of+ String s -> TE.encodeUtf8 s+ _ -> ""+ +#ifdef WITH_REGEX+evalExpression (BinaryOperation op' a' (Regexp re ml cs)) env = apply op' $ toString $ evalExpression a' env+ where+ apply RegexTest (String s) = Bool $ maybe False (\_ -> True) $ match s+ apply RegexMatch (String s) = maybe Null (Array . V.fromList . map (String . T.pack)) $ match s+ apply RegexSplit (String s) = Array $ V.fromList $ map String $ split s+ apply _ _ = Null+ + match :: Text -> Maybe [String]+ match = RE.matchRegex regex . T.unpack++ split :: Text -> [Text]+ split = map T.pack . RE.splitRegex regex . T.unpack+ + regex :: Regex+ regex = RE.mkRegexWithOpts (BSC.unpack re) ml cs++-- regexps is non-evaluatable+evalExpression (Regexp _ _ _) _ = Null+#endif++evalExpression (BinaryOperation op' a' b') env = binary op' (evalExpression a' env) (evalExpression b' env)+ where+ binary :: BinaryOperator -> Value -> Value -> Value+ + binary Equal a = Bool . (a ==)+ binary NotEqual a = Bool . (a /=)+ + binary Append (String a) = applyToString $ String . T.append a+ binary Multiply (String a) = applyToInteger $ String . flip T.replicate a+ binary IntDivide (String a) = applyToString $ Array . V.fromList . map String . flip T.splitOn a+ binary LessThan (String a) = applyToString $ Bool . (a <)+ binary GreatThan (String a) = applyToString $ Bool . (a >)+ binary LessEqual (String a) = applyToString $ Bool . (a <=)+ binary GreatEqual (String a) = applyToString $ Bool . (a >=)+ + binary GetField (String s) = applyToInteger (\i -> if i >= 0 && i < T.length s then String $ T.singleton $ T.index s i else Null)+ + binary LessThan (Number a) = applyToNumber $ Bool . (a <)+ binary GreatThan (Number a) = applyToNumber $ Bool . (a >)+ binary LessEqual (Number a) = applyToNumber $ Bool . (a <=)+ binary GreatEqual (Number a) = applyToNumber $ Bool . (a >=)+ + binary GetField (Array a) = applyToInteger (maybe Null id . (V.!?) a)+ binary GetField (Object a) = applyToString (maybe Null id . flip H.lookup a)+ + binary op a = binary' op a+ + binary' LogicOr = booleanOp (||)+ binary' LogicAnd = booleanOp (&&)+ + binary' Substract = numericOp (-)+ binary' Append = numericOp (+)+ binary' Multiply = numericOp (*)+ binary' Divide = numericOp (/)+ binary' IntDivide = numericOp' (/)+ binary' Module = numericOp mod'+ --binary' Power = numericOp pow+ binary' _ = \_ _ -> Null+ + numericOp op a b = case (toNumber a, toNumber b) of+ (Number na, Number nb) -> Number $ op na nb+ _ -> Null++ numericOp' op a b = case (toNumber a, toNumber b) of+ (Number na, Number nb) -> Number $ fromIntegral ((round $ op na nb) :: Integer)+ _ -> Null+ + booleanOp op a b = case (toBoolean a, toBoolean b) of+ (Bool ba, Bool bb) -> Bool $ op ba bb+ _ -> Null+ + applyToString fn v = case toString v of+ String s -> fn s+ _ -> Null++ applyToNumber fn v = case toNumber v of+ Number n -> fn $ n+ _ -> Null+ + applyToInteger fn = applyToNumber (fn . round)++-- | Generic get length.+getLength :: Value -> Value+getLength (String text) = Number $ fromIntegral $ T.length text+getLength (Array list) = Number $ fromIntegral $ V.length list+getLength (Object hash) = Number $ fromIntegral $ H.size hash+getLength _ = Null++-- | Cast value to boolean.+toBoolean :: Value -> Value+toBoolean bool@(Bool _) = bool+toBoolean (Number val) = Bool $ val /= I 0+toBoolean (String text) = Bool $ not $ T.null text+toBoolean Null = Bool False+toBoolean (Object hash) = Bool $ not $ H.null hash+toBoolean (Array list) = Bool $ not $ V.null list++-- | Cast any value to number.+-- Returns null if non-castable.+toNumber :: Value -> Value+toNumber val@(Number _) = val+toNumber (Bool bool) = Number $ if bool then 1 else 0+toNumber (String text) = getNumber' $ AT.parse AT.number text+ where+ getNumber' (AT.Done _ val) = Number val+ getNumber' _ = Null+toNumber _ = Null++-- | Cast any value to string.+toString :: Value -> Value+toString text@(String _) = text+toString (Number val) = String $ T.pack $ show val+toString Null = String "[null]"+toString (Bool _) = String "[bool]"+toString (Object _) = String "[object]"+toString (Array _) = String "[array]"++-- | Stringify value to JSON.+-- Stringify any value using JSON format by AESON encode.+stringify :: Value -> Value+stringify = String . LT.toStrict . LTB.toLazyText . JE.fromValue
+ library/Data/EasyTpl/Types.hs view
@@ -0,0 +1,65 @@+module Data.EasyTpl.Types where++import Data.ByteString (ByteString)+import Data.Text (Text)+import Data.Aeson (Value)++-- | Compiled template.+newtype Template = Template [TemplateToken] -- ^ Template consists of tokens+ deriving (Show, Eq)++-- | Template token.+data TemplateToken = ContentToken ByteString -- ^ Chunk or raw content as is+ | LiteralToken Expression -- ^ Computable expression for substitution+ | ControlToken Control Template -- ^ Control block structure with sub-template+ deriving (Show, Eq)++-- | Control structure.+data Control = Condition Expression -- ^ Conditional statement with expression+ | Iteration (Text, Text) Expression -- ^ Iterational statement with variables and expression+ deriving (Show, Eq)++-- | Expression.+data Expression = Constant Value --+ | Variable Text+ | Range Expression Expression Expression+#ifdef WITH_REGEX+ | Regexp ByteString Bool Bool+#endif+ | UnaryOperation UnaryOperator Expression+ | BinaryOperation BinaryOperator Expression Expression+ deriving (Show, Eq)++-- | Unary operator+data UnaryOperator = GetLength -- ^ Length operator `#` (#value)+ | Stringify -- ^ Stringify operator `\@` (\@value)+ | Evaluate -- ^ Evaluate operator `=` (value=)+ | LogicNot -- ^ Logical not operator `!` (!value)+ | Negate -- ^ Numeric negate operator `-` (-value)+ | ToNumber -- ^ Numeric cast operator `+` (+value)+ | NotNull -- ^ Not null test operator `?` (value?)+ deriving (Show, Eq)++-- | Binary operator+data BinaryOperator = LogicOr -- ^ Logical or operator `||`+ | LogicAnd -- ^ Logical and operator `&&`+ | Equal -- ^ Generic equality operator `==`+ | NotEqual -- ^ Generic non-equality operator `!=`+ | LessThan -- ^ Lesser than operator `<`+ | GreatThan -- ^ Greater than operator `>`+ | LessEqual -- ^ Lesser or equal operator `<=`+ | GreatEqual -- ^ Greater or equal operator `>=`+ | Substract -- ^ Numeric substract operator `-`+ | Append -- ^ Generic append operator `+`+ | Multiply -- ^ Generic multiply operator `*`+ | Divide -- ^ Generic divide operator `/`+ | IntDivide -- ^ Generic integral divide operator `:`+ | Module -- ^ Numeric module operator `%`+ | Power -- ^ Numeric power operator `^`+ | GetField -- ^ Container get field operator `.` | `[` `]` (object.field, object[field_name], array[index])+#ifdef WITH_REGEX+ | RegexTest -- ^ Regular expression test operator `~` (string ~ /regex/ => bool)+ | RegexMatch -- ^ Regular expression match operator `~>` (string ~> /regex/ => null | [matches])+ | RegexSplit -- ^ Regular expression split operator `~:` (string ~: /regex/ => [pieces])+#endif+ deriving (Show, Eq)