{-#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 = 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
      }

--    = 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 [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 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
(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 =
              -- We're erasing source code positions here,
              -- because we don't have any use for them anyway.
              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]