{-#LANGUAGE GeneralizedNewtypeDeriving #-}
{-#LANGUAGE FlexibleInstances #-}
{-#LANGUAGE MultiParamTypeClasses #-}
{-#LANGUAGE OverloadedStrings #-}
{-#LANGUAGE ScopedTypeVariables #-}
{-#LANGUAGE FlexibleContexts #-}
-- | A syntax tree optimizer
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 = forall a. Template a -> Template a
optimizeTemplate

instance Optimizable (Statement a) where
    optimize :: Statement a -> Statement a
optimize = forall a. Statement a -> Statement a
optimizeStatement

instance Optimizable (Block a) where
    optimize :: Block a -> Block a
optimize = forall a. Block a -> Block a
optimizeBlock

instance Optimizable (Macro a) where
    optimize :: Macro a -> Macro a
optimize = forall a. Macro a -> Macro a
optimizeMacro

instance Optimizable (Expression a) where
    optimize :: Expression a -> Expression a
optimize = forall a. Expression a -> Expression a
optimizeExpression

optimizeTemplate :: Template a -> Template a
optimizeTemplate Template a
t =
    Template a
t { templateBody :: Statement a
templateBody = forall a. Optimizable a => a -> a
optimize forall a b. (a -> b) -> a -> b
$ forall a. Template a -> Statement a
templateBody Template a
t
      , templateBlocks :: HashMap VarName (Block a)
templateBlocks = forall a. Optimizable a => a -> a
optimize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Template a -> HashMap VarName (Block a)
templateBlocks Template a
t
      , templateParent :: Maybe (Template a)
templateParent = forall a. Optimizable a => a -> a
optimize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Template a -> Maybe (Template a)
templateParent Template a
t
      }

--    = MultiS p [Statement a] -- ^ A sequence of multiple statements
--    | ScopedS p Statement a -- ^ Run wrapped statement in a local scope
--    | LiteralS p Html -- ^ Literal output (anything outside of any tag)
--    | InterpolationS p Expression a -- ^ {{ expression }}
--    | IfS p Expression a Statement a Statement a -- ^ {% if expression %}statement{% else %}statement{% endif %}
--    | ForS p (Maybe VarName) VarName Expression a Statement a -- ^ {% for index, varname in expression %}statement{% endfor %}
--    | SetVarS p VarName Expression a -- ^ {% set varname = expr %}
--    | DefMacroS p VarName Macro a -- ^ {% macro varname %}statements{% endmacro %}
--    | BlockRefS p VarName
--    | PreprocessedIncludeS p Template a -- ^ {% include "template" %}
--    | NullS p -- ^ The do-nothing statement (NOP)

optimizeStatement :: Statement p -> Statement p
optimizeStatement (MultiS p
p [Statement p]
items) =
    case forall {a}. [Statement a] -> [Statement a]
optimizeStatementList [Statement p]
items of
        [] -> forall a. a -> Statement a
NullS p
p
        [Statement p
x] -> Statement p
x
        [Statement p]
xs -> forall a. a -> [Statement a] -> Statement a
MultiS p
p [Statement p]
xs
optimizeStatement (InterpolationS p
p Expression p
e) =
    forall a. a -> Expression a -> Statement a
InterpolationS p
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' = forall a. Optimizable a => a -> a
optimize Expression p
c
        t' :: Statement p
t' = forall a. Optimizable a => a -> a
optimize Statement p
t
        f' :: Statement p
f' = forall a. Optimizable a => a -> a
optimize Statement p
f
    in case forall p. Expression p -> Maybe (GVal Identity)
compileTimeEval Expression p
c' of
        Just GVal Identity
gv -> case 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) = forall a. Statement a -> Block a
Block forall a b. (a -> b) -> a -> b
$ forall a. Optimizable a => a -> a
optimize Statement a
b

optimizeMacro :: Macro a -> Macro a
optimizeMacro (Macro [VarName]
args Statement a
body) = forall a. [VarName] -> Statement a -> Macro a
Macro [VarName]
args (forall a. Optimizable a => a -> a
optimize Statement a
body)

optimizeStatementList :: [Statement a] -> [Statement a]
optimizeStatementList =
    forall {a}. [Statement a] -> [Statement a]
mergeLiterals forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    forall {a}. [Statement a] -> [Statement a]
cullNulls forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Optimizable a => a -> a
optimize

cullNulls :: [Statement a] -> [Statement a]
cullNulls :: forall {a}. [Statement a] -> [Statement a]
cullNulls = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall {a}. [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) = forall {a}. [Statement a] -> [Statement a]
mergeLiterals forall a b. (a -> b) -> a -> b
$ (forall a. a -> Html -> Statement a
LiteralS a
p1 forall a b. (a -> b) -> a -> b
$ Html
a forall a. Semigroup a => a -> a -> a
<> Html
b)forall a. a -> [a] -> [a]
:[Statement a]
xs
mergeLiterals (Statement a
x:[Statement a]
xs) = Statement a
xforall a. a -> [a] -> [a]
:forall {a}. [Statement a] -> [Statement a]
mergeLiterals [Statement a]
xs


-- data Expression a
--     = StringLiteralE p Text -- ^ String literal expression: "foobar"
--     | NumberLiteralE p Scientific -- ^ Numeric literal expression: 123.4
--     | BoolLiteralE p Bool -- ^ Boolean literal expression: true
--     | NullLiteralE p -- ^ Literal null
--     | VarE p VarName -- ^ Variable reference: foobar
--     | ListE p [Expression a] -- ^ List construct: [ expr, expr, expr ]
--     | ObjectE p [(Expression a, Expression a)] -- ^ Object construct: { expr: expr, expr: expr, ... }
--     | MemberLookupE p Expression a Expression a -- ^ foo[bar] (also dot access)
--     | CallE p Expression a [(Maybe Text, Expression a)] -- ^ foo(bar=baz, quux)
--     | LambdaE p [Text] Expression a -- ^ (foo, bar) -> expr
--     | TernaryE p Expression a Expression a Expression a -- ^ expr ? expr : expr
--     deriving (Show)

data Purity = Pure | Impure
    deriving (Int -> Purity -> ShowS
[Purity] -> ShowS
Purity -> String
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
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]
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]
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
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
Ord, 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 = forall a. Semigroup a => a -> a -> a
(<>)

pureExpression :: Expression a -> Purity
pureExpression :: forall a. 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) = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Expression a -> Purity
pureExpression forall a b. (a -> b) -> a -> b
$ [Expression a]
items
pureExpression (ObjectE a
p [(Expression a, Expression a)]
pairs) =
    forall a. Monoid a => [a] -> a
mconcat [ Purity -> Purity -> Purity
bothPure (forall a. Expression a -> Purity
pureExpression Expression a
k) (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) = forall a. Expression a -> Purity
pureExpression Expression a
body
pureExpression (TernaryE a
_ Expression a
cond Expression a
yes Expression a
no) =
    forall a. Expression a -> Purity
pureExpression Expression a
cond forall a. Semigroup a => a -> a -> a
<> forall a. Expression a -> Purity
pureExpression Expression a
yes forall a. Semigroup a => a -> a -> a
<> forall a. Expression a -> Purity
pureExpression Expression a
no
pureExpression (MemberLookupE a
_ Expression a
k Expression a
v) =
    forall a. Expression a -> Purity
pureExpression Expression a
k forall a. Semigroup a => a -> a -> a
<> 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 forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Expression a -> Purity
pureExpression forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 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 :: forall a. Expression a -> Expression a
optimizeExpression = forall a. Expression a -> Expression a
preEvalExpression forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Expression a -> Expression a
expandConstExpressions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Expression a -> Expression a
optimizeSubexpressions

preEvalExpression :: Expression a -> Expression a
preEvalExpression :: forall a. Expression a -> Expression a
preEvalExpression Expression a
e = forall a. a -> Maybe a -> a
fromMaybe Expression a
e forall a b. (a -> b) -> a -> b
$ do
    forall p. Expression p -> Maybe (GVal Identity)
compileTimeEval Expression a
e forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a (m :: * -> *). a -> GVal m -> Maybe (Expression a)
gvalToExpression (forall (f :: * -> *) p. Annotated f => f p -> p
annotation Expression a
e)

gvalToExpression :: forall a m
                  . a -> GVal m -> Maybe (Expression a)
gvalToExpression :: forall a (m :: * -> *). a -> GVal m -> Maybe (Expression a)
gvalToExpression a
p GVal m
g =
    (Value -> Maybe (Expression a)
jsonLiteral forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). GVal m -> Maybe Value
asJSON GVal m
g) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    (forall a. a -> [(Expression a, Expression a)] -> Expression a
ObjectE a
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([(VarName, GVal m)] -> Maybe [(Expression a, Expression a)]
recurseDict forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). GVal m -> Maybe [(VarName, GVal m)]
asDictItems GVal m
g)) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    (forall a. a -> [Expression a] -> Expression a
ListE a
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a (m :: * -> *). a -> GVal m -> Maybe (Expression a)
gvalToExpression a
p) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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) = forall a. a -> Maybe a
Just (forall a. a -> Bool -> Expression a
BoolLiteralE a
p Bool
b)
        jsonLiteral (JSON.String VarName
s) = forall a. a -> Maybe a
Just (forall a. a -> VarName -> Expression a
StringLiteralE a
p VarName
s)
        jsonLiteral (Value
JSON.Null) = forall a. a -> Maybe a
Just (forall a. a -> Expression a
NullLiteralE a
p)
        jsonLiteral (JSON.Number Scientific
n) = forall a. a -> Maybe a
Just (forall a. a -> Scientific -> Expression a
NumberLiteralE a
p Scientific
n)
        jsonLiteral Value
_ = forall a. Maybe a
Nothing
        recurseDict :: [(Text, GVal m)] -> Maybe [(Expression a, Expression a)]
        recurseDict :: [(VarName, GVal m)] -> Maybe [(Expression a, Expression a)]
recurseDict = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a b. (a -> b) -> a -> b
$ \(VarName
key, GVal m
val) -> do
            let key' :: Expression a
key' = forall a. a -> VarName -> Expression a
StringLiteralE a
p VarName
key
            Expression a
val' <- forall a (m :: * -> *). a -> GVal m -> Maybe (Expression a)
gvalToExpression a
p GVal m
val
            forall (m :: * -> *) a. Monad m => a -> m a
return (Expression a
key', Expression a
val')


expandConstExpressions :: Expression a -> Expression a
expandConstExpressions :: forall a. Expression a -> Expression a
expandConstExpressions e :: Expression a
e@(TernaryE a
p Expression a
c Expression a
t Expression a
f) =
    case forall p. Expression p -> Maybe (GVal Identity)
compileTimeEval Expression a
c of
        Just GVal Identity
gv -> case forall (m :: * -> *). GVal m -> Bool
asBoolean GVal Identity
gv of
            Bool
True -> forall a. Expression a -> Expression a
optimizeExpression Expression a
t
            Bool
False -> 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) = forall a. a -> [Expression a] -> Expression a
ListE a
p (forall a b. (a -> b) -> [a] -> [b]
map forall a. Optimizable a => a -> a
optimize [Expression a]
xs)
optimizeSubexpressions (ObjectE a
p [(Expression a, Expression a)]
xs) = forall a. a -> [(Expression a, Expression a)] -> Expression a
ObjectE a
p [ (forall a. Optimizable a => a -> a
optimize Expression a
k, 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) = forall a. a -> Expression a -> Expression a -> Expression a
MemberLookupE a
p (forall a. Optimizable a => a -> a
optimize Expression a
k) (forall a. Optimizable a => a -> a
optimize Expression a
m)
optimizeSubexpressions (CallE a
p Expression a
f [(Maybe VarName, Expression a)]
args) = forall a.
a
-> Expression a -> [(Maybe VarName, Expression a)] -> Expression a
CallE a
p (forall a. Optimizable a => a -> a
optimize Expression a
f) [(Maybe VarName
n, 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) = forall a. a -> [VarName] -> Expression a -> Expression a
LambdaE a
p [VarName]
args (forall a. Optimizable a => a -> a
optimize Expression a
body)
optimizeSubexpressions (TernaryE a
p Expression a
c Expression a
t Expression a
f) = forall a.
a -> Expression a -> Expression a -> Expression a -> Expression a
TernaryE a
p (forall a. Optimizable a => a -> a
optimize Expression a
c) (forall a. Optimizable a => a -> a
optimize Expression a
t) (forall a. Optimizable a => a -> a
optimize Expression a
f)
optimizeSubexpressions Expression a
e = Expression a
e

isConstExpression :: Expression a -> Bool
isConstExpression :: forall a. 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) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall a. Expression a -> Bool
isConstExpression [Expression a]
xs
isConstExpression (ObjectE a
p [(Expression a, Expression a)]
xs) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(Expression a
k,Expression a
v) -> forall a. Expression a -> Bool
isConstExpression Expression a
k Bool -> Bool -> 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) = forall a. Expression a -> Bool
isConstExpression Expression a
k Bool -> Bool -> Bool
&& forall a. Expression a -> Bool
isConstExpression Expression a
m
isConstExpression Expression a
e = Bool
False

compileTimeEval :: Expression p -> Maybe (GVal Identity)
compileTimeEval :: forall p. Expression p -> Maybe (GVal Identity)
compileTimeEval (StringLiteralE p
p VarName
s) = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal forall a b. (a -> b) -> a -> b
$ VarName
s
compileTimeEval (NumberLiteralE p
p Scientific
n) = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal forall a b. (a -> b) -> a -> b
$ Scientific
n
compileTimeEval (BoolLiteralE p
p Bool
b) = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal forall a b. (a -> b) -> a -> b
$ Bool
b
compileTimeEval (NullLiteralE p
p) = forall a. a -> Maybe a
Just forall a. Default a => a
def
compileTimeEval Expression p
e = case forall a. Expression a -> Purity
pureExpression Expression p
e of
    Purity
Pure -> do
        let tpl :: Template ()
tpl =
              -- We're erasing source code positions here,
              -- because we don't have any use for them anyway.
              forall a.
Statement a
-> HashMap VarName (Block a) -> Maybe (Template a) -> Template a
Template
                  (forall a. a -> Expression a -> Statement a
InterpolationS () (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const ()) Expression p
e))
                  forall k v. HashMap k v
HashMap.empty
                  forall a. Maybe a
Nothing
        forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Template () -> Collected
runCT forall a b. (a -> b) -> a -> b
$ Template ()
tpl
    Purity
Impure -> forall a. Maybe a
Nothing

newtype Collected = Collected [GVal Identity]
    deriving (NonEmpty Collected -> Collected
Collected -> Collected -> 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 :: forall b. Integral b => 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
[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
Monoid)

instance ToGVal m Collected where
    toGVal :: Collected -> GVal m
toGVal = forall (m :: * -> *). Collected -> GVal m
collectedToGVal

collectedToGVal :: Collected -> GVal m
collectedToGVal :: forall (m :: * -> *). Collected -> GVal m
collectedToGVal (Collected []) = forall a. Default a => a
def
collectedToGVal (Collected (GVal Identity
x:[GVal Identity]
_)) = forall (m :: * -> *) (n :: * -> *). GVal m -> GVal n
marshalGVal GVal Identity
x

runCT :: Template () -> Collected
runCT :: Template () -> Collected
runCT = 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 = 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' forall (m :: * -> *). VarName -> GVal m
ctLookup forall (m :: * -> *). GVal m -> Collected
ctEncode forall a. Maybe a
Nothing

ctLookup :: VarName -> GVal m
ctLookup :: forall (m :: * -> *). VarName -> GVal m
ctLookup = forall a b. a -> b -> a
const forall a. Default a => a
def

ctEncode :: GVal m -> Collected
ctEncode :: forall (m :: * -> *). GVal m -> Collected
ctEncode GVal m
g = [GVal Identity] -> Collected
Collected [forall (m :: * -> *) (n :: * -> *). GVal m -> GVal n
marshalGVal GVal m
g]