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
interpretWithJson
:: Value
-> Text
-> 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
:: Value
-> [Expr]
-> Rendering Text
interpret ctx template =
foldl (<>) T.empty <$> sequenceA (renderTemplate ctx <$> template)
renderTemplate
:: Value
-> Expr
-> Rendering Text
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
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
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
renderTemplate j (CaseLogic (Variable v) patterns) =
evalCaseLogic j (extractValue j v) patterns
renderTemplate _ _ =
_Failure # [ LiquidError "Template rendering critical error!" ]
evalLogic
:: Value
-> Rendering Bool
-> [Expr]
-> 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
evalCaseLogic
:: Value
-> Rendering Value
-> [(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
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) ]
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
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" ]
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 ]
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)" ]
getStringsFromArray
:: Value
-> [Text]
getStringsFromArray v =
v ^.. values . _String
getNumbersFromArray
:: Value
-> [Scientific]
getNumbersFromArray v =
v ^.. values . _Number
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) ]
bothSidesEqual
:: Value
-> Expr
-> Expr
-> 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) ]
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 =
case (j ^? buildLens xz) <|>
(j ^? buildLens (ObjectIndex "event" <| xz)) of
Just v -> _Success # v
Nothing -> _Failure # [ JsonValueNotFound xz ]
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!" ]
applyCellsM
:: Value
-> [Expr]
-> Maybe Text
applyCellsM v [] = v ^? _String
applyCellsM v (c:fcs) = arrayFilterM v c >>= \i -> foldM' applyFilterM i fcs
applyFilterM
:: Text
-> Expr
-> 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
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
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)
renderEachArrayElem
:: [Value]
-> Maybe [Text]
renderEachArrayElem = traverse renderv