liquid 0.1.0.1 → 0.1.0.2
raw patch · 8 files changed
+374/−294 lines, 8 filesdep ~QuickCheckdep ~aesondep ~attoparsecsetup-changed
Dependency ranges changed: QuickCheck, aeson, attoparsec, base, criterion, lens, scientific, semigroups, tasty, tasty-quickcheck, tasty-th, text, unordered-containers, validation, vector
Files
- Setup.hs +3/−1
- liquid.cabal +37/−38
- src/Text/Liquid/Helpers.hs +98/−84
- src/Text/Liquid/Parser.hs +44/−24
- src/Text/Liquid/Renderer.hs +95/−68
- src/Text/Liquid/Tokens.hs +1/−0
- src/Text/Liquid/Types.hs +7/−6
- src/Text/Liquid/VariableFinder.hs +89/−73
Setup.hs view
@@ -1,2 +1,4 @@-import Distribution.Simple+import Distribution.Simple+ main = defaultMain+
liquid.cabal view
@@ -1,5 +1,5 @@ name: liquid-version: 0.1.0.1+version: 0.1.0.2 synopsis: Liquid template language library description: Parser, interpreter and assorted functions for the Liquid template language license: BSD3@@ -19,7 +19,7 @@ library default-language: Haskell2010 - ghc-options: -Wall -O2+ ghc-options: -Wall hs-source-dirs: src @@ -31,20 +31,18 @@ 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+ build-depends: attoparsec >=0.13.1.0 && <0.14,+ aeson >=0.11.2.1 && <0.12,+ base >=4.9.0.0 && <5.0,+ lens >=4.14 && <4.15,+ lens-aeson >=1.0.0.5 && <1.1,+ mtl >=2.2.1 && <2.3,+ semigroups >=0.18.2 && <0.19,+ scientific >=0.3.4.9 && <0.4,+ text >=1.2.2.1 && <1.3,+ unordered-containers >=0.2.7.1 && <0.3,+ validation >=0.5.4 && <0.6,+ vector >=0.11.0.0 && <0.12 test-suite test @@ -58,26 +56,27 @@ 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,+ build-depends: aeson >=0.11.2.1 && <0.12,+ QuickCheck >=2.8.2 && <2.9,+ attoparsec >=0.13.1.0 && <0.14,+ base >=4.9.0.0 && <5.0,+ lens >=4.14 && <4.15,+ 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+ mtl >=2.2.1 && <2.3,+ scientific >=0.3.4.9 && <0.4,+ semigroups >=0.18.2 && <0.19,+ tasty >=0.11.0.4 && <0.12,+ tasty-hunit >=0.9.2 && <0.10,+ tasty-quickcheck >=0.8.4 && <0.9,+ tasty-th >=0.1.4 && <0.2,+ text >=1.2.2.1 && <1.3,+ unordered-containers >=0.2.7.1 && <0.3,+ validation >=0.5.4 && <0.6,+ vector >=0.11.0.0 && <0.12 benchmark bench+ default-language: Haskell2010 type: exitcode-stdio-1.0@@ -90,9 +89,9 @@ 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,+ build-depends: attoparsec >=0.13.1.0 && <0.14,+ aeson >=0.11.2.1 && <0.12,+ base >=4.9 && <5,+ criterion >=1.1.1.0 && <1.2, liquid,- text >=1.2.1.3 && <1.3+ text >=1.2.2.1 && <1.3
src/Text/Liquid/Helpers.hs view
@@ -1,6 +1,8 @@-{-# LANGUAGE GADTs #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-} module Text.Liquid.Helpers ( foldM'@@ -19,107 +21,119 @@ 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'+ :: 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+ :: 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+ :: 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+renderPath+ :: JsonVarPath+ -> Text+renderPath = foldl conc T.empty 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) <> "]"+ 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 _))+renderExpr+ :: Expr+ -> Text+renderExpr e = case e of+ Noop -> mempty+ (RawText t) -> t+ (Num s) -> formatNum s+ (Variable jp) -> renderPath jp+ (QuoteString t) -> "\'" <> t <> "\'"+ (Equal l r) -> renderExpr l <> " == " <> renderExpr r+ (NotEqual l r) -> renderExpr l <> " != " <> renderExpr r+ (GtEqual l r) -> renderExpr l <> " >= " <> renderExpr r+ (LtEqual l r) -> renderExpr l <> " <= " <> renderExpr r+ (Gt l r) -> renderExpr l <> " > " <> renderExpr r+ (Lt l r) -> renderExpr l <> " < " <> renderExpr r+ (Or l r) -> renderExpr l <> " or " <> renderExpr r+ (And l r) -> renderExpr l <> " and " <> renderExpr r+ (Contains l r) -> renderExpr l <> " contains " <> renderExpr r+ Trueth -> "true"+ Falseth -> "false"+ Nil -> "nil"+ Null -> "null"+ (Truthy x) -> renderExpr x+ (IfClause x) -> "{% if " <> renderExpr x <> " %}"+ (IfKeyClause x) -> "{% ifkey " <> renderExpr x <> " %}"+ (ElsIfClause x) -> "{% elsif " <> renderExpr x <> " %}"+ Else -> "{% else %}"+ (FilterCell n []) -> n+ (FilterCell n opts) -> n <> ": " <> mconcat (intersperse ", " $ renderExpr <$> opts)+ (Filter t fs) -> renderExpr t <> " | " <> mconcat (intersperse " | " $ renderExpr <$> fs)+ (Output x) -> "{{ " <> renderExpr x <> " }}"+ (TrueStatements xs) -> mconcat $ renderExpr <$> xs+ (IfLogic i+ ts@(TrueStatements _)) ->+ renderExpr i <>+ renderExpr ts <>+ "{% endif %}"+ (IfLogic (IfLogic i ts1@(TrueStatements _))+ (IfLogic Else ts2@(TrueStatements _))) ->+ renderExpr i <>+ renderExpr ts1 <>+ renderExpr Else <>+ renderExpr ts2 <>+ "{% endif %}"+ (IfLogic (IfLogic i ts1@(TrueStatements _))+ (IfLogic ei@(ElsIfClause _) ts2@(TrueStatements _))) ->+ renderExpr i <>+ renderExpr ts1 <>+ renderExpr ei <>+ renderExpr ts2 <>+ "{% endif %}"+ (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+ (IfLogic Else ts3@(TrueStatements _)))) ->+ renderExpr i <>+ renderExpr ts1 <>+ renderExpr ei <>+ renderExpr ts2 <>+ renderExpr Else <>+ renderExpr ts3 <>+ "{% endif %}"+ (CaseLogic s ts) ->+ "{% case " <> renderExpr s <> " %}" <>+ mconcat (renderCaseLogic <$> ts) <>+ "{% endcase %}"+ _ -> mempty++renderCaseLogic+ :: (Expr, Expr)+ -> Text+renderCaseLogic (Else, y) =+ "{% else %}" <> renderExpr y+renderCaseLogic (x, y) =+ "{% when " <> renderExpr x <> " %}" <> renderExpr y
src/Text/Liquid/Parser.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ module Text.Liquid.Parser where import Prelude hiding (and, null, or, takeWhile)@@ -7,7 +9,7 @@ import Data.Attoparsec.Combinator (lookAhead) import Data.Attoparsec.Text import Data.Char (isAlpha)-import Data.List.NonEmpty (NonEmpty(..), nonEmpty)+import Data.List.NonEmpty (NonEmpty (..), nonEmpty) import Data.Scientific (toBoundedInteger) import Data.Semigroup hiding (option) import Data.Text (Text)@@ -16,41 +18,53 @@ 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+ :: 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+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)+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)+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+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+mapT+ :: Parser [Char]+ -> Parser Text+mapT =+ fmap T.pack -- | Match variables (without indices, including underscore or hash) var :: Parser Text@@ -224,7 +238,9 @@ -- | Match a filter fn name filterName :: Parser Text filterName = mapT $ skipSpace *> manyTill1 letter terminator- where terminator = colon <|> (skipSpace *> pipe) <|> (lookAhead $ satisfy (not . isAlpha))+ where terminator = colon <|>+ (skipSpace *> pipe) <|>+ (lookAhead $ satisfy (not . isAlpha)) -- | Match the list of arguments for the filter fn filterArgs :: Parser [Expr]@@ -310,7 +326,9 @@ start <- ifClause <|> ifKeyClause <|> elsifClause <|> elseClause iftrue <- TrueStatements <$> manyTill (output <|> textPart)- (lookAhead elsifClause <|> lookAhead elseClause <|> lookAhead endIfClause)+ (lookAhead elsifClause <|>+ lookAhead elseClause <|>+ lookAhead endIfClause) let sofar = IfLogic start iftrue (endIfClause *> pure sofar) <|> (IfLogic sofar <$> ifLogic) @@ -325,7 +343,9 @@ pattern <- whenClause <|> elseClause iftrue <- TrueStatements <$> manyTill (output <|> textPart)- (lookAhead whenClause <|> lookAhead elseClause <|> lookAhead endCaseClause)+ (lookAhead whenClause <|>+ lookAhead elseClause <|>+ lookAhead endCaseClause) return (pattern, iftrue) -- | Parse any block type
src/Text/Liquid/Renderer.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ module Text.Liquid.Renderer where import Control.Applicative@@ -19,10 +21,12 @@ 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+ :: Value -- ^ JSON context+ -> Text -- ^ Raw template+ -> Rendering Text interpretWithJson ctx template = case parseRes of (Fail brokenPart errCtxs _) -> let (ok, bad) = T.breakOn brokenPart template@@ -32,16 +36,18 @@ where parseRes = parseTemplate template -- | Interpret the raw data if it is ok-interpret :: Value- -> [Expr]- -> Rendering Text+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+renderTemplate+ :: Value+ -> Expr+ -> Rendering Text -- | Rendering types renderTemplate j (Output f@(Filter _ _)) = applyFilter j f@@ -113,10 +119,11 @@ _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+ :: 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)@@ -125,10 +132,11 @@ second (const T.empty) failure -- | Evaluate case logic-evalCaseLogic :: Value- -> Rendering Value -- ^ Extracted JSON value for case match- -> [(Expr, Expr)]- -> Rendering Text+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) =@@ -149,9 +157,10 @@ _Failure # [ RenderingFailure "Impossible case pattern evaluation" ] <*> v -- | Render a renderable Expr as Text-renderText :: Value- -> Expr- -> Rendering Text+renderText+ :: Value+ -> Expr+ -> Rendering Text renderText _ Noop = pure $ T.empty renderText _ (RawText t) = pure t renderText _ (Num n) = pure $ formatNum n@@ -162,8 +171,9 @@ _Failure # [ RenderingFailure $ "Can't render this type: " <> (renderExpr e) ] -- | Format variable as either number or Text-numberOrTextFormat :: Rendering Value- -> Rendering Text+numberOrTextFormat+ :: Rendering Value+ -> Rendering Text numberOrTextFormat rv = fromMaybe (AccFailure [err]) (s <|> n) where s = sequenceA $ preview _String <$> rv@@ -171,9 +181,10 @@ err = NotAStringOrNumberJsonValue rv --TODO build better error -- | Eval key present & not null-evalKeyTruthiness :: Value- -> Expr- -> Rendering Bool+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" :| _)) =@@ -184,9 +195,10 @@ _Failure # [ RenderingFailure "Can't evalulate if key on anything other than json context variables" ] -- | Eval truth-evalTruthiness :: Value- -> Expr- -> Rendering Bool+evalTruthiness+ :: Value+ -> Expr+ -> Rendering Bool evalTruthiness j (Truthy (Variable i)) = case extractValue j i of (AccSuccess v) -> maybe (pure True) pure (v ^? _Bool)@@ -219,10 +231,11 @@ _Failure # [ ImpossibleTruthEvaluation err ] -- | Check if the variable contains the thing on the rhs-containsCheck :: Value- -> Expr- -> Expr- -> Rendering Bool+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@@ -233,24 +246,27 @@ _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+ :: Value+ -> [Text] getStringsFromArray v = v ^.. values . _String -- | Aggregate all the numbers in the underlying array - if present-getNumbersFromArray :: Value- -> [Scientific]+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+ :: 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)@@ -271,10 +287,11 @@ _Failure # [ ImpossibleComparison (renderExpr l) (renderExpr r) ] -- | Evaluate a binary comparison-bothSidesEqual :: Value -- ^ JSON context- -> Expr -- ^ lhs- -> Expr -- ^ rhs- -> Rendering Bool+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@@ -309,9 +326,10 @@ _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+ :: Value+ -> JsonVarPath+ -> Rendering Value extractValue j xz@(ObjectIndex "user" :| _) = case j ^? buildLens xz of Just v -> _Success # v@@ -320,16 +338,17 @@ 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+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+ :: 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@@ -344,16 +363,18 @@ _Failure # [ LiquidError "Filter Bug!" ] -- | Apply a chain of functions from l -> r-applyCellsM :: Value- -> [Expr]- -> Maybe Text+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+ :: 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@@ -363,18 +384,20 @@ applyFilterM _ _ = Nothing -- | Apply the array filter if the targeted value is an array, otherwise the reg filter-arrayFilterM :: Value- -> Expr- -> Maybe Text+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+ :: [Value]+ -> Expr+ -> Maybe Text applyArrayFilterM [] (FilterCell "first" []) = pure "" applyArrayFilterM vs (FilterCell "first" []) = (vs ^? ix 0 . _String) <|> (formatNum <$> vs ^? ix 0 . _Number) <|>@@ -406,11 +429,15 @@ applyArrayFilterM vs (FilterCell "countElements" _) = pure . T.pack . show $ length vs applyArrayFilterM _ _ = Nothing -renderv :: Value -> Maybe Text-renderv v = v^?_String <|> (formatNum <$> v^?_Number)+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+ :: [Value]+ -> Maybe [Text] renderEachArrayElem = traverse renderv
src/Text/Liquid/Tokens.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-} module Text.Liquid.Tokens ( and
src/Text/Liquid/Types.hs view
@@ -2,12 +2,13 @@ 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)+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
src/Text/Liquid/VariableFinder.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} module Text.Liquid.VariableFinder where@@ -10,6 +11,7 @@ import qualified Data.List.NonEmpty as NEL import Text.Liquid.Types + -- | Allowed types data VType = VString@@ -20,76 +22,86 @@ deriving (Eq, Show) -- | Map findAllVariables across terms from parsed template and concatenate variable with inferred type-findAllVariables :: [Expr]- -> [(JsonVarPath, VType)]+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+findVariables+ :: StateT VType [] JsonVarPath+ -> Expr+ -> StateT VType [] JsonVarPath+findVariables vs e = case e of+ (Variable v) -> return v `mplus` vs+ (Equal l r) -> findVariables mzero l `mplus`+ findVariables mzero r `mplus`+ vs+ (NotEqual l r) -> findVariables mzero l `mplus`+ findVariables mzero r `mplus`+ vs+ (GtEqual l r) -> put VNumber >> findVariables mzero l `mplus`+ findVariables mzero r `mplus`+ vs+ (LtEqual l r) -> put VNumber >> findVariables mzero l `mplus`+ findVariables mzero r `mplus`+ vs+ (Gt l r) -> put VNumber >> findVariables mzero l `mplus`+ findVariables mzero r `mplus`+ vs+ (Lt l r) -> put VNumber >> findVariables mzero l `mplus`+ findVariables mzero r `mplus`+ vs+ (Or l r) -> findVariables mzero l `mplus`+ findVariables mzero r `mplus`+ vs+ (And l r) -> findVariables mzero l `mplus`+ findVariables mzero r `mplus`+ vs+ (Contains l r) -> findVariables mzero l `mplus`+ findVariables mzero r `mplus`+ vs+ (Truthy t) -> put VBool >> findVariables vs t+ (IfClause i) -> findVariables vs i+ (IfKeyClause i) -> findVariables vs i+ (ElsIfClause i) -> findVariables vs i+ (Filter f xs) -> put VString >> findVariables mzero f `mplus`+ msum (findVariables mzero <$> xs) `mplus`+ vs+ (Output o) -> findVariables vs o+ (TrueStatements xs) -> msum (findVariables mzero <$> xs) `mplus` vs+ (IfLogic l r) -> findVariables mzero l `mplus`+ findVariables mzero r `mplus`+ 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+ _ -> 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+ :: 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+ :: 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@@ -146,16 +158,20 @@ 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+updateFs+ :: Expr+ -- ^ Aggregate sample filter to prepend+ -> [Expr]+ -- ^ List of filter cells+ -> [Expr]+updateFs af e = case e of+ [] -> []+ f@(FilterCell "first" _:_) -> f+ f@(FilterCell "firstOrDefault" _:_) -> f+ f@(FilterCell "last" _:_) -> f+ f@(FilterCell "lastOrDefault" _:_) -> f+ f@(FilterCell "countElements" _:_) -> f+ f@(FilterCell "renderWithSeparator" _:_) -> f+ f@(FilterCell "toSentenceWithSeparator" _:_) -> f+ (f:fs) -> af:f:fs