{-#LANGUAGE GeneralizedNewtypeDeriving #-}
{-#LANGUAGE FlexibleInstances #-}
{-#LANGUAGE MultiParamTypeClasses #-}
{-#LANGUAGE OverloadedStrings #-}
{-#LANGUAGE ScopedTypeVariables #-}
{-#LANGUAGE FlexibleContexts #-}
module Text.Ginger.Optimizer
( Optimizable (..) )
where
import Text.Ginger.AST
import Text.Ginger.GVal
import Text.Ginger.Run
import Control.Monad.Identity
import Data.Default
import Control.Monad.State (execState, evalState)
import Control.Monad.Writer (Writer, execWriter, tell)
import qualified Data.HashMap.Strict as HashMap
import Data.Maybe (fromMaybe)
import Control.Applicative
import Data.Text (Text)
import qualified Data.Aeson as JSON
import Data.Semigroup as Semigroup
class Optimizable a where
optimize :: a -> a
instance Optimizable (Template a) where
optimize :: Template a -> Template a
optimize = Template a -> Template a
forall a. Template a -> Template a
optimizeTemplate
instance Optimizable (Statement a) where
optimize :: Statement a -> Statement a
optimize = Statement a -> Statement a
forall a. Statement a -> Statement a
optimizeStatement
instance Optimizable (Block a) where
optimize :: Block a -> Block a
optimize = Block a -> Block a
forall a. Block a -> Block a
optimizeBlock
instance Optimizable (Macro a) where
optimize :: Macro a -> Macro a
optimize = Macro a -> Macro a
forall a. Macro a -> Macro a
optimizeMacro
instance Optimizable (Expression a) where
optimize :: Expression a -> Expression a
optimize = Expression a -> Expression a
forall a. Expression a -> Expression a
optimizeExpression
optimizeTemplate :: Template a -> Template a
optimizeTemplate Template a
t =
Template a
t { templateBody :: Statement a
templateBody = Statement a -> Statement a
forall a. Optimizable a => a -> a
optimize (Statement a -> Statement a) -> Statement a -> Statement a
forall a b. (a -> b) -> a -> b
$ Template a -> Statement a
forall a. Template a -> Statement a
templateBody Template a
t
, templateBlocks :: HashMap VarName (Block a)
templateBlocks = Block a -> Block a
forall a. Optimizable a => a -> a
optimize (Block a -> Block a)
-> HashMap VarName (Block a) -> HashMap VarName (Block a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Template a -> HashMap VarName (Block a)
forall a. Template a -> HashMap VarName (Block a)
templateBlocks Template a
t
, templateParent :: Maybe (Template a)
templateParent = Template a -> Template a
forall a. Optimizable a => a -> a
optimize (Template a -> Template a)
-> Maybe (Template a) -> Maybe (Template a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Template a -> Maybe (Template a)
forall a. Template a -> Maybe (Template a)
templateParent Template a
t
}
optimizeStatement :: Statement p -> Statement p
optimizeStatement (MultiS p
p [Statement p]
items) =
case [Statement p] -> [Statement p]
forall a. [Statement a] -> [Statement a]
optimizeStatementList [Statement p]
items of
[] -> p -> Statement p
forall a. a -> Statement a
NullS p
p
[Statement p
x] -> Statement p
x
[Statement p]
xs -> p -> [Statement p] -> Statement p
forall a. a -> [Statement a] -> Statement a
MultiS p
p [Statement p]
xs
optimizeStatement (InterpolationS p
p Expression p
e) =
p -> Expression p -> Statement p
forall a. a -> Expression a -> Statement a
InterpolationS p
p (Expression p -> Expression p
forall a. Optimizable a => a -> a
optimize Expression p
e)
optimizeStatement s :: Statement p
s@(IfS p
p Expression p
c Statement p
t Statement p
f) =
let c' :: Expression p
c' = Expression p -> Expression p
forall a. Optimizable a => a -> a
optimize Expression p
c
t' :: Statement p
t' = Statement p -> Statement p
forall a. Optimizable a => a -> a
optimize Statement p
t
f' :: Statement p
f' = Statement p -> Statement p
forall a. Optimizable a => a -> a
optimize Statement p
f
in case Expression p -> Maybe (GVal Identity)
forall p. Expression p -> Maybe (GVal Identity)
compileTimeEval Expression p
c' of
Just GVal Identity
gv -> case GVal Identity -> Bool
forall (m :: * -> *). GVal m -> Bool
asBoolean GVal Identity
gv of
Bool
True -> Statement p
t
Bool
False -> Statement p
f
Maybe (GVal Identity)
_ -> Statement p
s
optimizeStatement Statement p
s = Statement p
s
optimizeBlock :: Block a -> Block a
optimizeBlock (Block Statement a
b) = Statement a -> Block a
forall a. Statement a -> Block a
Block (Statement a -> Block a) -> Statement a -> Block a
forall a b. (a -> b) -> a -> b
$ Statement a -> Statement a
forall a. Optimizable a => a -> a
optimize Statement a
b
optimizeMacro :: Macro a -> Macro a
optimizeMacro (Macro [VarName]
args Statement a
body) = [VarName] -> Statement a -> Macro a
forall a. [VarName] -> Statement a -> Macro a
Macro [VarName]
args (Statement a -> Statement a
forall a. Optimizable a => a -> a
optimize Statement a
body)
optimizeStatementList :: [Statement a] -> [Statement a]
optimizeStatementList =
[Statement a] -> [Statement a]
forall a. [Statement a] -> [Statement a]
mergeLiterals ([Statement a] -> [Statement a])
-> ([Statement a] -> [Statement a])
-> [Statement a]
-> [Statement a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[Statement a] -> [Statement a]
forall a. [Statement a] -> [Statement a]
cullNulls ([Statement a] -> [Statement a])
-> ([Statement a] -> [Statement a])
-> [Statement a]
-> [Statement a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Statement a -> Statement a) -> [Statement a] -> [Statement a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Statement a -> Statement a
forall a. Optimizable a => a -> a
optimize
cullNulls :: [Statement a] -> [Statement a]
cullNulls :: [Statement a] -> [Statement a]
cullNulls = (Statement a -> Bool) -> [Statement a] -> [Statement a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Statement a -> Bool) -> Statement a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Statement a -> Bool
forall a. Statement a -> Bool
isNullS)
where
isNullS :: Statement a -> Bool
isNullS (NullS a
_) = Bool
True
isNullS Statement a
_ = Bool
False
mergeLiterals :: [Statement a] -> [Statement a]
mergeLiterals :: [Statement a] -> [Statement a]
mergeLiterals [] = []
mergeLiterals [Statement a
x] = [Statement a
x]
mergeLiterals (x :: Statement a
x@(LiteralS a
p1 Html
a):y :: Statement a
y@(LiteralS a
p2 Html
b):[Statement a]
xs) = [Statement a] -> [Statement a]
forall a. [Statement a] -> [Statement a]
mergeLiterals ([Statement a] -> [Statement a]) -> [Statement a] -> [Statement a]
forall a b. (a -> b) -> a -> b
$ (a -> Html -> Statement a
forall a. a -> Html -> Statement a
LiteralS a
p1 (Html -> Statement a) -> Html -> Statement a
forall a b. (a -> b) -> a -> b
$ Html
a Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
b)Statement a -> [Statement a] -> [Statement a]
forall a. a -> [a] -> [a]
:[Statement a]
xs
mergeLiterals (Statement a
x:[Statement a]
xs) = Statement a
xStatement a -> [Statement a] -> [Statement a]
forall a. a -> [a] -> [a]
:[Statement a] -> [Statement a]
forall a. [Statement a] -> [Statement a]
mergeLiterals [Statement a]
xs
data Purity = Pure | Impure
deriving (Int -> Purity -> ShowS
[Purity] -> ShowS
Purity -> String
(Int -> Purity -> ShowS)
-> (Purity -> String) -> ([Purity] -> ShowS) -> Show Purity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Purity] -> ShowS
$cshowList :: [Purity] -> ShowS
show :: Purity -> String
$cshow :: Purity -> String
showsPrec :: Int -> Purity -> ShowS
$cshowsPrec :: Int -> Purity -> ShowS
Show, Purity -> Purity -> Bool
(Purity -> Purity -> Bool)
-> (Purity -> Purity -> Bool) -> Eq Purity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Purity -> Purity -> Bool
$c/= :: Purity -> Purity -> Bool
== :: Purity -> Purity -> Bool
$c== :: Purity -> Purity -> Bool
Eq, Int -> Purity
Purity -> Int
Purity -> [Purity]
Purity -> Purity
Purity -> Purity -> [Purity]
Purity -> Purity -> Purity -> [Purity]
(Purity -> Purity)
-> (Purity -> Purity)
-> (Int -> Purity)
-> (Purity -> Int)
-> (Purity -> [Purity])
-> (Purity -> Purity -> [Purity])
-> (Purity -> Purity -> [Purity])
-> (Purity -> Purity -> Purity -> [Purity])
-> Enum Purity
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Purity -> Purity -> Purity -> [Purity]
$cenumFromThenTo :: Purity -> Purity -> Purity -> [Purity]
enumFromTo :: Purity -> Purity -> [Purity]
$cenumFromTo :: Purity -> Purity -> [Purity]
enumFromThen :: Purity -> Purity -> [Purity]
$cenumFromThen :: Purity -> Purity -> [Purity]
enumFrom :: Purity -> [Purity]
$cenumFrom :: Purity -> [Purity]
fromEnum :: Purity -> Int
$cfromEnum :: Purity -> Int
toEnum :: Int -> Purity
$ctoEnum :: Int -> Purity
pred :: Purity -> Purity
$cpred :: Purity -> Purity
succ :: Purity -> Purity
$csucc :: Purity -> Purity
Enum, ReadPrec [Purity]
ReadPrec Purity
Int -> ReadS Purity
ReadS [Purity]
(Int -> ReadS Purity)
-> ReadS [Purity]
-> ReadPrec Purity
-> ReadPrec [Purity]
-> Read Purity
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Purity]
$creadListPrec :: ReadPrec [Purity]
readPrec :: ReadPrec Purity
$creadPrec :: ReadPrec Purity
readList :: ReadS [Purity]
$creadList :: ReadS [Purity]
readsPrec :: Int -> ReadS Purity
$creadsPrec :: Int -> ReadS Purity
Read, Eq Purity
Eq Purity
-> (Purity -> Purity -> Ordering)
-> (Purity -> Purity -> Bool)
-> (Purity -> Purity -> Bool)
-> (Purity -> Purity -> Bool)
-> (Purity -> Purity -> Bool)
-> (Purity -> Purity -> Purity)
-> (Purity -> Purity -> Purity)
-> Ord Purity
Purity -> Purity -> Bool
Purity -> Purity -> Ordering
Purity -> Purity -> Purity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Purity -> Purity -> Purity
$cmin :: Purity -> Purity -> Purity
max :: Purity -> Purity -> Purity
$cmax :: Purity -> Purity -> Purity
>= :: Purity -> Purity -> Bool
$c>= :: Purity -> Purity -> Bool
> :: Purity -> Purity -> Bool
$c> :: Purity -> Purity -> Bool
<= :: Purity -> Purity -> Bool
$c<= :: Purity -> Purity -> Bool
< :: Purity -> Purity -> Bool
$c< :: Purity -> Purity -> Bool
compare :: Purity -> Purity -> Ordering
$ccompare :: Purity -> Purity -> Ordering
$cp1Ord :: Eq Purity
Ord, Purity
Purity -> Purity -> Bounded Purity
forall a. a -> a -> Bounded a
maxBound :: Purity
$cmaxBound :: Purity
minBound :: Purity
$cminBound :: Purity
Bounded)
bothPure :: Purity -> Purity -> Purity
bothPure :: Purity -> Purity -> Purity
bothPure Purity
Pure Purity
Pure = Purity
Pure
bothPure Purity
_ Purity
_ = Purity
Impure
instance Semigroup.Semigroup Purity where
<> :: Purity -> Purity -> Purity
(<>) = Purity -> Purity -> Purity
bothPure
instance Monoid Purity where
mempty :: Purity
mempty = Purity
Pure
mappend :: Purity -> Purity -> Purity
mappend = Purity -> Purity -> Purity
forall a. Semigroup a => a -> a -> a
(<>)
pureExpression :: Expression a -> Purity
pureExpression :: Expression a -> Purity
pureExpression (StringLiteralE a
p VarName
_) = Purity
Pure
pureExpression (NumberLiteralE a
p Scientific
_) = Purity
Pure
pureExpression (NullLiteralE a
p) = Purity
Pure
pureExpression (ListE a
p [Expression a]
items) = [Purity] -> Purity
forall a. Monoid a => [a] -> a
mconcat ([Purity] -> Purity)
-> ([Expression a] -> [Purity]) -> [Expression a] -> Purity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expression a -> Purity) -> [Expression a] -> [Purity]
forall a b. (a -> b) -> [a] -> [b]
map Expression a -> Purity
forall a. Expression a -> Purity
pureExpression ([Expression a] -> Purity) -> [Expression a] -> Purity
forall a b. (a -> b) -> a -> b
$ [Expression a]
items
pureExpression (ObjectE a
p [(Expression a, Expression a)]
pairs) =
[Purity] -> Purity
forall a. Monoid a => [a] -> a
mconcat [ Purity -> Purity -> Purity
bothPure (Expression a -> Purity
forall a. Expression a -> Purity
pureExpression Expression a
k) (Expression a -> Purity
forall a. Expression a -> Purity
pureExpression Expression a
v)
| (Expression a
k, Expression a
v) <- [(Expression a, Expression a)]
pairs
]
pureExpression (LambdaE a
_ [VarName]
args Expression a
body) = Expression a -> Purity
forall a. Expression a -> Purity
pureExpression Expression a
body
pureExpression (TernaryE a
_ Expression a
cond Expression a
yes Expression a
no) =
Expression a -> Purity
forall a. Expression a -> Purity
pureExpression Expression a
cond Purity -> Purity -> Purity
forall a. Semigroup a => a -> a -> a
<> Expression a -> Purity
forall a. Expression a -> Purity
pureExpression Expression a
yes Purity -> Purity -> Purity
forall a. Semigroup a => a -> a -> a
<> Expression a -> Purity
forall a. Expression a -> Purity
pureExpression Expression a
no
pureExpression (MemberLookupE a
_ Expression a
k Expression a
v) =
Expression a -> Purity
forall a. Expression a -> Purity
pureExpression Expression a
k Purity -> Purity -> Purity
forall a. Semigroup a => a -> a -> a
<> Expression a -> Purity
forall a. Expression a -> Purity
pureExpression Expression a
v
pureExpression (CallE a
_ (VarE a
_ VarName
name) [(Maybe VarName, Expression a)]
args) =
VarName -> Purity
pureFunction VarName
name Purity -> Purity -> Purity
forall a. Semigroup a => a -> a -> a
<> [Purity] -> Purity
forall a. Monoid a => [a] -> a
mconcat (((Maybe VarName, Expression a) -> Purity)
-> [(Maybe VarName, Expression a)] -> [Purity]
forall a b. (a -> b) -> [a] -> [b]
map (Expression a -> Purity
forall a. Expression a -> Purity
pureExpression (Expression a -> Purity)
-> ((Maybe VarName, Expression a) -> Expression a)
-> (Maybe VarName, Expression a)
-> Purity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe VarName, Expression a) -> Expression a
forall a b. (a, b) -> b
snd) [(Maybe VarName, Expression a)]
args)
pureExpression Expression a
_ = Purity
Impure
pureFunction :: VarName -> Purity
pureFunction VarName
name
| VarName
name VarName -> [VarName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [VarName]
pureFunctionNames = Purity
Pure
| Bool
otherwise = Purity
Impure
pureFunctionNames :: [VarName]
pureFunctionNames =
[ VarName
"raw"
, VarName
"abs"
, VarName
"any"
, VarName
"all"
, VarName
"capitalize"
, VarName
"ceil"
, VarName
"center"
, VarName
"concat"
, VarName
"contains"
, VarName
"default"
, VarName
"dictsort"
, VarName
"difference"
, VarName
"e"
, VarName
"equals"
, VarName
"escape"
, VarName
"filesizeformat"
, VarName
"filter"
, VarName
"floor"
, VarName
"format"
, VarName
"greater"
, VarName
"greaterEquals"
, VarName
"int"
, VarName
"int_ratio"
, VarName
"iterable"
, VarName
"length"
, VarName
"less"
, VarName
"lessEquals"
, VarName
"modulo"
, VarName
"nequals"
, VarName
"num"
, VarName
"product"
, VarName
"ratio"
, VarName
"replace"
, VarName
"round"
, VarName
"show"
, VarName
"slice"
, VarName
"sort"
, VarName
"str"
, VarName
"sum"
, VarName
"truncate"
, VarName
"urlencode"
]
optimizeExpression :: Expression a -> Expression a
optimizeExpression :: Expression a -> Expression a
optimizeExpression = Expression a -> Expression a
forall a. Expression a -> Expression a
preEvalExpression (Expression a -> Expression a)
-> (Expression a -> Expression a) -> Expression a -> Expression a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expression a -> Expression a
forall a. Expression a -> Expression a
expandConstExpressions (Expression a -> Expression a)
-> (Expression a -> Expression a) -> Expression a -> Expression a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expression a -> Expression a
forall a. Expression a -> Expression a
optimizeSubexpressions
preEvalExpression :: Expression a -> Expression a
preEvalExpression :: Expression a -> Expression a
preEvalExpression Expression a
e = Expression a -> Maybe (Expression a) -> Expression a
forall a. a -> Maybe a -> a
fromMaybe Expression a
e (Maybe (Expression a) -> Expression a)
-> Maybe (Expression a) -> Expression a
forall a b. (a -> b) -> a -> b
$ do
Expression a -> Maybe (GVal Identity)
forall p. Expression p -> Maybe (GVal Identity)
compileTimeEval Expression a
e Maybe (GVal Identity)
-> (GVal Identity -> Maybe (Expression a)) -> Maybe (Expression a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> GVal Identity -> Maybe (Expression a)
forall a (m :: * -> *). a -> GVal m -> Maybe (Expression a)
gvalToExpression (Expression a -> a
forall (f :: * -> *) p. Annotated f => f p -> p
annotation Expression a
e)
gvalToExpression :: forall a m
. a -> GVal m -> Maybe (Expression a)
gvalToExpression :: a -> GVal m -> Maybe (Expression a)
gvalToExpression a
p GVal m
g =
(Value -> Maybe (Expression a)
jsonLiteral (Value -> Maybe (Expression a))
-> Maybe Value -> Maybe (Expression a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GVal m -> Maybe Value
forall (m :: * -> *). GVal m -> Maybe Value
asJSON GVal m
g) Maybe (Expression a)
-> Maybe (Expression a) -> Maybe (Expression a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(a -> [(Expression a, Expression a)] -> Expression a
forall a. a -> [(Expression a, Expression a)] -> Expression a
ObjectE a
p ([(Expression a, Expression a)] -> Expression a)
-> Maybe [(Expression a, Expression a)] -> Maybe (Expression a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([(VarName, GVal m)] -> Maybe [(Expression a, Expression a)]
recurseDict ([(VarName, GVal m)] -> Maybe [(Expression a, Expression a)])
-> Maybe [(VarName, GVal m)]
-> Maybe [(Expression a, Expression a)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GVal m -> Maybe [(VarName, GVal m)]
forall (m :: * -> *). GVal m -> Maybe [(VarName, GVal m)]
asDictItems GVal m
g)) Maybe (Expression a)
-> Maybe (Expression a) -> Maybe (Expression a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(a -> [Expression a] -> Expression a
forall a. a -> [Expression a] -> Expression a
ListE a
p ([Expression a] -> Expression a)
-> Maybe [Expression a] -> Maybe (Expression a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((GVal m -> Maybe (Expression a))
-> [GVal m] -> Maybe [Expression a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (a -> GVal m -> Maybe (Expression a)
forall a (m :: * -> *). a -> GVal m -> Maybe (Expression a)
gvalToExpression a
p) ([GVal m] -> Maybe [Expression a])
-> Maybe [GVal m] -> Maybe [Expression a]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GVal m -> Maybe [GVal m]
forall (m :: * -> *). GVal m -> Maybe [GVal m]
asList GVal m
g))
where
jsonLiteral :: JSON.Value -> Maybe (Expression a)
jsonLiteral :: Value -> Maybe (Expression a)
jsonLiteral (JSON.Bool Bool
b) = Expression a -> Maybe (Expression a)
forall a. a -> Maybe a
Just (a -> Bool -> Expression a
forall a. a -> Bool -> Expression a
BoolLiteralE a
p Bool
b)
jsonLiteral (JSON.String VarName
s) = Expression a -> Maybe (Expression a)
forall a. a -> Maybe a
Just (a -> VarName -> Expression a
forall a. a -> VarName -> Expression a
StringLiteralE a
p VarName
s)
jsonLiteral (Value
JSON.Null) = Expression a -> Maybe (Expression a)
forall a. a -> Maybe a
Just (a -> Expression a
forall a. a -> Expression a
NullLiteralE a
p)
jsonLiteral (JSON.Number Scientific
n) = Expression a -> Maybe (Expression a)
forall a. a -> Maybe a
Just (a -> Scientific -> Expression a
forall a. a -> Scientific -> Expression a
NumberLiteralE a
p Scientific
n)
jsonLiteral Value
_ = Maybe (Expression a)
forall a. Maybe a
Nothing
recurseDict :: [(Text, GVal m)] -> Maybe [(Expression a, Expression a)]
recurseDict :: [(VarName, GVal m)] -> Maybe [(Expression a, Expression a)]
recurseDict = ((VarName, GVal m) -> Maybe (Expression a, Expression a))
-> [(VarName, GVal m)] -> Maybe [(Expression a, Expression a)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (((VarName, GVal m) -> Maybe (Expression a, Expression a))
-> [(VarName, GVal m)] -> Maybe [(Expression a, Expression a)])
-> ((VarName, GVal m) -> Maybe (Expression a, Expression a))
-> [(VarName, GVal m)]
-> Maybe [(Expression a, Expression a)]
forall a b. (a -> b) -> a -> b
$ \(VarName
key, GVal m
val) -> do
let key' :: Expression a
key' = a -> VarName -> Expression a
forall a. a -> VarName -> Expression a
StringLiteralE a
p VarName
key
Expression a
val' <- a -> GVal m -> Maybe (Expression a)
forall a (m :: * -> *). a -> GVal m -> Maybe (Expression a)
gvalToExpression a
p GVal m
val
(Expression a, Expression a) -> Maybe (Expression a, Expression a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression a
key', Expression a
val')
expandConstExpressions :: Expression a -> Expression a
expandConstExpressions :: Expression a -> Expression a
expandConstExpressions e :: Expression a
e@(TernaryE a
p Expression a
c Expression a
t Expression a
f) =
case Expression a -> Maybe (GVal Identity)
forall p. Expression p -> Maybe (GVal Identity)
compileTimeEval Expression a
c of
Just GVal Identity
gv -> case GVal Identity -> Bool
forall (m :: * -> *). GVal m -> Bool
asBoolean GVal Identity
gv of
Bool
True -> Expression a -> Expression a
forall a. Expression a -> Expression a
optimizeExpression Expression a
t
Bool
False -> Expression a -> Expression a
forall a. Expression a -> Expression a
optimizeExpression Expression a
f
Maybe (GVal Identity)
_ -> Expression a
e
expandConstExpressions Expression a
e = Expression a
e
optimizeSubexpressions :: Expression a -> Expression a
optimizeSubexpressions (ListE a
p [Expression a]
xs) = a -> [Expression a] -> Expression a
forall a. a -> [Expression a] -> Expression a
ListE a
p ((Expression a -> Expression a) -> [Expression a] -> [Expression a]
forall a b. (a -> b) -> [a] -> [b]
map Expression a -> Expression a
forall a. Optimizable a => a -> a
optimize [Expression a]
xs)
optimizeSubexpressions (ObjectE a
p [(Expression a, Expression a)]
xs) = a -> [(Expression a, Expression a)] -> Expression a
forall a. a -> [(Expression a, Expression a)] -> Expression a
ObjectE a
p [ (Expression a -> Expression a
forall a. Optimizable a => a -> a
optimize Expression a
k, Expression a -> Expression a
forall a. Optimizable a => a -> a
optimize Expression a
v) | (Expression a
k, Expression a
v) <- [(Expression a, Expression a)]
xs ]
optimizeSubexpressions (MemberLookupE a
p Expression a
k Expression a
m) = a -> Expression a -> Expression a -> Expression a
forall a. a -> Expression a -> Expression a -> Expression a
MemberLookupE a
p (Expression a -> Expression a
forall a. Optimizable a => a -> a
optimize Expression a
k) (Expression a -> Expression a
forall a. Optimizable a => a -> a
optimize Expression a
m)
optimizeSubexpressions (CallE a
p Expression a
f [(Maybe VarName, Expression a)]
args) = a
-> Expression a -> [(Maybe VarName, Expression a)] -> Expression a
forall a.
a
-> Expression a -> [(Maybe VarName, Expression a)] -> Expression a
CallE a
p (Expression a -> Expression a
forall a. Optimizable a => a -> a
optimize Expression a
f) [(Maybe VarName
n, Expression a -> Expression a
forall a. Optimizable a => a -> a
optimize Expression a
v) | (Maybe VarName
n, Expression a
v) <- [(Maybe VarName, Expression a)]
args]
optimizeSubexpressions (LambdaE a
p [VarName]
args Expression a
body) = a -> [VarName] -> Expression a -> Expression a
forall a. a -> [VarName] -> Expression a -> Expression a
LambdaE a
p [VarName]
args (Expression a -> Expression a
forall a. Optimizable a => a -> a
optimize Expression a
body)
optimizeSubexpressions (TernaryE a
p Expression a
c Expression a
t Expression a
f) = a -> Expression a -> Expression a -> Expression a -> Expression a
forall a.
a -> Expression a -> Expression a -> Expression a -> Expression a
TernaryE a
p (Expression a -> Expression a
forall a. Optimizable a => a -> a
optimize Expression a
c) (Expression a -> Expression a
forall a. Optimizable a => a -> a
optimize Expression a
t) (Expression a -> Expression a
forall a. Optimizable a => a -> a
optimize Expression a
f)
optimizeSubexpressions Expression a
e = Expression a
e
isConstExpression :: Expression a -> Bool
isConstExpression :: Expression a -> Bool
isConstExpression (StringLiteralE a
p VarName
_) = Bool
True
isConstExpression (BoolLiteralE a
p Bool
_) = Bool
True
isConstExpression (NullLiteralE a
p) = Bool
True
isConstExpression (ListE a
p [Expression a]
xs) = (Expression a -> Bool) -> [Expression a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Expression a -> Bool
forall a. Expression a -> Bool
isConstExpression [Expression a]
xs
isConstExpression (ObjectE a
p [(Expression a, Expression a)]
xs) = ((Expression a, Expression a) -> Bool)
-> [(Expression a, Expression a)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(Expression a
k,Expression a
v) -> Expression a -> Bool
forall a. Expression a -> Bool
isConstExpression Expression a
k Bool -> Bool -> Bool
&& Expression a -> Bool
forall a. Expression a -> Bool
isConstExpression Expression a
v) [(Expression a, Expression a)]
xs
isConstExpression (MemberLookupE a
p Expression a
k Expression a
m) = Expression a -> Bool
forall a. Expression a -> Bool
isConstExpression Expression a
k Bool -> Bool -> Bool
&& Expression a -> Bool
forall a. Expression a -> Bool
isConstExpression Expression a
m
isConstExpression Expression a
e = Bool
False
compileTimeEval :: Expression p -> Maybe (GVal Identity)
compileTimeEval :: Expression p -> Maybe (GVal Identity)
compileTimeEval (StringLiteralE p
p VarName
s) = GVal Identity -> Maybe (GVal Identity)
forall a. a -> Maybe a
Just (GVal Identity -> Maybe (GVal Identity))
-> (VarName -> GVal Identity) -> VarName -> Maybe (GVal Identity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarName -> GVal Identity
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal (VarName -> Maybe (GVal Identity))
-> VarName -> Maybe (GVal Identity)
forall a b. (a -> b) -> a -> b
$ VarName
s
compileTimeEval (NumberLiteralE p
p Scientific
n) = GVal Identity -> Maybe (GVal Identity)
forall a. a -> Maybe a
Just (GVal Identity -> Maybe (GVal Identity))
-> (Scientific -> GVal Identity)
-> Scientific
-> Maybe (GVal Identity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> GVal Identity
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal (Scientific -> Maybe (GVal Identity))
-> Scientific -> Maybe (GVal Identity)
forall a b. (a -> b) -> a -> b
$ Scientific
n
compileTimeEval (BoolLiteralE p
p Bool
b) = GVal Identity -> Maybe (GVal Identity)
forall a. a -> Maybe a
Just (GVal Identity -> Maybe (GVal Identity))
-> (Bool -> GVal Identity) -> Bool -> Maybe (GVal Identity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> GVal Identity
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal (Bool -> Maybe (GVal Identity)) -> Bool -> Maybe (GVal Identity)
forall a b. (a -> b) -> a -> b
$ Bool
b
compileTimeEval (NullLiteralE p
p) = GVal Identity -> Maybe (GVal Identity)
forall a. a -> Maybe a
Just GVal Identity
forall a. Default a => a
def
compileTimeEval Expression p
e = case Expression p -> Purity
forall a. Expression a -> Purity
pureExpression Expression p
e of
Purity
Pure -> do
let tpl :: Template ()
tpl =
Statement ()
-> HashMap VarName (Block ()) -> Maybe (Template ()) -> Template ()
forall a.
Statement a
-> HashMap VarName (Block a) -> Maybe (Template a) -> Template a
Template
(() -> Expression () -> Statement ()
forall a. a -> Expression a -> Statement a
InterpolationS () ((p -> ()) -> Expression p -> Expression ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> p -> ()
forall a b. a -> b -> a
const ()) Expression p
e))
HashMap VarName (Block ())
forall k v. HashMap k v
HashMap.empty
Maybe (Template ())
forall a. Maybe a
Nothing
GVal Identity -> Maybe (GVal Identity)
forall a. a -> Maybe a
Just (GVal Identity -> Maybe (GVal Identity))
-> (Template () -> GVal Identity)
-> Template ()
-> Maybe (GVal Identity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Collected -> GVal Identity
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal (Collected -> GVal Identity)
-> (Template () -> Collected) -> Template () -> GVal Identity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Template () -> Collected
runCT (Template () -> Maybe (GVal Identity))
-> Template () -> Maybe (GVal Identity)
forall a b. (a -> b) -> a -> b
$ Template ()
tpl
Purity
Impure -> Maybe (GVal Identity)
forall a. Maybe a
Nothing
newtype Collected = Collected [GVal Identity]
deriving (b -> Collected -> Collected
NonEmpty Collected -> Collected
Collected -> Collected -> Collected
(Collected -> Collected -> Collected)
-> (NonEmpty Collected -> Collected)
-> (forall b. Integral b => b -> Collected -> Collected)
-> Semigroup Collected
forall b. Integral b => b -> Collected -> Collected
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Collected -> Collected
$cstimes :: forall b. Integral b => b -> Collected -> Collected
sconcat :: NonEmpty Collected -> Collected
$csconcat :: NonEmpty Collected -> Collected
<> :: Collected -> Collected -> Collected
$c<> :: Collected -> Collected -> Collected
Semigroup.Semigroup, Semigroup Collected
Collected
Semigroup Collected
-> Collected
-> (Collected -> Collected -> Collected)
-> ([Collected] -> Collected)
-> Monoid Collected
[Collected] -> Collected
Collected -> Collected -> Collected
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Collected] -> Collected
$cmconcat :: [Collected] -> Collected
mappend :: Collected -> Collected -> Collected
$cmappend :: Collected -> Collected -> Collected
mempty :: Collected
$cmempty :: Collected
$cp1Monoid :: Semigroup Collected
Monoid)
instance ToGVal m Collected where
toGVal :: Collected -> GVal m
toGVal = Collected -> GVal m
forall (m :: * -> *). Collected -> GVal m
collectedToGVal
collectedToGVal :: Collected -> GVal m
collectedToGVal :: Collected -> GVal m
collectedToGVal (Collected []) = GVal m
forall a. Default a => a
def
collectedToGVal (Collected (GVal Identity
x:[GVal Identity]
_)) = GVal Identity -> GVal m
forall (m :: * -> *) (n :: * -> *). GVal m -> GVal n
marshalGVal GVal Identity
x
runCT :: Template () -> Collected
runCT :: Template () -> Collected
runCT = GingerContext () (Writer Collected) Collected
-> Template () -> Collected
forall p h.
(ToGVal (Run p (Writer h) h) h, ToGVal (Run p (Writer h) h) p,
Monoid h) =>
GingerContext p (Writer h) h -> Template p -> h
runGinger GingerContext () (Writer Collected) Collected
ctContext
ctContext :: GingerContext () (Writer Collected) Collected
ctContext :: GingerContext () (Writer Collected) Collected
ctContext = (VarName -> GVal (Run () (Writer Collected) Collected))
-> (GVal (Run () (Writer Collected) Collected) -> Collected)
-> Maybe (Newlines Collected)
-> GingerContext () (Writer Collected) Collected
forall h p.
Monoid h =>
(VarName -> GVal (Run p (Writer h) h))
-> (GVal (Run p (Writer h) h) -> h)
-> Maybe (Newlines h)
-> GingerContext p (Writer h) h
makeContext' VarName -> GVal (Run () (Writer Collected) Collected)
forall (m :: * -> *). VarName -> GVal m
ctLookup GVal (Run () (Writer Collected) Collected) -> Collected
forall (m :: * -> *). GVal m -> Collected
ctEncode Maybe (Newlines Collected)
forall a. Maybe a
Nothing
ctLookup :: VarName -> GVal m
ctLookup :: VarName -> GVal m
ctLookup = GVal m -> VarName -> GVal m
forall a b. a -> b -> a
const GVal m
forall a. Default a => a
def
ctEncode :: GVal m -> Collected
ctEncode :: GVal m -> Collected
ctEncode GVal m
g = [GVal Identity] -> Collected
Collected [GVal m -> GVal Identity
forall (m :: * -> *) (n :: * -> *). GVal m -> GVal n
marshalGVal GVal m
g]