diff --git a/Data/EasyTpl.hs b/Data/EasyTpl.hs deleted file mode 100644 --- a/Data/EasyTpl.hs +++ /dev/null @@ -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: - -> - -* Compiled template: - -> (Template [ -> ContentToken "\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: - -> --} diff --git a/ert.cabal b/ert.cabal --- a/ert.cabal +++ b/ert.cabal @@ -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 diff --git a/library/Data/EasyTpl.hs b/library/Data/EasyTpl.hs new file mode 100644 --- /dev/null +++ b/library/Data/EasyTpl.hs @@ -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: + +> + +* Compiled template: + +> (Template [ +> ContentToken "\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: + +> +-} diff --git a/library/Data/EasyTpl/Parser.hs b/library/Data/EasyTpl/Parser.hs new file mode 100644 --- /dev/null +++ b/library/Data/EasyTpl/Parser.hs @@ -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 diff --git a/library/Data/EasyTpl/Render.hs b/library/Data/EasyTpl/Render.hs new file mode 100644 --- /dev/null +++ b/library/Data/EasyTpl/Render.hs @@ -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 diff --git a/library/Data/EasyTpl/Types.hs b/library/Data/EasyTpl/Types.hs new file mode 100644 --- /dev/null +++ b/library/Data/EasyTpl/Types.hs @@ -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)