liquid (empty) → 0.1.0.1
raw patch · 12 files changed
+1560/−0 lines, 12 filesdep +QuickCheckdep +aesondep +attoparsecsetup-changed
Dependencies added: QuickCheck, aeson, attoparsec, base, criterion, lens, lens-aeson, liquid, mtl, scientific, semigroups, tasty, tasty-hunit, tasty-quickcheck, tasty-th, text, unordered-containers, validation, vector
Files
- LICENSE +29/−0
- Setup.hs +2/−0
- benchmark/Benchmark.hs +43/−0
- liquid.cabal +98/−0
- src/Text/Liquid.hs +18/−0
- src/Text/Liquid/Helpers.hs +125/−0
- src/Text/Liquid/Parser.hs +355/−0
- src/Text/Liquid/Renderer.hs +416/−0
- src/Text/Liquid/Tokens.hs +225/−0
- src/Text/Liquid/Types.hs +72/−0
- src/Text/Liquid/VariableFinder.hs +161/−0
- test/Main.hs +16/−0
+ LICENSE view
@@ -0,0 +1,29 @@+Copyright (c) 2015-2016, Orphid, Inc.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++1. Redistributions of source code must retain the above copyright+notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+notice, this list of conditions and the following disclaimer in the+documentation and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its+contributors may be used to endorse or promote products derived from+this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ benchmark/Benchmark.hs view
@@ -0,0 +1,43 @@+import Criterion.Main+import Data.Aeson hiding (Result)+import Data.Attoparsec.Text+import Data.Text (Text)+import Text.Liquid.Parser+import Text.Liquid.Renderer+import Text.Liquid.Types+import Text.Liquid.VariableFinder++template :: Text+template = "some text prior {{ a.nested[2] | replace:\'foo\',\'bar\' | toUpper }}somesquishedtext{% if user == \'barry\' %} then this text {% else %} yo yo {% endif %}the end!{% case user %}{% when \'notbarry\' %} no barrys {% when \'barry\' %} t'is barry!{% else %} any old nonsense{% endcase %}"++jsonCtx :: Value+jsonCtx = object ["a" .= nested, "user" .= ("barry" :: Text)]+ where nested = object ["nested" .= ([ "a", "b", "foobar" ] :: [Text])]++parsedTemplate :: Maybe [Expr]+parsedTemplate = maybeResult $ parseTemplate template++{-# INLINE benchParseTemplate #-}+benchParseTemplate :: Text -> Maybe [Expr]+benchParseTemplate t = maybeResult $ parseTemplate t++{-# INLINE benchRenderTemplate #-}+benchRenderTemplate :: (Value, Maybe [Expr]) -> Maybe [Rendering Text]+benchRenderTemplate (v, ts) = fmap (renderTemplate v) <$> ts++{-#INLINE benchInterpret #-}+benchInterpret :: (Value, Text) -> Rendering Text+benchInterpret (j, t) = interpretWithJson j t++{-#INLINE benchFindVariables #-}+benchFindVariables :: Maybe [Expr] -> Maybe [(JsonVarPath, VType)]+benchFindVariables xs = findAllVariables <$> xs++main :: IO ()+main = defaultMain [+ bgroup "Text.Liquid" [ bench "parse-whnf" $ whnf benchParseTemplate template+ , bench "renderTemplate" $ whnf benchRenderTemplate (jsonCtx, parsedTemplate)+ , bench "interpret" $ whnf benchInterpret (jsonCtx, template)+ , bench "findAllVariables" $ whnf benchFindVariables parsedTemplate+ ]]+
+ liquid.cabal view
@@ -0,0 +1,98 @@+name: liquid+version: 0.1.0.1+synopsis: Liquid template language library+description: Parser, interpreter and assorted functions for the Liquid template language+license: BSD3+license-file: LICENSE+copyright: Copyright (C) 2015-2016 Orphid, Inc.+author: James R. Thompson <james@projector.com>+maintainer: James R. Thompson <jamesthompsonoxford@gmail.com>+homepage: https://github.com/projectorhq/haskell-liquid+build-type: Simple+category: Template+cabal-version: >= 1.10+stability: Experimental+description:+ This package should be used by importing Text.Liquid.+ Sundry nested packages can be used freely for other functionality. See the readme on Github for more details on usage.++library+ default-language: Haskell2010++ ghc-options: -Wall -O2++ hs-source-dirs: src++ exposed-modules: Text.Liquid+ Text.Liquid.Helpers+ Text.Liquid.Parser+ Text.Liquid.Renderer+ Text.Liquid.Tokens+ Text.Liquid.Types+ Text.Liquid.VariableFinder++ default-extensions: OverloadedStrings++ build-depends: attoparsec >=0.13.0.1 && <0.14,+ aeson >=0.11.2.0 && <0.12,+ base >=4.8 && <5,+ lens >=4.13 && <5,+ lens-aeson >=1.0.0.5 && <1.1,+ mtl >=2.2.1 && <2.3,+ semigroups >=0.18.0.1 && <0.19,+ scientific >=0.3.4.2 && <0.4,+ text >=1.2.1.3 && <1.3,+ unordered-containers >=0.2.5.1 && <0.3,+ validation >=0.5.2 && <0.6,+ vector >=0.10.12.3 && <0.12++test-suite test++ default-language: Haskell2010++ type: exitcode-stdio-1.0++ hs-source-dirs: test++ main-is: Main.hs++ default-extensions: OverloadedStrings++ build-depends: aeson >=0.11.2.0 && <0.12,+ attoparsec >=0.13.0.1 && <0.14,+ base >=4.8 && <4.9,+ lens >=4.13 && <5,+ lens-aeson >=1.0.0.5 && <1.1,+ liquid,+ mtl >=2.2.1 && <2.3,+ QuickCheck >=2.8.1 && <2.9,+ scientific >=0.3.4.2 && <0.4,+ semigroups >=0.18.0.1 && <0.19,+ tasty >=0.10 && <0.12,+ tasty-hunit >=0.9.2 && <0.10,+ tasty-th >=0.1.3 && <0.2,+ tasty-quickcheck >=0.8.3.2 && <0.9,+ text >=1.2.1.3 && <1.3,+ unordered-containers >=0.2.5.1 && <0.3,+ validation >=0.5.2 && <0.6,+ vector >=0.10.12.3 && <0.12++benchmark bench+ default-language: Haskell2010++ type: exitcode-stdio-1.0++ hs-source-dirs: benchmark++ main-is: Benchmark.hs++ default-extensions: OverloadedStrings++ ghc-options: -O2++ build-depends: attoparsec >=0.13.0.1 && <0.14,+ aeson >=0.11.2.0 && <0.12,+ base >=4.8 && <4.9,+ criterion >=1.1.0 && <1.2,+ liquid,+ text >=1.2.1.3 && <1.3
+ src/Text/Liquid.hs view
@@ -0,0 +1,18 @@+module Text.Liquid (+ Expr(..)+ , JsonVarPath+ , LiquidError(..)+ , Rendering+ , VarIndex(..)+ , interpret+ , interpretWithJson+ , parseTemplate+ , renderTemplate+ , templateP+ , templateParser+ ) where++import Text.Liquid.Parser (parseTemplate, templateP, templateParser)+import Text.Liquid.Renderer (interpret, interpretWithJson, renderTemplate)+import Text.Liquid.Types (Expr(..), VarIndex(..), JsonVarPath, Rendering, LiquidError(..))+
+ src/Text/Liquid/Helpers.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE RankNTypes #-}++module Text.Liquid.Helpers (+ foldM'+ , formatNum+ , buildLens+ , renderPath+ , renderExpr+ )where++import Data.Aeson.Lens (key, nth)+import Data.Aeson.Types (Value)+import Data.List (intersperse)+import Data.Monoid+import Data.Scientific+import Data.Text (Text)+import qualified Data.Text as T+import Text.Liquid.Types++-- | Strict monadic foldl+foldM' :: Monad m+ => (a -> b -> m a)+ -> a+ -> [b]+ -> m a+foldM' _ z [] = return z+foldM' f z (x:xs) = do+ z' <- f z x+ z' `seq` foldM' f z' xs++-- | Format a number+formatNum :: Scientific+ -> Text+formatNum s | isInteger s =+ maybe T.empty (T.pack . show) (toBoundedInteger s :: Maybe Int)+ | otherwise =+ T.pack $ formatScientific Fixed Nothing s++-- | Compose a traversal into a JSON Value+buildLens :: forall (f :: * -> *) . Applicative f+ => JsonVarPath+ -> ((Value -> f Value) -> Value -> f Value)+buildLens xs = foldl1 (.) (matchKey <$> xs)+ where matchKey (ObjectIndex i) = key i+ matchKey (ArrayIndex i) = nth i++renderPath :: JsonVarPath+ -> Text+renderPath path = foldl conc T.empty path+ where conc :: Text -> VarIndex -> Text+ conc l (ObjectIndex r) | T.null l = r+ | otherwise = l <> "." <> r+ conc l (ArrayIndex r) | T.null l = "[" <> (T.pack $ show r) <> "]"+ | otherwise = l <> "[" <> (T.pack $ show r) <> "]"++renderExpr :: Expr+ -> Text+renderExpr Noop = mempty+renderExpr (RawText t) = t+renderExpr (Num s) = formatNum s+renderExpr (Variable jp) = renderPath jp+renderExpr (QuoteString t) = "\'" <> t <> "\'"+renderExpr (Equal l r) = (renderExpr l) <> " == " <> (renderExpr r)+renderExpr (NotEqual l r) = (renderExpr l) <> " != " <> (renderExpr r)+renderExpr (GtEqual l r) = (renderExpr l) <> " >= " <> (renderExpr r)+renderExpr (LtEqual l r) = (renderExpr l) <> " <= " <> (renderExpr r)+renderExpr (Gt l r) = (renderExpr l) <> " > " <> (renderExpr r)+renderExpr (Lt l r) = (renderExpr l) <> " < " <> (renderExpr r)+renderExpr (Or l r) = (renderExpr l) <> " or " <> (renderExpr r)+renderExpr (And l r) = (renderExpr l) <> " and " <> (renderExpr r)+renderExpr (Contains l r) = (renderExpr l) <> " contains " <> (renderExpr r)+renderExpr Trueth = "true"+renderExpr Falseth = "false"+renderExpr Nil = "nil"+renderExpr Null = "null"+renderExpr (Truthy x) = renderExpr x+renderExpr (IfClause x) = "{% if " <> renderExpr x <> " %}"+renderExpr (IfKeyClause x) = "{% ifkey " <> renderExpr x <> " %}"+renderExpr (ElsIfClause x) = "{% elsif " <> renderExpr x <> " %}"+renderExpr Else = "{% else %}"+renderExpr (FilterCell n []) = n+renderExpr (FilterCell n opts) = n <> ": " <> (mconcat $ intersperse ", " $ renderExpr <$> opts)+renderExpr (Filter t fs) = renderExpr t <> bar <> (mconcat $ intersperse bar $ renderExpr <$> fs)+ where bar = " | "+renderExpr (Output x) = "{{ " <> renderExpr x <> " }}"+renderExpr (TrueStatements xs) = mconcat $ renderExpr <$> xs+renderExpr (IfLogic i+ ts@(TrueStatements _)) =+ renderExpr i <>+ renderExpr ts <>+ "{% endif %}"+renderExpr (IfLogic (IfLogic i ts1@(TrueStatements _))+ (IfLogic Else ts2@(TrueStatements _))) =+ renderExpr i <>+ renderExpr ts1 <>+ renderExpr Else <>+ renderExpr ts2 <>+ "{% endif %}"+renderExpr (IfLogic (IfLogic i ts1@(TrueStatements _))+ (IfLogic ei@(ElsIfClause _) ts2@(TrueStatements _))) =+ renderExpr i <>+ renderExpr ts1 <>+ renderExpr ei <>+ renderExpr ts2 <>+ "{% endif %}"+renderExpr (IfLogic (IfLogic i ts1@(TrueStatements _))+ (IfLogic (IfLogic ei@(ElsIfClause _) ts2@(TrueStatements _))+ (IfLogic Else ts3@(TrueStatements _)))) =+ renderExpr i <>+ renderExpr ts1 <>+ renderExpr ei <>+ renderExpr ts2 <>+ renderExpr Else <>+ renderExpr ts3 <>+ "{% endif %}"+renderExpr (CaseLogic s ts) = "{% case " <> renderExpr s <> " %}" <>+ (mconcat $ renderCaseLogic <$> ts) <>+ "{% endcase %}"+ where renderCaseLogic :: (Expr, Expr) -> Text+ renderCaseLogic (Else, y) = "{% else %}" <> renderExpr y+ renderCaseLogic (x, y) = "{% when " <> renderExpr x <> " %}" <> renderExpr y+renderExpr _ = mempty+
+ src/Text/Liquid/Parser.hs view
@@ -0,0 +1,355 @@+module Text.Liquid.Parser where++import Prelude hiding (and, null, or, takeWhile)++import Control.Applicative+import Control.Lens (Prism', prism')+import Data.Attoparsec.Combinator (lookAhead)+import Data.Attoparsec.Text+import Data.Char (isAlpha)+import Data.List.NonEmpty (NonEmpty(..), nonEmpty)+import Data.Scientific (toBoundedInteger)+import Data.Semigroup hiding (option)+import Data.Text (Text)+import qualified Data.Text as T+import Text.Liquid.Helpers+import Text.Liquid.Tokens+import Text.Liquid.Types++-- | Match middle parser, around explicit start and end parsers+between :: Parser b -- ^ open tag parser+ -> Parser b -- ^ close tag parser+ -> Parser a -- ^ match middle parser+ -> Parser a+between open close p = do+ _ <- open+ x <- p+ (close *> return x) <|> fail "Tag or output statement incomplete"++-- | Match parser between whitespace+stripped :: Parser a+ -> Parser a+stripped = between skipSpace skipSpace++-- | Match given parser for a tag+tag :: Parser a+ -> Parser a+tag p = between tagStart tagEnd (stripped p)++-- | Match given parser for output block+outputTag :: Parser a+ -> Parser a+outputTag p = between outputStart outputEnd (stripped p)++-- | Match given tag name (e.g. for, case) with following parser+tagWith :: Parser a -- ^ initial tag type, e.g. for+ -> Parser b -- ^ follow on parser, e.g. variable+ -> Parser b+tagWith tg p = tag $ tg *> skipSpace >> p++-- | Convert match into text+mapT :: Parser [Char]+ -> Parser Text+mapT = fmap T.pack++-- | Match variables (without indices, including underscore or hash)+var :: Parser Text+var = mapT $ many1 $ letter <|> satisfy (inClass "_-")++-- | Parse a positive integer within square brackets, e.g. "[123]", NOT "[123.1]"+parseBoxedInt :: Parser Int+parseBoxedInt = do+ sc <- between oBr cBr scientific+ case toBoundedInteger sc of+ Just i -> if i >= 0 then return i else err+ Nothing -> err+ where err = fail "invalid variable (array) index, expecting a positive integer"++-- | Parse a variable section with an optional indexing+-- An array index MUST be preceded by an object index+-- ...hence Maybe do comprehension+varIndexSection :: Parser (NonEmpty VarIndex)+varIndexSection = do+ vs <- sepBy var dot+ i <- many parseBoxedInt+ brokenChar <- oBr <|> return '~'+ let ixs = do obs <- (nonEmpty (ObjectIndex <$> vs))+ Just obs <> (nonEmpty (ArrayIndex <$> i))+ if brokenChar == '[' then (fail "invalid array index - ill-typed") else case ixs of+ Just nel -> return nel+ Nothing -> fail "invalid var index section"++-- | Parse a variable+variable :: Parser Expr+variable = do+ sections <- sepBy1 varIndexSection dot+ return . Variable $ foldl1 (<>) sections++-- | e.g. raw tag, comment tag+rawBodyTag :: Parser Text -- ^ start tag matcher+ -> Parser Text -- ^ end tag matcher+ -> Parser Text+rawBodyTag s e =+ s >> skipSpace *> (mapT $ manyTill anyChar (skipSpace >> e))++-- | Match interior of raw tag+rawTag :: Parser Expr+rawTag = RawText <$> rawBodyTag (tag rawStart) (tag rawEnd)++-- | Match interior of comment tag+commentTag :: Parser Expr+commentTag = rawBodyTag (tag commentStart) (tag commentEnd) *> pure Noop++-- | Match any raw text upto a tag/output start or the end of the input+textPart :: Parser Expr+textPart = RawText <$> (mapT $ manyTill1 (satisfy $ notInClass "{%") terminator)+ where terminator = lookAhead $ tagStart <|> outputStart <|> (endOfInput *> pure T.empty)++-- | Force the first character to be valid, otherwise fail miserably+manyTill1 :: Alternative f => f a -> f b -> f [a]+manyTill1 p e = (:) <$> p <*> s+ where s = (e *> pure []) <|> ((:) <$> p <*> s)++-- | Match an Ord comparison operator+ordOperator :: Parser (Expr -> Expr -> Expr)+ordOperator =+ stripped $ eq *> pure Equal <|>+ neq *> pure NotEqual <|>+ gtEq *> pure GtEqual <|>+ ltEq *> pure LtEqual <|>+ (mapT . some $ gt) *> pure Gt <|>+ (mapT . some $ lt) *> pure Lt <|>+ contains *> pure Contains++-- | Match an or, and or contains predicate+ordCombinator :: Parser (Expr -> Expr -> Expr)+ordCombinator =+ stripped $ or *> pure Or <|>+ and *> pure And++-- | Match a quoted string+quoteString :: Parser Expr+quoteString = do+ skipSpace+ beginTick <- satisfy (inClass "\'\"")+ qs <- mapT $ manyTill anyChar (char beginTick)+ return $ QuoteString qs++-- | Match a binary predicate, e.g. a.b >= b.name+binaryPredicate :: Parser Expr+binaryPredicate = do+ lhs <- quoteString <|>+ (Num <$> scientific) <|>+ Null <$ (stripped null) <|>+ Nil <$ (stripped nil) <|>+ Falseth <$ (stripped false) <|>+ Trueth <$ (stripped true) <|>+ variable+ op <- ordOperator+ rhs <- quoteString <|>+ (Num <$> scientific) <|>+ Null <$ (stripped null) <|>+ Nil <$ (stripped nil) <|>+ Falseth <$ (stripped false) <|>+ Trueth <$ (stripped true) <|>+ variable+ return $ op lhs rhs++-- | Parse and evaluate truthiness+truthy :: Parser Expr+truthy =+ Null <$ (stripped null) <|>+ Nil <$ (stripped nil) <|>+ Falseth <$ (stripped false) <|>+ Trueth <$ (stripped true) <|>+ (Truthy . Num <$> stripped scientific) <|>+ (Truthy <$> stripped quoteString) <|>+ (Truthy <$> stripped variable)++-- | Match a binary predicate, e.g. a.b >= b.name or 'barry'+predicate :: Parser Expr+predicate = do+ bpl <- stripped binaryPredicate+ oc <- ordCombinator+ bpr <- stripped binaryPredicate+ return $ oc bpl bpr++-- | Match any predicate clause+predicateClause :: Parser Expr+predicateClause =+ predicate <|> binaryPredicate <|> truthy++-- | Match an if clause+ifClause :: Parser Expr+ifClause = IfClause <$> tagWith ifStart predicateClause++-- | Match an ifkey clause+ifKeyClause :: Parser Expr+ifKeyClause = IfKeyClause <$> tagWith ifKeyStart variableOnly+ where variableOnly = do res <- eitherP precheck variable+ case res of+ Left _ -> fail "Only variables as ifkey args allowed"+ Right ok -> return ok+ precheck = Null <$ (stripped null) <|>+ Nil <$ (stripped nil) <|>+ Falseth <$ (stripped false) <|>+ Trueth <$ (stripped true) <|>+ (Truthy . Num <$> stripped scientific) <|>+ (Truthy <$> stripped quoteString)++-- | Match an elsif clause+elsifClause :: Parser Expr+elsifClause = ElsIfClause <$> tagWith elsIf predicateClause++-- | Match an else clause+elseClause :: Parser Expr+elseClause = (tag els) *> pure Else++-- | Match the end of an if clause+endIfClause :: Parser Expr+endIfClause = (tag endIf) *> pure Noop++-- | Match a variable condition for a case clause+caseClause :: Parser Expr+caseClause = tagWith caseStart variable++-- | Match a when clause, part of a case pattern match block+whenClause :: Parser Expr+whenClause = tagWith when (quoteString <|> (Num <$> scientific))++-- | Match the end of a case pattern match block+endCaseClause :: Parser Expr+endCaseClause = (tag caseEnd) *> pure Noop++-- | Match a filter fn name+filterName :: Parser Text+filterName = mapT $ skipSpace *> manyTill1 letter terminator+ where terminator = colon <|> (skipSpace *> pipe) <|> (lookAhead $ satisfy (not . isAlpha))++-- | Match the list of arguments for the filter fn+filterArgs :: Parser [Expr]+filterArgs = skipSpace *> sepBy numOrString comma+ where numOrString = skipSpace *> (Num <$> scientific) <|> quoteString++-- | Match a filter cell, fn and args+filterCell :: Parser Expr+filterCell = do+ fnName <- filterName+ args <- filterArgs+ typeCheckFilter fnName args++-- | Type check the function args and check arity+typeCheckFilter :: Text+ -> [Expr]+ -> Parser Expr+typeCheckFilter "toUpper" [] =+ return $ FilterCell "toUpper" []+typeCheckFilter "toUpper" _ =+ fail "toUpper filter takes no arguments"+typeCheckFilter "toLower" [] =+ return $ FilterCell "toLower" []+typeCheckFilter "toLower" _ =+ fail "toLower filter takes no arguments"+typeCheckFilter "toTitle" [] =+ return $ FilterCell "toTitle" []+typeCheckFilter "toTitle" _ =+ fail "toTitle filter takes no arguments"+typeCheckFilter "replace" a@[QuoteString _, QuoteString _] =+ return $ FilterCell "replace" a+typeCheckFilter "replace" _ =+ fail "replace filter requires find, replace strings as args"+typeCheckFilter "first" [] =+ return $ FilterCell "first" []+typeCheckFilter "first" _ =+ fail "first filter takes no arguments"+typeCheckFilter "firstOrDefault" a@(_:_) =+ return $ FilterCell "firstOrDefault" a+typeCheckFilter "firstOrDefault" _ =+ fail "firstOrDefault requires a single default parameter"+typeCheckFilter "last" [] =+ return $ FilterCell "last" []+typeCheckFilter "last" _ =+ fail "last filter takes no arguments"+typeCheckFilter "lastOrDefault" a@(_:_) =+ return $ FilterCell "lastOrDefault" a+typeCheckFilter "lastOrDefault" _ =+ fail "lastOrDefault requires a single default parameter"+typeCheckFilter "countElements" [] =+ return $ FilterCell "countElements" []+typeCheckFilter "countElements" _ =+ fail "countElements takes no arguments"+typeCheckFilter "renderWithSeparator" a@[QuoteString _] =+ return $ FilterCell "renderWithSeparator" a+typeCheckFilter "renderWithSeparator" _ =+ fail "renderWithSeparator requires a separator argument with which to intersperse the target array"+typeCheckFilter "toSentenceWithSeparator" a@[QuoteString _, QuoteString _] =+ return $ FilterCell "toSentenceWithSeparator" a+typeCheckFilter "toSentenceWithSeparator" _ =+ fail "toSentenceWithSeparator requires a separator argument and last element separator"+typeCheckFilter l _ =+ fail $ (show l) ++ ": function isn't supported"++-- | Match multiple filter fns and args+filterCells :: Parser [Expr]+filterCells = many ((filterCell <* (skipSpace *> pipe)) <|> filterCell)++-- | Match a lhs and a block of filters with their args+filterBlock :: Parser Expr+filterBlock = do+ lhs <- (quoteString <|> (skipSpace *> variable)) <* (skipSpace >> pipe)+ cells <- filterCells+ return $ Filter lhs cells++-- | Output block, a variable, indexed variable, number or filter block+output :: Parser Expr+output = Output <$> outputTag (filterBlock <|> quoteString <|> variable)++-- | If statement, optional elsif or else+ifLogic :: Parser Expr+ifLogic = do+ start <- ifClause <|> ifKeyClause <|> elsifClause <|> elseClause+ iftrue <- TrueStatements <$>+ manyTill (output <|> textPart)+ (lookAhead elsifClause <|> lookAhead elseClause <|> lookAhead endIfClause)+ let sofar = IfLogic start iftrue+ (endIfClause *> pure sofar) <|> (IfLogic sofar <$> ifLogic)++-- | Case pattern match block+caseLogic :: Parser Expr+caseLogic = do+ start <- caseClause+ patterns <- many1 whenBlock+ _ <- endCaseClause+ return $ CaseLogic start patterns+ where whenBlock = do+ pattern <- whenClause <|> elseClause+ iftrue <- TrueStatements <$>+ manyTill (output <|> textPart)+ (lookAhead whenClause <|> lookAhead elseClause <|> lookAhead endCaseClause)+ return (pattern, iftrue)++-- | Parse any block type+block :: Parser Expr+block = choice [ ifLogic+ , caseLogic+ , rawTag+ , commentTag+ , output+ , textPart+ ] <?> "Block Parsing"++-- | Parse an entire template into chunks+templateParser :: Parser [Expr]+templateParser = manyTill1 (block <?> "Syntax Error") endOfInput++-- | Run the templateParser on input text, force partial results to terminate with Failure+parseTemplate :: Text+ -> IResult Text [Expr]+parseTemplate t =+ feed (parse templateParser t) T.empty++templateP :: Prism' Text [Expr]+templateP = prism' back forw+ where forw = maybeResult . parseTemplate+ back = mconcat . fmap renderExpr+
+ src/Text/Liquid/Renderer.hs view
@@ -0,0 +1,416 @@+module Text.Liquid.Renderer where++import Control.Applicative+import Control.Lens hiding (op, (<|))+import Data.Aeson hiding (Null)+import Data.Aeson.Lens+import qualified Data.Aeson.Lens as AL+import Data.Attoparsec.Text+import Data.Bifunctor (second)+import Data.List (intersperse)+import Data.List.NonEmpty (NonEmpty (..), (<|))+import Data.Maybe (fromMaybe)+import Data.Monoid ((<>))+import Data.Scientific (Scientific)+import Data.Text (Text)+import qualified Data.Text as T+import Data.Validation+import Text.Liquid.Helpers+import Text.Liquid.Parser (parseTemplate)+import Text.Liquid.Types++-- | Interpret function - for use in testing the lib+interpretWithJson :: Value -- ^ JSON context+ -> Text -- ^ Raw template+ -> Rendering Text+interpretWithJson ctx template = case parseRes of+ (Fail brokenPart errCtxs _) ->+ let (ok, bad) = T.breakOn brokenPart template+ in _Failure # [ TemplateParsingError ok bad (T.pack <$> errCtxs) ]+ (Partial _) -> _Failure # [ LiquidError "Major parsing error! - Attoparsec Issue" ]+ (Done _ ts) -> interpret ctx ts+ where parseRes = parseTemplate template++-- | Interpret the raw data if it is ok+interpret :: Value+ -> [Expr]+ -> Rendering Text+interpret ctx template =+ foldl (<>) T.empty <$> sequenceA (renderTemplate ctx <$> template)++-- | Main template block rendering fn+renderTemplate :: Value+ -> Expr+ -> Rendering Text++-- | Rendering types+renderTemplate j (Output f@(Filter _ _)) = applyFilter j f+renderTemplate j (Output q@(QuoteString _)) = renderText j q+renderTemplate j (Output v@(Variable _)) = renderText j v+renderTemplate j (Output n@(Num _)) = renderText j n+renderTemplate _ (RawText t) = pure t++-- | If logic+renderTemplate j (IfLogic (IfClause i)+ (TrueStatements ts)) =+ evalLogic j (evalTruthiness j i) ts++renderTemplate j (IfLogic (IfLogic (IfClause it) (TrueStatements ts))+ (IfLogic Else (TrueStatements ets)))+ | ifTrue == (AccSuccess False) = evalLogic j (pure True) ets+ | otherwise = evalLogic j ifTrue ts+ where ifTrue = evalTruthiness j it++renderTemplate j (IfLogic (IfLogic (IfClause it) (TrueStatements ts))+ (IfLogic (ElsIfClause eit) (TrueStatements eits)))+ | ifTrue == (AccSuccess False) = evalLogic j ifElseTrue eits+ | otherwise = evalLogic j ifTrue ts+ where ifTrue = evalTruthiness j it+ ifElseTrue = evalTruthiness j eit++renderTemplate j (IfLogic (IfLogic (IfClause it) (TrueStatements ts))+ (IfLogic (IfLogic (ElsIfClause eit) (TrueStatements eits))+ (IfLogic Else (TrueStatements ets))))+ | ifTrue == (AccSuccess False) && ifElseTrue == (AccSuccess False) = evalLogic j (pure True) ets+ | ifTrue == (AccSuccess False) = evalLogic j ifElseTrue eits+ | otherwise = evalLogic j ifTrue ts+ where ifTrue = evalTruthiness j it+ ifElseTrue = evalTruthiness j eit++-- | Ifkey logic+renderTemplate j (IfLogic (IfKeyClause i)+ (TrueStatements ts)) =+ evalLogic j (evalKeyTruthiness j i) ts++renderTemplate j (IfLogic (IfLogic (IfKeyClause it) (TrueStatements ts))+ (IfLogic Else (TrueStatements ets)))+ | ifTrue == (AccSuccess False) = evalLogic j (pure True) ets+ | otherwise = evalLogic j ifTrue ts+ where ifTrue = evalKeyTruthiness j it++renderTemplate j (IfLogic (IfLogic (IfKeyClause it) (TrueStatements ts))+ (IfLogic (ElsIfClause eit) (TrueStatements eits)))+ | ifTrue == (AccSuccess False) = evalLogic j ifElseTrue eits+ | otherwise = evalLogic j ifTrue ts+ where ifTrue = evalKeyTruthiness j it+ ifElseTrue = evalTruthiness j eit++renderTemplate j (IfLogic (IfLogic (IfKeyClause it) (TrueStatements ts))+ (IfLogic (IfLogic (ElsIfClause eit) (TrueStatements eits))+ (IfLogic Else (TrueStatements ets))))+ | ifTrue == (AccSuccess False) && ifElseTrue == (AccSuccess False) = evalLogic j (pure True) ets+ | ifTrue == (AccSuccess False) = evalLogic j ifElseTrue eits+ | otherwise = evalLogic j ifTrue ts+ where ifTrue = evalKeyTruthiness j it+ ifElseTrue = evalTruthiness j eit++-- | Case logic+renderTemplate j (CaseLogic (Variable v) patterns) =+ evalCaseLogic j (extractValue j v) patterns++-- | Catch all error - theoretically impossible.+renderTemplate _ _ =+ _Failure # [ LiquidError "Template rendering critical error!" ]++-- | Evaluate predicate result and render+evalLogic :: Value -- ^ JSON Context+ -> Rendering Bool -- ^ Predicate / logical expression result+ -> [Expr] -- ^ Expressions to evaluate if true+ -> Rendering Text+evalLogic j (AccSuccess True) ts =+ foldl (<>) T.empty <$> tevals+ where tevals = sequenceA $ (renderTemplate j <$> ts)+evalLogic _ (AccSuccess False) _ = pure T.empty+evalLogic _ failure _ =+ second (const T.empty) failure++-- | Evaluate case logic+evalCaseLogic :: Value+ -> Rendering Value -- ^ Extracted JSON value for case match+ -> [(Expr, Expr)]+ -> Rendering Text+evalCaseLogic _ _ [] =+ pure T.empty+evalCaseLogic j v ((Num n, TrueStatements ts):xs) =+ case (==) (pure n) <$> preview _Number <$> v of+ AccSuccess True -> evalLogic j (pure True) ts+ AccSuccess False -> evalCaseLogic j v xs+ failure -> second (const T.empty) failure+evalCaseLogic j v ((QuoteString q, TrueStatements ts):xs) =+ case (==) (pure q) <$> preview _String <$> v of+ AccSuccess True -> evalLogic j (pure True) ts+ AccSuccess False -> evalCaseLogic j v xs+ failure -> second (const T.empty) failure+evalCaseLogic j _ ((Else, TrueStatements ts):[]) =+ evalLogic j (pure True) ts+evalCaseLogic _ v ((Else, TrueStatements _):_) =+ _Failure # [ RenderingFailure "Multiple else blocks in a case statement" ] <*> v+evalCaseLogic _ v _ =+ _Failure # [ RenderingFailure "Impossible case pattern evaluation" ] <*> v++-- | Render a renderable Expr as Text+renderText :: Value+ -> Expr+ -> Rendering Text+renderText _ Noop = pure $ T.empty+renderText _ (RawText t) = pure t+renderText _ (Num n) = pure $ formatNum n+renderText j (Variable xs) =+ numberOrTextFormat $ extractValue j xs+renderText _ (QuoteString q) = pure q+renderText _ e =+ _Failure # [ RenderingFailure $ "Can't render this type: " <> (renderExpr e) ]++-- | Format variable as either number or Text+numberOrTextFormat :: Rendering Value+ -> Rendering Text+numberOrTextFormat rv =+ fromMaybe (AccFailure [err]) (s <|> n)+ where s = sequenceA $ preview _String <$> rv+ n = sequenceA $ (fmap formatNum <$> preview _Number <$> rv)+ err = NotAStringOrNumberJsonValue rv --TODO build better error++-- | Eval key present & not null+evalKeyTruthiness :: Value+ -> Expr+ -> Rendering Bool+evalKeyTruthiness j (Variable i@(ObjectIndex "user" :| _)) =+ maybe (pure False) (const (pure True)) (j ^? buildLens i.nonNull)+evalKeyTruthiness j (Variable i@(ObjectIndex "event" :| _)) =+ maybe (pure False) (const (pure True)) (j ^? buildLens i.nonNull)+evalKeyTruthiness j (Variable i) =+ maybe (pure False) (const (pure True)) $ (j ^? buildLens i.nonNull) <|> (j ^? buildLens (ObjectIndex "event" <| i).nonNull)+evalKeyTruthiness _ _ =+ _Failure # [ RenderingFailure "Can't evalulate if key on anything other than json context variables" ]++-- | Eval truth+evalTruthiness :: Value+ -> Expr+ -> Rendering Bool+evalTruthiness j (Truthy (Variable i)) =+ case extractValue j i of+ (AccSuccess v) -> maybe (pure True) pure (v ^? _Bool)+ failure -> second (const False) failure+evalTruthiness _ (Truthy _) = pure True+evalTruthiness _ Nil = pure False+evalTruthiness _ Null = pure False+evalTruthiness _ Falseth = pure False+evalTruthiness _ Trueth = pure True+evalTruthiness j (Equal l r) = bothSidesEqual j l r+evalTruthiness j (NotEqual l r) = not <$> bothSidesEqual j l r+evalTruthiness _ (GtEqual (Num l) (Num r)) = pure $ l >= r+evalTruthiness _ (LtEqual (Num l) (Num r)) = pure $ l <= r+evalTruthiness _ (Gt (Num l) (Num r)) = pure $ l > r+evalTruthiness _ (Lt (Num l) (Num r)) = pure $ l < r+evalTruthiness _ (GtEqual (QuoteString l) (QuoteString r)) = pure $ l >= r+evalTruthiness _ (LtEqual (QuoteString l) (QuoteString r)) = pure $ l <= r+evalTruthiness _ (Gt (QuoteString l) (QuoteString r)) = pure $ l > r+evalTruthiness _ (Lt (QuoteString l) (QuoteString r)) = pure $ l < r+evalTruthiness j (GtEqual l r) = varComparisons j (>=) l r+evalTruthiness j (LtEqual l r) = varComparisons j (<=) l r+evalTruthiness j (Gt l r) = varComparisons j (>) l r+evalTruthiness j (Lt l r) = varComparisons j (<) l r+evalTruthiness j (Contains l r) = containsCheck j l r+evalTruthiness j (Or l r) =+ (||) <$> evalTruthiness j l <*> evalTruthiness j r+evalTruthiness j (And l r) =+ (&&) <$> evalTruthiness j l <*> evalTruthiness j r+evalTruthiness _ err =+ _Failure # [ ImpossibleTruthEvaluation err ]++-- | Check if the variable contains the thing on the rhs+containsCheck :: Value+ -> Expr+ -> Expr+ -> Rendering Bool+containsCheck j (Variable l) (QuoteString r) = elem r <$> v+ where v = getStringsFromArray <$> extractValue j l+containsCheck j (Variable l) (Num r) = elem r <$> v+ where v = getNumbersFromArray <$> extractValue j l+containsCheck _ (Variable _) r =+ _Failure # [ ImpossibleComparison "Contains" (renderExpr r) ]+containsCheck _ _ _ =+ _Failure # [ LiquidError "Contains checks can only be performed on arrays (i.e. Variables)" ]++-- | Aggregate all the strings in the underlying array - if present+getStringsFromArray :: Value+ -> [Text]+getStringsFromArray v =+ v ^.. values . _String++-- | Aggregate all the numbers in the underlying array - if present+getNumbersFromArray :: Value+ -> [Scientific]+getNumbersFromArray v =+ v ^.. values . _Number++-- | Truth evaluation with variables+-- ONLY numberic comparison allowed, text comparisons not supported+varComparisons :: Value+ -> (Maybe Scientific -> Maybe Scientific -> Bool)+ -> Expr+ -> Expr+ -> Rendering Bool+varComparisons j op (Num l) (Variable r) = op (pure l) <$> vr+ where vr = preview _Number <$> extractValue j r+varComparisons j op (Variable l) (Num r) = op <$> vl <*> (pure $ pure r)+ where vl = preview _Number <$> extractValue j l+varComparisons j op lhs@(Variable l) rhs@(Variable r) = res+ where vl = preview _Number <$> extractValue j l+ vr = preview _Number <$> extractValue j r+ res = case (vl, vr) of+ (AccSuccess (Just _), AccSuccess (Just _)) -> op <$> vl <*> vr+ (AccSuccess Nothing, AccSuccess (Just _)) ->+ _Failure # [ ImpossibleComparison ("Number not found at variable" <> renderExpr lhs) (renderExpr rhs) ]+ (AccSuccess (Just _), AccSuccess Nothing) ->+ _Failure # [ ImpossibleComparison (renderExpr lhs) ("Number not found at variable" <> renderExpr rhs)]+ (_, _) ->+ _Failure # [ ImpossibleComparison ("Number not found at variable" <> renderExpr lhs)+ ("Number not found at variable" <> renderExpr rhs) ]+varComparisons _ _ l r =+ _Failure # [ ImpossibleComparison (renderExpr l) (renderExpr r) ]++-- | Evaluate a binary comparison+bothSidesEqual :: Value -- ^ JSON context+ -> Expr -- ^ lhs+ -> Expr -- ^ rhs+ -> Rendering Bool+bothSidesEqual _ l r | l == r = pure True+bothSidesEqual _ (QuoteString q1) (QuoteString q2) = pure $ q1 == q2+bothSidesEqual j (Variable xs) (QuoteString q) = (==) (pure q) <$> vl+ where vl = preview _String <$> extractValue j xs+bothSidesEqual j (QuoteString q) (Variable ys) = (==) (pure q) <$> vr+ where vr = preview _String <$> extractValue j ys+bothSidesEqual j (Variable xs) (Variable ys) = (==) <$> vl <*> vr+ where vl = extractValue j xs+ vr = extractValue j ys+bothSidesEqual j (Variable xs) (Num n) = (==) (pure n) <$> vl+ where vl = preview _Number <$> extractValue j xs+bothSidesEqual j (Num n) (Variable ys) = (==) (pure n) <$> vr+ where vr = preview _Number <$> extractValue j ys+bothSidesEqual _ (Num l) (Num r) = pure $ l == r+bothSidesEqual j (Variable xs) Trueth = (==) (pure True) <$> vl+ where vl = preview _Bool <$> extractValue j xs+bothSidesEqual j Trueth (Variable xs) = (==) (pure True) <$> vl+ where vl = preview _Bool <$> extractValue j xs+bothSidesEqual j (Variable xs) Falseth = (==) (pure False) <$> vl+ where vl = preview _Bool <$> extractValue j xs+bothSidesEqual j Falseth (Variable xs) = (==) (pure False) <$> vl+ where vl = preview _Bool <$> extractValue j xs+bothSidesEqual j (Variable xs) Null = (==) (pure ()) <$> vl+ where vl = preview AL._Null <$> extractValue j xs+bothSidesEqual j Null (Variable xs) = (==) (pure ()) <$> vl+ where vl = preview AL._Null <$> extractValue j xs+bothSidesEqual j (Variable xs) Nil = (==) (pure ()) <$> vl+ where vl = preview AL._Null <$> extractValue j xs+bothSidesEqual j Nil (Variable xs) = (==) (pure ()) <$> vl+ where vl = preview AL._Null <$> extractValue j xs+bothSidesEqual _ l r =+ _Failure # [ ImpossibleComparison (renderExpr l) (renderExpr r) ]++-- | Fold over multiple layers of variable syntax, and deal with future event nesting+extractValue :: Value+ -> JsonVarPath+ -> Rendering Value+extractValue j xz@(ObjectIndex "user" :| _) =+ case j ^? buildLens xz of+ Just v -> _Success # v+ Nothing -> _Failure # [ JsonValueNotFound xz ]+extractValue j xz@(ObjectIndex "event" :| _) =+ case (j ^? buildLens xz) of+ Just v -> _Success # v+ Nothing -> _Failure # [ JsonValueNotFound xz ]+extractValue j xz = -- ^ If template doesn't have context yet - add it after first attempting raw key+ case (j ^? buildLens xz) <|>+ (j ^? buildLens (ObjectIndex "event" <| xz)) of+ Just v -> _Success # v+ Nothing -> _Failure # [ JsonValueNotFound xz ]++-- | Apply a filter to the input+applyFilter :: Value+ -> Expr+ -> Rendering Text+applyFilter _ (Filter (QuoteString q) []) = pure q+applyFilter _ (Filter (QuoteString q) (c:fcs)) =+ case applyFilterM q c >>= \i -> foldM' applyFilterM i fcs of+ Just t -> AccSuccess t+ _ -> _Failure # [ RenderingFailure "Filtration fn failure" ]+applyFilter j (Filter (Variable vs) fcs) =+ case res of+ (AccSuccess (Just t)) -> AccSuccess t+ failure -> _Failure # [ RenderingFailure "Variable filtration fn failure" ] <*> failure+ where res = (\v -> applyCellsM v fcs) <$> extractValue j vs+applyFilter _ _ =+ _Failure # [ LiquidError "Filter Bug!" ]++-- | Apply a chain of functions from l -> r+applyCellsM :: Value+ -> [Expr]+ -> Maybe Text+applyCellsM v [] = v ^? _String+applyCellsM v (c:fcs) = arrayFilterM v c >>= \i -> foldM' applyFilterM i fcs++-- | Apply a filter+applyFilterM :: Text -- ^ LHS+ -> Expr -- ^ FilterCell+ -> Maybe Text+applyFilterM i (FilterCell "toUpper" []) = pure $ T.toUpper i+applyFilterM i (FilterCell "toLower" []) = pure $ T.toLower i+applyFilterM i (FilterCell "toTitle" []) = pure $ T.toTitle i+applyFilterM i (FilterCell "replace" [QuoteString find,+ QuoteString rep ]) =+ pure $ T.replace find rep i+applyFilterM _ _ = Nothing++-- | Apply the array filter if the targeted value is an array, otherwise the reg filter+arrayFilterM :: Value+ -> Expr+ -> Maybe Text+arrayFilterM v fc | isn't _Nothing $ st = st >>= (flip applyFilterM) fc+ | otherwise = applyArrayFilterM arr fc+ where st = v ^? _String+ arr = v ^.. values++-- | Apply an array filter to an array+applyArrayFilterM :: [Value]+ -> Expr+ -> Maybe Text+applyArrayFilterM [] (FilterCell "first" []) = pure ""+applyArrayFilterM vs (FilterCell "first" []) = (vs ^? ix 0 . _String) <|>+ (formatNum <$> vs ^? ix 0 . _Number) <|>+ (pure "")+applyArrayFilterM [] (FilterCell "last" []) = pure ""+applyArrayFilterM vs (FilterCell "last" []) = (vs ^? _last . _String) <|>+ (formatNum <$> vs ^? _last . _Number) <|>+ (pure "")+applyArrayFilterM [] (FilterCell "firstOrDefault" [QuoteString d]) = pure d+applyArrayFilterM [] (FilterCell "firstOrDefault" [Num d]) = pure $ formatNum d+applyArrayFilterM vs (FilterCell "firstOrDefault" _) = (vs ^? ix 0 . _String) <|>+ (formatNum <$> vs ^? ix 0 . _Number)+applyArrayFilterM [] (FilterCell "lastOrDefault" [QuoteString d]) = pure d+applyArrayFilterM [] (FilterCell "lastOrDefault" [Num d]) = pure $ formatNum d+applyArrayFilterM vs (FilterCell "lastOrDefault" _) = (vs ^? _last . _String) <|>+ (formatNum <$> vs ^? _last . _Number)+applyArrayFilterM [] (FilterCell "toSentenceWithSeparator" _) = pure ""+applyArrayFilterM vs (FilterCell "toSentenceWithSeparator" [QuoteString sep, QuoteString fin]) = do+ (upToLast, lastElem) <- vs^?_Snoc+ case null upToLast of+ True -> renderv lastElem+ False -> do+ text <- mconcat . intersperse sep <$> renderEachArrayElem upToLast+ fmap (mappend $ text <> fin) $ renderv lastElem+applyArrayFilterM [] (FilterCell "renderWithSeparator" _) = pure ""+applyArrayFilterM vs (FilterCell "renderWithSeparator" [QuoteString sep]) =+ mconcat . intersperse sep <$> renderEachArrayElem vs+applyArrayFilterM [] (FilterCell "countElements" _) = pure "0"+applyArrayFilterM vs (FilterCell "countElements" _) = pure . T.pack . show $ length vs+applyArrayFilterM _ _ = Nothing++renderv :: Value -> Maybe Text+renderv v = v^?_String <|> (formatNum <$> v^?_Number)++-- | Render each array element (can only contain strings or numbers!)+renderEachArrayElem :: [Value]+ -> Maybe [Text]+renderEachArrayElem = traverse renderv+
+ src/Text/Liquid/Tokens.hs view
@@ -0,0 +1,225 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Text.Liquid.Tokens (+ and+ , assign+ , break+ , cBr+ , cPar+ , captureEnd+ , captureStart+ , caseEnd+ , caseStart+ , colon+ , comma+ , commentEnd+ , commentStart+ , contains+ , continue+ , cycle+ , dot+ , dotDot+ , els+ , elsIf+ , empty+ , end+ , endIf+ , eq+ , eqSign+ , false+ , forEnd+ , forStart+ , gt+ , gtEq+ , iN+ , ifKeyStart+ , ifStart+ , include+ , lt+ , ltEq+ , minus+ , neq+ , nil+ , null+ , oBr+ , oPar+ , or+ , outputEnd+ , outputStart+ , pipe+ , qMark+ , rawEnd+ , rawStart+ , tableEnd+ , tableStart+ , tagEnd+ , tagStart+ , true+ , underscore+ , unlessEnd+ , unlessStart+ , when+ , with+ ) where++import Control.Applicative ((<|>))+import Data.Attoparsec.Text+import Data.Text (Text)+import Prelude (Char)++--------------------------------------------------------------------------------+-- * Symbolic Tokens+--------------------------------------------------------------------------------++colon :: Parser Char+colon = char ':'++comma :: Parser Char+comma = char ','++dot :: Parser Char+dot = char '.'++dotDot :: Parser Text+dotDot = ".."++eq :: Parser Text+eq = "=="++eqSign :: Parser Char+eqSign = char '='++gt :: Parser Char+gt = char '>'++gtEq :: Parser Text+gtEq = ">="++lt :: Parser Char+lt = char '<'++ltEq :: Parser Text+ltEq = "<="++minus :: Parser Char+minus = char '-'++neq :: Parser Text+neq = "!=" <|> "<>"++oBr, cBr :: Parser Char+oBr = char '['+cBr = char ']'++oPar, cPar :: Parser Char+oPar = char '('+cPar = char ')'++outputStart, outputEnd :: Parser Text+outputStart = "{{"+outputEnd = "}}"++pipe :: Parser Char+pipe = char '|'++qMark :: Parser Char+qMark = char '?'++tagStart, tagEnd :: Parser Text+tagStart = "{%"+tagEnd = "%}"++underscore :: Parser Char+underscore = char '_'++--------------------------------------------------------------------------------+-- * Textual Tokens+--------------------------------------------------------------------------------++and :: Parser Text+and = "and"++assign :: Parser Text+assign = "assign"++break, continue :: Parser Text+break = "break"+continue = "continue"++captureStart, captureEnd :: Parser Text+captureStart = "capture"+captureEnd = "endcapture"++caseStart, caseEnd :: Parser Text+caseStart = "case"+caseEnd = "endcase"++commentStart, commentEnd :: Parser Text+commentStart = "comment"+commentEnd = "endcomment"++contains :: Parser Text+contains = "contains"++cycle :: Parser Text+cycle = "cycle"++els :: Parser Text+els = "else"++elsIf :: Parser Text+elsIf = "elsif"++empty :: Parser Text+empty = "empty"+end :: Parser Text+end = "end"++endIf :: Parser Text+endIf = "endif"++forStart, forEnd :: Parser Text+forStart = "for"+forEnd = "endfor"++iN :: Parser Text+iN = "in"++ifKeyStart :: Parser Text+ifKeyStart = "ifkey"++ifStart :: Parser Text+ifStart = "if"++include :: Parser Text+include = "include"++null, nil :: Parser Text+null = "null"+nil = "nil"++or :: Parser Text+or = "or"++rawStart, rawEnd :: Parser Text+rawStart = "raw"+rawEnd = "endraw"++tableStart, tableEnd :: Parser Text+tableStart = "tablerow"+tableEnd = "endtablerow"++true, false :: Parser Text+true = "true"+false = "false"++unlessStart, unlessEnd :: Parser Text+unlessStart = "unless"+unlessEnd = "endunless"++when :: Parser Text+when = "when"++with :: Parser Text+with = "with"+
+ src/Text/Liquid/Types.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE TemplateHaskell #-}++module Text.Liquid.Types where++import Control.Lens.TH (makePrisms)+import Data.Aeson.Types (Value)+import Data.List.NonEmpty (NonEmpty)+import Data.Scientific (Scientific)+import Data.Text (Text)+import Data.Validation (AccValidation)++--------------------------------------------------------------------------------+-- * Liquid Template Data+--------------------------------------------------------------------------------++type JsonVarPath = NonEmpty VarIndex++data VarIndex+ = ObjectIndex Text+ | ArrayIndex Int+ deriving (Eq, Ord, Show)++data Expr+ = Noop+ | RawText Text+ | Num Scientific+ | Variable JsonVarPath+ | QuoteString Text+ | Equal Expr Expr+ | NotEqual Expr Expr+ | GtEqual Expr Expr+ | LtEqual Expr Expr+ | Gt Expr Expr+ | Lt Expr Expr+ | Or Expr Expr+ | And Expr Expr+ | Contains Expr Expr+ | Nil+ | Null+ | Trueth+ | Falseth+ | Truthy Expr+ | IfClause Expr+ | IfKeyClause Expr+ | ElsIfClause Expr+ | Else+ | FilterCell Text [Expr]+ | Filter Expr [Expr]+ | Output Expr+ | TrueStatements [Expr]+ | IfLogic Expr Expr+ | CaseLogic Expr [(Expr, Expr)]+ deriving (Eq, Show)+makePrisms ''Expr++--------------------------------------------------------------------------------+-- * Error types+--------------------------------------------------------------------------------++type Rendering a = AccValidation [LiquidError] a++data LiquidError+ = TemplateParsingError Text Text [Text]+ | JsonValueError Text+ | JsonValueNotFound JsonVarPath+ | NotAStringOrNumberJsonValue (Rendering Value)+ | ImpossibleComparison Text Text+ | ImpossibleTruthEvaluation Expr+ | RenderingFailure Text+ | LiquidError Text+ deriving (Eq, Show)+
+ src/Text/Liquid/VariableFinder.hs view
@@ -0,0 +1,161 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections #-}++module Text.Liquid.VariableFinder where++import Control.Arrow+import Control.Monad.State.Lazy+import qualified Data.List as L+import qualified Data.List.NonEmpty as NEL+import Text.Liquid.Types++-- | Allowed types+data VType+ = VString+ | VNumber+ | VStringOrNumber+ | VBool+ | VAny+ deriving (Eq, Show)++-- | Map findAllVariables across terms from parsed template and concatenate variable with inferred type+findAllVariables :: [Expr]+ -> [(JsonVarPath, VType)]+findAllVariables exps =+ L.nub . join $ flip runStateT VStringOrNumber . findVariables mzero <$> exps++-- | Find all the variables in a node's children, with a type scope+findVariables :: StateT VType [] JsonVarPath+ -> Expr+ -> StateT VType [] JsonVarPath+findVariables vs (Variable v) =+ return v `mplus` vs+findVariables vs (Equal l r) =+ (findVariables mzero l) `mplus` (findVariables mzero r) `mplus` vs+findVariables vs (NotEqual l r) =+ (findVariables mzero l) `mplus` (findVariables mzero r) `mplus` vs+findVariables vs (GtEqual l r) =+ put VNumber >> (findVariables mzero l) `mplus` (findVariables mzero r) `mplus` vs+findVariables vs (LtEqual l r) =+ put VNumber >> (findVariables mzero l) `mplus` (findVariables mzero r) `mplus` vs+findVariables vs (Gt l r) =+ put VNumber >> (findVariables mzero l) `mplus` (findVariables mzero r) `mplus` vs+findVariables vs (Lt l r) =+ put VNumber >> (findVariables mzero l) `mplus` (findVariables mzero r) `mplus` vs+findVariables vs (Or l r) =+ (findVariables mzero l) `mplus` (findVariables mzero r) `mplus` vs+findVariables vs (And l r) =+ (findVariables mzero l) `mplus` (findVariables mzero r) `mplus` vs+findVariables vs (Contains l r) =+ (findVariables mzero l) `mplus` (findVariables mzero r) `mplus` vs+findVariables vs (Truthy t) =+ put VBool >> findVariables vs t+findVariables vs (IfClause i) =+ findVariables vs i+findVariables vs (IfKeyClause i) =+ findVariables vs i+findVariables vs (ElsIfClause i) =+ findVariables vs i+findVariables vs (Filter f xs) =+ put VString >> (findVariables mzero f) `mplus` (msum $ findVariables mzero <$> xs) `mplus` vs+findVariables vs (Output o) =+ findVariables vs o+findVariables vs (TrueStatements xs) =+ (msum $ findVariables mzero <$> xs) `mplus` vs+findVariables vs (IfLogic l r) =+ (findVariables mzero l) `mplus` (findVariables mzero r) `mplus` vs+findVariables vs (CaseLogic c xts) =+ let (ls, rs) = unzip xts+ in (findVariables mzero c) `mplus`+ (msum $ findVariables mzero <$> ls) `mplus`+ (msum $ findVariables mzero <$> rs) `mplus`+ vs+findVariables vs _ =+ vs++-- | Find all context variables and add a sample filter.+-- Designed to simulate required templates for aggregate contexts - see JsonTools+makeAggregate :: Expr+ -- ^ Aggregate sample filter to add+ -> VarIndex+ -- ^ Prefix to filter on - do not aggregate this prefix+ -> [Expr]+ -- ^ Parsed template to make `aggregate` style+ -> [Expr]+makeAggregate af pf xs =+ aggregateElem af pf <$> xs++aggregateElem :: Expr -- ^ Aggregate sample filter to add+ -> VarIndex -- ^ Prefix to filter on - do not aggregate this prefix+ -> Expr -- ^ Expression under modification+ -> Expr+aggregateElem _ _ Noop = Noop+aggregateElem _ _ r@(RawText _) = r+aggregateElem _ _ n@(Num _) = n+aggregateElem _ _ v@(Variable _) = v+aggregateElem _ _ q@(QuoteString _) = q+aggregateElem af pf (Equal l r) =+ Equal (aggregateElem af pf l) (aggregateElem af pf r)+aggregateElem af pf (NotEqual l r) =+ NotEqual (aggregateElem af pf l) (aggregateElem af pf r)+aggregateElem af pf (GtEqual l r) =+ GtEqual (aggregateElem af pf l) (aggregateElem af pf r)+aggregateElem af pf (LtEqual l r) =+ LtEqual (aggregateElem af pf l) (aggregateElem af pf r)+aggregateElem af pf (Gt l r) =+ Gt (aggregateElem af pf l) (aggregateElem af pf r)+aggregateElem af pf (Lt l r) =+ Lt (aggregateElem af pf l) (aggregateElem af pf r)+aggregateElem af pf (Or l r) =+ Or (aggregateElem af pf l) (aggregateElem af pf r)+aggregateElem af pf (And l r) =+ And (aggregateElem af pf l) (aggregateElem af pf r)+aggregateElem af pf (Contains l r) =+ Contains (aggregateElem af pf l) (aggregateElem af pf r)+aggregateElem af pf (Truthy x) =+ Truthy (aggregateElem af pf x)+aggregateElem af pf (IfClause x) =+ IfClause (aggregateElem af pf x)+aggregateElem af pf (IfKeyClause x) =+ IfKeyClause (aggregateElem af pf x)+aggregateElem af pf (ElsIfClause x) =+ ElsIfClause (aggregateElem af pf x)+aggregateElem _ _ Else = Else+aggregateElem af pf (FilterCell x ys) =+ FilterCell x (aggregateElem af pf <$> ys)+aggregateElem af pf (Filter (q@(QuoteString _)) fs) =+ Filter q (aggregateElem af pf <$> fs)+aggregateElem af pf (Filter (v@(Variable path)) fs)+ | NEL.head path == pf = Filter v (aggregateElem af pf <$> fs)+ | otherwise = Filter v (aggregateElem af pf <$> updateFs af fs)+aggregateElem af pf (Filter x fs) =+ Filter x (aggregateElem af pf <$> fs)+aggregateElem _ _ (Output q@(QuoteString _)) =+ Output q+aggregateElem af pf (Output v@(Variable path))+ | NEL.head path == pf = Output v+ | otherwise = Output (Filter v [af])+aggregateElem af pf (Output f) =+ Output (aggregateElem af pf f)+aggregateElem af pf (TrueStatements xs) =+ TrueStatements (aggregateElem af pf <$> xs)+aggregateElem af pf (IfLogic l r) =+ IfLogic (aggregateElem af pf l) (aggregateElem af pf r)+aggregateElem af pf (CaseLogic x ys) =+ CaseLogic (aggregateElem af pf x) ((aggregateElem af pf *** aggregateElem af pf) <$> ys)+aggregateElem _ _ x = x++updateFs :: Expr -- ^ Aggregate sample filter to prepend+ -> [Expr] -- ^ List of filter cells+ -> [Expr]+updateFs _ [] = []+updateFs _ f@((FilterCell "first" _):_) = f+updateFs _ f@((FilterCell "firstOrDefault" _):_) = f+updateFs _ f@((FilterCell "last" _):_) = f+updateFs _ f@((FilterCell "lastOrDefault" _):_) = f+updateFs _ f@((FilterCell "countElements" _):_) = f+updateFs _ f@((FilterCell "renderWithSeparator" _):_) = f+updateFs _ f@((FilterCell "toSentenceWithSeparator" _):_) = f+updateFs af (f:fs) = af:f:fs+
+ test/Main.hs view
@@ -0,0 +1,16 @@+import Test.Tasty (defaultMain, TestTree, testGroup)+import Text.Liquid.HelperTests+import Text.Liquid.ParserTests+import Text.Liquid.RendererTests+import Text.Liquid.VariableFinderTests++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "Root"+ [ helperTests+ , parserTests+ , rendererTests+ , variableFinderTests+ ]