module Hakyllbars.Context where

import Control.Monad.Except
import Control.Monad.State.Strict
import Data.Aeson
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as KeyMap
import Data.Bifunctor
import Data.Either
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.Maybe
import Data.Proxy
import Data.Scientific (isInteger, toBoundedInteger, toBoundedRealFloat)
import qualified Data.Text as T
import qualified Data.Vector as Vector
import Hakyllbars.Ast
import Hakyllbars.Common
import Text.Parsec (SourcePos)
import Prelude hiding (lookup)

newtype Context a = Context {forall a. Context a -> ContextFunction a
unContext :: ContextFunction a}

type ContextFunction a = String -> TemplateRunner a (ContextValue a)

getContext :: Identifier -> Compiler (Context a)
getContext :: forall a. Identifier -> Compiler (Context a)
getContext Identifier
id' = forall v a. IntoContext v a => v -> Context a
intoContext forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadMetadata m => Identifier -> m Metadata
getMetadata Identifier
id'

itemFilePath :: Item a -> FilePath
itemFilePath :: forall a. Item a -> FilePath
itemFilePath = Identifier -> FilePath
toFilePath forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Item a -> Identifier
itemIdentifier

data TemplateState a = TemplateState
  { forall a. TemplateState a -> [(Context a, Context a)]
tplContextStack :: [(Context a, Context a)],
    forall a. TemplateState a -> [Item a]
tplItemStack :: [Item a],
    forall a. TemplateState a -> [FilePath]
tplCallStack :: [String]
  }

type TemplateRunner a b = StateT (TemplateState a) Compiler b

tplItem :: TemplateRunner a (Item a)
tplItem :: forall a. TemplateRunner a (Item a)
tplItem =
  forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a. TemplateState a -> [Item a]
tplItemStack forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    [] -> forall a b. FilePath -> TemplateRunner a b
tplFail FilePath
"tplItem: no Item on stack"
    (Item a
item : [Item a]
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return Item a
item

tplModifyItem :: (Item a -> TemplateRunner a (Item a)) -> TemplateRunner a ()
tplModifyItem :: forall a.
(Item a -> TemplateRunner a (Item a)) -> TemplateRunner a ()
tplModifyItem Item a -> TemplateRunner a (Item a)
f =
  forall a. TemplateRunner a (Item a)
tplItem
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Item a -> TemplateRunner a (Item a)
f
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Item a -> TemplateRunner a ()
tplReplaceItem

tplReplaceItem :: Item a -> TemplateRunner a ()
tplReplaceItem :: forall a. Item a -> TemplateRunner a ()
tplReplaceItem Item a
item = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a. TemplateRunner a (Item a)
tplPopItem
  forall a. Item a -> TemplateRunner a ()
tplPushItem Item a
item

tplPopItem :: TemplateRunner a (Item a)
tplPopItem :: forall a. TemplateRunner a (Item a)
tplPopItem =
  forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a. TemplateState a -> [Item a]
tplItemStack forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    [] -> forall a. HasCallStack => FilePath -> a
error FilePath
"tplPopItem: no Item on stack"
    Item a
current : [Item a]
previous -> do
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify \TemplateState a
s -> TemplateState a
s {tplItemStack :: [Item a]
tplItemStack = [Item a]
previous}
      forall (m :: * -> *) a. Monad m => a -> m a
return Item a
current

tplPopBody :: TemplateRunner a a
tplPopBody :: forall a. TemplateRunner a a
tplPopBody = forall a. Item a -> a
itemBody forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. TemplateRunner a (Item a)
tplPopItem

tplPushItem :: Item a -> TemplateRunner a ()
tplPushItem :: forall a. Item a -> TemplateRunner a ()
tplPushItem Item a
item = do
  [Item a]
stack <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a. TemplateState a -> [Item a]
tplItemStack
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify \TemplateState a
s -> TemplateState a
s {tplItemStack :: [Item a]
tplItemStack = Item a
item forall a. a -> [a] -> [a]
: [Item a]
stack}

tplWithItem :: Item a -> TemplateRunner a b -> TemplateRunner a b
tplWithItem :: forall a b. Item a -> TemplateRunner a b -> TemplateRunner a b
tplWithItem Item a
item TemplateRunner a b
f = do
  forall a. Item a -> TemplateRunner a ()
tplPushItem Item a
item
  b
x <- TemplateRunner a b
f
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a. TemplateRunner a (Item a)
tplPopItem
  forall (m :: * -> *) a. Monad m => a -> m a
return b
x

tplContext :: TemplateRunner a (Context a)
tplContext :: forall a. TemplateRunner a (Context a)
tplContext =
  forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a. TemplateState a -> [(Context a, Context a)]
tplContextStack forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    [] -> forall a b. FilePath -> TemplateRunner a b
tplFail FilePath
"tplContext: no Context on stack"
    ((Context a
_, Context a
catted) : [(Context a, Context a)]
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return Context a
catted

tplPushContext :: Context a -> TemplateRunner a ()
tplPushContext :: forall a. Context a -> TemplateRunner a ()
tplPushContext Context a
context = do
  [(Context a, Context a)]
stack <-
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a. TemplateState a -> [(Context a, Context a)]
tplContextStack forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
      [] -> [(Context a
context, Context a
context)]
      stack :: [(Context a, Context a)]
stack@((Context a
_, Context a
cattedParent) : [(Context a, Context a)]
_) -> (Context a
context, Context a
context forall a. Semigroup a => a -> a -> a
<> Context a
cattedParent) forall a. a -> [a] -> [a]
: [(Context a, Context a)]
stack
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify \TemplateState a
s -> TemplateState a
s {tplContextStack :: [(Context a, Context a)]
tplContextStack = [(Context a, Context a)]
stack}

tplPopContext :: TemplateRunner a (Context a)
tplPopContext :: forall a. TemplateRunner a (Context a)
tplPopContext =
  forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a. TemplateState a -> [(Context a, Context a)]
tplContextStack forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    [] -> forall a b. FilePath -> TemplateRunner a b
tplFail FilePath
"tplPopContext: no Context on stack"
    ((Context a
current, Context a
_) : [(Context a, Context a)]
previous) -> do
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify \TemplateState a
s ->
        TemplateState a
s
          { tplContextStack :: [(Context a, Context a)]
tplContextStack = [(Context a, Context a)]
previous
          }
      forall (m :: * -> *) a. Monad m => a -> m a
return Context a
current

-- | Place context within a given scope.
tplWithContext :: Context a -> TemplateRunner a b -> TemplateRunner a b
tplWithContext :: forall a b. Context a -> TemplateRunner a b -> TemplateRunner a b
tplWithContext Context a
context TemplateRunner a b
f = do
  forall a. Context a -> TemplateRunner a ()
tplPushContext Context a
context
  b
x <- TemplateRunner a b
f
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a. TemplateRunner a (Context a)
tplPopContext
  forall (m :: * -> *) a. Monad m => a -> m a
return b
x

-- | Get a value from the context by name and convert it.
tplGet :: (FromValue v a) => String -> TemplateRunner a v
tplGet :: forall v a. FromValue v a => FilePath -> TemplateRunner a v
tplGet FilePath
name =
  forall a. TemplateRunner a (Context a)
tplContext
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Context a -> ContextFunction a
unContext FilePath
name
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue

-- | Get a value from a specific item's context by name and convert it.
tplGetWithItemContext :: (FromValue v a) => Item a -> Context a -> String -> TemplateRunner a v
tplGetWithItemContext :: forall v a.
FromValue v a =>
Item a -> Context a -> FilePath -> TemplateRunner a v
tplGetWithItemContext Item a
item Context a
context FilePath
name =
  forall a b. Item a -> TemplateRunner a b -> TemplateRunner a b
tplWithItem Item a
item forall a b. (a -> b) -> a -> b
$ forall a b. Context a -> TemplateRunner a b -> TemplateRunner a b
tplWithContext Context a
context forall a b. (a -> b) -> a -> b
$ forall v a. FromValue v a => FilePath -> TemplateRunner a v
tplGet FilePath
name

-- | Place context in global scope.
tplPut :: Context a -> TemplateRunner a ()
tplPut :: forall a. Context a -> TemplateRunner a ()
tplPut Context a
context = do
  [(Context a, Context a)]
stack <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Context a
context forall a. Semigroup a => a -> a -> a
<>)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a. TemplateState a -> [(Context a, Context a)]
tplContextStack
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' \TemplateState a
s -> TemplateState a
s {tplContextStack :: [(Context a, Context a)]
tplContextStack = [(Context a, Context a)]
stack}

-- | Perform an action within the scope of a call.
tplWithCall :: String -> TemplateRunner a b -> TemplateRunner a b
tplWithCall :: forall a b. FilePath -> TemplateRunner a b -> TemplateRunner a b
tplWithCall FilePath
call TemplateRunner a b
f = do
  [FilePath]
stack <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a. TemplateState a -> [FilePath]
tplCallStack
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' \TemplateState a
s -> TemplateState a
s {tplCallStack :: [FilePath]
tplCallStack = FilePath
call forall a. a -> [a] -> [a]
: [FilePath]
stack}
  b
x <- TemplateRunner a b
f
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' \TemplateState a
s -> TemplateState a
s {tplCallStack :: [FilePath]
tplCallStack = [FilePath]
stack}
  forall (m :: * -> *) a. Monad m => a -> m a
return b
x

tplWithPos :: (x -> SourcePos) -> (x -> TemplateRunner a b) -> x -> TemplateRunner a b
tplWithPos :: forall x a b.
(x -> SourcePos)
-> (x -> TemplateRunner a b) -> x -> TemplateRunner a b
tplWithPos x -> SourcePos
getPos x -> TemplateRunner a b
f x
x = forall a b. FilePath -> TemplateRunner a b -> TemplateRunner a b
tplWithCall (forall a. Show a => a -> FilePath
show forall a b. (a -> b) -> a -> b
$ x -> SourcePos
getPos x
x) forall a b. (a -> b) -> a -> b
$ x -> TemplateRunner a b
f x
x

-- | Perform an action within the scope of a field call.
tplWithField :: String -> TemplateRunner a b -> TemplateRunner a b
tplWithField :: forall a b. FilePath -> TemplateRunner a b -> TemplateRunner a b
tplWithField FilePath
field' TemplateRunner a b
f = do
  FilePath
file <- forall a. Item a -> FilePath
itemFilePath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. TemplateRunner a (Item a)
tplItem
  forall a b. FilePath -> TemplateRunner a b -> TemplateRunner a b
tplWithCall (FilePath
"field " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show FilePath
field' forall a. [a] -> [a] -> [a]
++ FilePath
" in " forall a. [a] -> [a] -> [a]
++ FilePath
file) TemplateRunner a b
f

-- | Fail with an error message and trace.
tplFail :: String -> TemplateRunner a b
tplFail :: forall a b. FilePath -> TemplateRunner a b
tplFail = forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a. FilePath -> TemplateRunner a FilePath
tplTraced

-- | Fail with a no-result message and trace.
tplTried :: String -> TemplateRunner a b
tplTried :: forall a b. FilePath -> TemplateRunner a b
tplTried = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FilePath -> Compiler a
noResult forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a. FilePath -> TemplateRunner a FilePath
tplTraced

-- | Return the current call stack, with the most recent call first.
tplTrace :: TemplateRunner a [String]
tplTrace :: forall a. TemplateRunner a [FilePath]
tplTrace = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a. TemplateState a -> [FilePath]
tplCallStack

-- | Get a formatted trace message with the most recent call first.
tplTraced :: String -> TemplateRunner a String
tplTraced :: forall a. FilePath -> TemplateRunner a FilePath
tplTraced FilePath
message = do
  [FilePath]
trace <- forall a. TemplateRunner a [FilePath]
tplTrace
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FilePath
message forall a. [a] -> [a] -> [a]
++ FilePath
", trace from most recent:\n" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"\n\t" [FilePath]
trace forall a. [a] -> [a] -> [a]
++ FilePath
"\n"

-- | Apply @f@ to an item if @key@ is requested.
field :: (IntoValue v a) => String -> (Item a -> TemplateRunner a v) -> Context a
field :: forall v a.
IntoValue v a =>
FilePath -> (Item a -> TemplateRunner a v) -> Context a
field FilePath
key Item a -> TemplateRunner a v
f = forall a. ContextFunction a -> Context a
Context FilePath -> TemplateRunner a (ContextValue a)
f'
  where
    f' :: FilePath -> TemplateRunner a (ContextValue a)
f' FilePath
k =
      forall a b. FilePath -> TemplateRunner a b -> TemplateRunner a b
tplWithField FilePath
key forall a b. (a -> b) -> a -> b
$
        if FilePath
k forall a. Eq a => a -> a -> Bool
== FilePath
key
          then do
            Item a
i <- forall a. TemplateRunner a (Item a)
tplItem
            forall v a. IntoValue v a => v -> ContextValue a
intoValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Item a -> TemplateRunner a v
f Item a
i
          else do
            forall a b. FilePath -> TemplateRunner a b
tplTried forall a b. (a -> b) -> a -> b
$ FilePath
"key " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show FilePath
k forall a. [a] -> [a] -> [a]
++ FilePath
" did not match field " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show FilePath
key

-- | Reports missing field.
missingField :: Context a
missingField :: forall a. Context a
missingField = forall a. ContextFunction a -> Context a
Context forall {a} {a} {b}. Show a => a -> TemplateRunner a b
f
  where
    f :: a -> TemplateRunner a b
f a
key = forall a b. FilePath -> TemplateRunner a b
tplTried forall a b. (a -> b) -> a -> b
$ FilePath
"missing " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show a
key

-- | Const-valued field, returns the same @val@ per @key@.
constField :: (IntoValue v a) => String -> v -> Context a
constField :: forall v a. IntoValue v a => FilePath -> v -> Context a
constField FilePath
key v
val = forall v a.
IntoValue v a =>
FilePath -> (Item a -> TemplateRunner a v) -> Context a
field FilePath
key Item a -> TemplateRunner a v
f
  where
    constResult :: TemplateRunner a v
constResult = forall (m :: * -> *) a. Monad m => a -> m a
return v
val
    f :: Item a -> TemplateRunner a v
f Item a
_ = forall a b. FilePath -> TemplateRunner a b -> TemplateRunner a b
tplWithCall FilePath
key TemplateRunner a v
constResult

-- | Creates a field containing a list of items.
itemsField :: String -> Context a -> [Item a] -> Context a
itemsField :: forall a. FilePath -> Context a -> [Item a] -> Context a
itemsField FilePath
key Context a
context [Item a]
items = forall v a. IntoValue v a => FilePath -> v -> Context a
constField FilePath
key (Context a
context, [Item a]
items)

-- | Mapping of function @g@ after context @f@.
mapField :: (FromValue v a, IntoValue w a) => (v -> w) -> Context a -> Context a
mapField :: forall v a w.
(FromValue v a, IntoValue w a) =>
(v -> w) -> Context a -> Context a
mapField v -> w
g (Context ContextFunction a
f) = forall a. ContextFunction a -> Context a
Context ContextFunction a
h
  where
    h :: ContextFunction a
h FilePath
k = forall a b. FilePath -> TemplateRunner a b -> TemplateRunner a b
tplWithCall (FilePath
"mapField of " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show FilePath
k) do
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall v a. IntoValue v a => v -> ContextValue a
intoValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> w
g) forall a b. (a -> b) -> a -> b
$ forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ContextFunction a
f FilePath
k

-- | Binding of function @g@ after context @f@.
bindField :: (FromValue v a, IntoValue w a) => (v -> TemplateRunner a w) -> Context a -> Context a
bindField :: forall v a w.
(FromValue v a, IntoValue w a) =>
(v -> TemplateRunner a w) -> Context a -> Context a
bindField v -> TemplateRunner a w
g (Context ContextFunction a
f) = forall a. ContextFunction a -> Context a
Context ContextFunction a
h
  where
    h :: ContextFunction a
h FilePath
k = do
      forall a b. FilePath -> TemplateRunner a b -> TemplateRunner a b
tplWithCall (FilePath
"bindField of " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show FilePath
k) do
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall v a. IntoValue v a => v -> ContextValue a
intoValue forall a b. (a -> b) -> a -> b
$ v -> TemplateRunner a w
g forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ContextFunction a
f FilePath
k

-- | Alternation of context @g@ after context @f@.
composeField :: Context a -> Context a -> Context a
composeField :: forall a. Context a -> Context a -> Context a
composeField (Context ContextFunction a
g) (Context ContextFunction a
f) = forall a. ContextFunction a -> Context a
Context ContextFunction a
h
  where
    h :: ContextFunction a
h FilePath
name = ContextFunction a
f FilePath
name forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` (\[FilePath]
_ -> ContextFunction a
g FilePath
name)

-- | Lookup of @val@ by @key@ into provided @HashMap@.
hashMapField :: (IntoValue v a) => HashMap String v -> Context a
hashMapField :: forall v a. IntoValue v a => HashMap FilePath v -> Context a
hashMapField HashMap FilePath v
m = forall a. ContextFunction a -> Context a
Context FilePath -> TemplateRunner a (ContextValue a)
f
  where
    m' :: HashMap FilePath (ContextValue a)
m' = forall v a. IntoValue v a => v -> ContextValue a
intoValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap FilePath v
m
    f :: FilePath -> TemplateRunner a (ContextValue a)
f FilePath
k = forall a b. FilePath -> TemplateRunner a b -> TemplateRunner a b
tplWithCall FilePath
"hashMap" forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> TemplateRunner a (ContextValue a)
tried FilePath
k) forall (m :: * -> *) a. Monad m => a -> m a
return (forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup FilePath
k HashMap FilePath (ContextValue a)
m')
    tried :: FilePath -> TemplateRunner a (ContextValue a)
tried FilePath
k = forall a b. FilePath -> TemplateRunner a b
tplTried forall a b. (a -> b) -> a -> b
$ FilePath
"tried " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show FilePath
k forall a. [a] -> [a] -> [a]
++ FilePath
" from hashmap of keys " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show (forall k v. HashMap k v -> [k]
HashMap.keys HashMap FilePath (ContextValue a)
m')

forItemField :: (IntoValue v a) => String -> [Identifier] -> (Item a -> TemplateRunner a v) -> Context a
forItemField :: forall v a.
IntoValue v a =>
FilePath
-> [Identifier] -> (Item a -> TemplateRunner a v) -> Context a
forItemField FilePath
key [Identifier]
ids Item a -> TemplateRunner a v
f = forall v a.
IntoValue v a =>
FilePath -> (Item a -> TemplateRunner a v) -> Context a
field FilePath
key Item a -> TemplateRunner a v
f'
  where
    f' :: Item a -> TemplateRunner a v
f' Item a
item
      | forall a. Item a -> Identifier
itemIdentifier Item a
item forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Identifier]
ids = Item a -> TemplateRunner a v
f Item a
item
      | Bool
otherwise = forall a b. FilePath -> TemplateRunner a b
tplTried forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show FilePath
key forall a. [a] -> [a] -> [a]
++ FilePath
" for items " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show (Identifier -> FilePath
toFilePath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Identifier]
ids)

functionField :: (FromValue v a, IntoValue w a) => String -> (v -> TemplateRunner a w) -> Context a
functionField :: forall v a w.
(FromValue v a, IntoValue w a) =>
FilePath -> (v -> TemplateRunner a w) -> Context a
functionField = forall v a. IntoValue v a => FilePath -> v -> Context a
constField

functionField2 :: (FromValue v a, FromValue x a, IntoValue w a) => String -> (v -> x -> TemplateRunner a w) -> Context a
functionField2 :: forall v a x w.
(FromValue v a, FromValue x a, IntoValue w a) =>
FilePath -> (v -> x -> TemplateRunner a w) -> Context a
functionField2 = forall v a. IntoValue v a => FilePath -> v -> Context a
constField

functionField3 :: (FromValue v a, FromValue x a, FromValue y a, IntoValue w a) => String -> (v -> x -> y -> TemplateRunner a w) -> Context a
functionField3 :: forall v a x y w.
(FromValue v a, FromValue x a, FromValue y a, IntoValue w a) =>
FilePath -> (v -> x -> y -> TemplateRunner a w) -> Context a
functionField3 = forall v a. IntoValue v a => FilePath -> v -> Context a
constField

functionField4 :: (FromValue v a, FromValue x a, FromValue y a, FromValue z a, IntoValue w a) => String -> (v -> x -> y -> z -> TemplateRunner a w) -> Context a
functionField4 :: forall v a x y z w.
(FromValue v a, FromValue x a, FromValue y a, FromValue z a,
 IntoValue w a) =>
FilePath -> (v -> x -> y -> z -> TemplateRunner a w) -> Context a
functionField4 = forall v a. IntoValue v a => FilePath -> v -> Context a
constField

instance Semigroup (Context a) where
  <> :: Context a -> Context a -> Context a
(<>) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Context a -> Context a -> Context a
composeField

instance Monoid (Context a) where
  mempty :: Context a
mempty = forall a. Context a
missingField

class IntoContext v a where
  intoContext :: v -> Context a

instance IntoContext (Context a) a where
  intoContext :: Context a -> Context a
intoContext = forall a. a -> a
id

instance (IntoValue v a) => IntoContext (HashMap String v) a where
  intoContext :: HashMap FilePath v -> Context a
intoContext = forall v a. IntoValue v a => HashMap FilePath v -> Context a
hashMapField

instance (IntoValue v a) => IntoContext [(String, v)] a where
  intoContext :: [(FilePath, v)] -> Context a
intoContext = forall v a. IntoContext v a => v -> Context a
intoContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList

instance IntoContext Object a where
  intoContext :: Metadata -> Context a
intoContext = [(FilePath, ContextValue a)] -> Context a
ic forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Key -> FilePath
Key.toString forall v a. IntoValue v a => v -> ContextValue a
intoValue) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. KeyMap v -> [(Key, v)]
KeyMap.toList
    where
      ic :: [(String, ContextValue a)] -> Context a
      ic :: [(FilePath, ContextValue a)] -> Context a
ic = forall v a. IntoContext v a => v -> Context a
intoContext

-- | ContextValues can hold certain types of data within a context.
data ContextValue a
  = EmptyValue
  | UndefinedValue String (Item a) [String] [String]
  | ContextValue (Context a)
  | ListValue [ContextValue a]
  | BoolValue Bool
  | StringValue String
  | DoubleValue Double
  | IntValue Int
  | FunctionValue (ContextValue a -> TemplateRunner a (ContextValue a))
  | BlockValue Block
  | ItemValue (Item a)
  | ThunkValue (TemplateRunner a (ContextValue a))
  | PairValue (ContextValue a, ContextValue a)

type FunctionValue v w a = v -> TemplateRunner a w

type FunctionValue2 v x w a = v -> FunctionValue x w a

type FunctionValue3 v x y w a = v -> FunctionValue2 x y w a

type FunctionValue4 v x y z w a = v -> FunctionValue3 x y z w a

instance Show (ContextValue a) where
  show :: ContextValue a -> FilePath
show = \case
    ContextValue a
EmptyValue -> FilePath
"EmptyValue"
    UndefinedValue FilePath
name Item a
_ [FilePath]
_ [FilePath]
_ -> FilePath
"UndefinedValue " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show FilePath
name
    ContextValue {} -> FilePath
"ContextValue"
    ListValue [ContextValue a]
values -> FilePath
"ListValue " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show [ContextValue a]
values
    BoolValue Bool
value -> FilePath
"BoolValue " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Bool
value
    StringValue FilePath
value -> FilePath
"StringValue " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show FilePath
value
    DoubleValue Double
value -> FilePath
"DoubleValue " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Double
value
    IntValue Int
value -> FilePath
"IntValue " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Int
value
    FunctionValue {} -> FilePath
"FunctionValue"
    BlockValue {} -> FilePath
"BlockValue"
    ItemValue Item a
item -> FilePath
"ItemValue " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show (forall a. Item a -> FilePath
itemFilePath Item a
item)
    ThunkValue {} -> FilePath
"ThunkValue"
    PairValue (ContextValue a
x, ContextValue a
y) -> FilePath
"PairValue (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show ContextValue a
x forall a. [a] -> [a] -> [a]
++ FilePath
", " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show ContextValue a
y forall a. [a] -> [a] -> [a]
++ FilePath
")"

itemValue :: Context a -> Item a -> ContextValue a
itemValue :: forall a. Context a -> Item a -> ContextValue a
itemValue Context a
context Item a
item = forall v a. IntoValue v a => v -> ContextValue a
intoValue (Context a
context, [Item a
item])

class IntoValue' (flag :: Bool) v a where
  intoValue' :: Proxy flag -> v -> ContextValue a

-- "Specialize" List
type family FString a :: Bool where
  FString Char = 'True
  FString _ = 'False

-- | Inject a concrete type @v@ into a @ContextValue a@.
class IntoValue v a where
  intoValue :: v -> ContextValue a

instance (FString v ~ flag, IntoValue' flag [v] a) => IntoValue [v] a where
  intoValue :: [v] -> ContextValue a
intoValue = forall (flag :: Bool) v a.
IntoValue' flag v a =>
Proxy flag -> v -> ContextValue a
intoValue' (forall {k} (t :: k). Proxy t
Proxy :: Proxy flag)

instance (IntoValue v a) => IntoValue' 'False [v] a where
  intoValue' :: Proxy 'False -> [v] -> ContextValue a
intoValue' Proxy 'False
_ = forall a. [ContextValue a] -> ContextValue a
ListValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall v a. IntoValue v a => v -> ContextValue a
intoValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)

instance IntoValue' 'True String a where
  intoValue' :: Proxy 'True -> FilePath -> ContextValue a
intoValue' Proxy 'True
_ = forall a. FilePath -> ContextValue a
StringValue

instance IntoValue Block a where
  intoValue :: Block -> ContextValue a
intoValue = forall a. Block -> ContextValue a
BlockValue

instance IntoValue (ContextValue a) a where
  intoValue :: ContextValue a -> ContextValue a
intoValue = forall a. a -> a
id

instance IntoValue (Context a) a where
  intoValue :: Context a -> ContextValue a
intoValue = forall a. Context a -> ContextValue a
ContextValue

instance IntoValue Value a where
  intoValue :: Value -> ContextValue a
intoValue = \case
    Object Metadata
o -> forall a. Context a -> ContextValue a
ContextValue forall a b. (a -> b) -> a -> b
$ forall v a. IntoContext v a => v -> Context a
intoContext Metadata
o
    Array Array
a -> forall a. [ContextValue a] -> ContextValue a
ListValue forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> [a]
Vector.toList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> Vector a -> Vector b
Vector.map forall v a. IntoValue v a => v -> ContextValue a
intoValue Array
a
    String Text
t -> forall a. FilePath -> ContextValue a
StringValue forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
t
    Number Scientific
n
      | Scientific -> Bool
isInteger Scientific
n -> forall a. Int -> ContextValue a
IntValue forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger Scientific
n
      | Bool
otherwise -> forall a. Double -> ContextValue a
DoubleValue forall a b. (a -> b) -> a -> b
$ forall b a. b -> Either a b -> b
fromRight Double
0.0 forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => Scientific -> Either a a
toBoundedRealFloat Scientific
n
    Bool Bool
b -> forall a. Bool -> ContextValue a
BoolValue Bool
b
    Value
Null -> forall a. ContextValue a
EmptyValue

instance IntoValue () a where
  intoValue :: () -> ContextValue a
intoValue () = forall a. ContextValue a
EmptyValue

instance IntoValue Bool a where
  intoValue :: Bool -> ContextValue a
intoValue = forall a. Bool -> ContextValue a
BoolValue

instance IntoValue Double a where
  intoValue :: Double -> ContextValue a
intoValue = forall a. Double -> ContextValue a
DoubleValue

instance IntoValue Int a where
  intoValue :: Int -> ContextValue a
intoValue = forall a. Int -> ContextValue a
IntValue

instance (IntoValue v a) => IntoValue (Maybe v) a where
  intoValue :: Maybe v -> ContextValue a
intoValue (Just v
v) = forall v a. IntoValue v a => v -> ContextValue a
intoValue v
v
  intoValue Maybe v
Nothing = forall a. ContextValue a
EmptyValue

instance (FromValue v a, IntoValue w a) => IntoValue (FunctionValue v w a) a where
  intoValue :: FunctionValue v w a -> ContextValue a
intoValue FunctionValue v w a
f = forall a.
(ContextValue a -> TemplateRunner a (ContextValue a))
-> ContextValue a
FunctionValue ContextValue a
-> StateT (TemplateState a) Compiler (ContextValue a)
f'
    where
      f' :: ContextValue a
-> StateT (TemplateState a) Compiler (ContextValue a)
f' ContextValue a
cv = do
        v
v <- forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue ContextValue a
cv
        forall v a. IntoValue v a => v -> ContextValue a
intoValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FunctionValue v w a
f v
v

instance (FromValue v a, FromValue x a, IntoValue w a) => IntoValue (FunctionValue2 v x w a) a where
  intoValue :: FunctionValue2 v x w a -> ContextValue a
intoValue FunctionValue2 v x w a
f = forall a.
(ContextValue a -> TemplateRunner a (ContextValue a))
-> ContextValue a
FunctionValue ContextValue a
-> StateT (TemplateState a) Compiler (ContextValue a)
f'
    where
      f' :: ContextValue a
-> StateT (TemplateState a) Compiler (ContextValue a)
f' ContextValue a
cv =
        forall v a. IntoValue v a => v -> ContextValue a
intoValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionValue2 v x w a
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue ContextValue a
cv

instance (FromValue v a, FromValue x a, FromValue y a, IntoValue w a) => IntoValue (FunctionValue3 v x y w a) a where
  intoValue :: FunctionValue3 v x y w a -> ContextValue a
intoValue FunctionValue3 v x y w a
f = forall a.
(ContextValue a -> TemplateRunner a (ContextValue a))
-> ContextValue a
FunctionValue ContextValue a
-> StateT (TemplateState a) Compiler (ContextValue a)
f'
    where
      f' :: ContextValue a
-> StateT (TemplateState a) Compiler (ContextValue a)
f' ContextValue a
cv =
        forall v a. IntoValue v a => v -> ContextValue a
intoValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionValue3 v x y w a
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue ContextValue a
cv

instance (FromValue v a, FromValue x a, FromValue y a, FromValue z a, IntoValue w a) => IntoValue (FunctionValue4 v x y z w a) a where
  intoValue :: FunctionValue4 v x y z w a -> ContextValue a
intoValue FunctionValue4 v x y z w a
f = forall a.
(ContextValue a -> TemplateRunner a (ContextValue a))
-> ContextValue a
FunctionValue ContextValue a
-> StateT (TemplateState a) Compiler (ContextValue a)
f'
    where
      f' :: ContextValue a
-> StateT (TemplateState a) Compiler (ContextValue a)
f' ContextValue a
cv =
        forall v a. IntoValue v a => v -> ContextValue a
intoValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionValue4 v x y z w a
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue ContextValue a
cv

instance IntoValue (TemplateRunner a (ContextValue a)) a where
  intoValue :: TemplateRunner a (ContextValue a) -> ContextValue a
intoValue = forall a. TemplateRunner a (ContextValue a) -> ContextValue a
ThunkValue

instance (IntoValue v a, IntoValue x a) => IntoValue (v, x) a where
  intoValue :: (v, x) -> ContextValue a
intoValue (v
v, x
x) = forall a. (ContextValue a, ContextValue a) -> ContextValue a
PairValue (forall v a. IntoValue v a => v -> ContextValue a
intoValue v
v, forall v a. IntoValue v a => v -> ContextValue a
intoValue x
x)

instance IntoValue (Item a) a where
  intoValue :: Item a -> ContextValue a
intoValue = forall a. Item a -> ContextValue a
ItemValue

-- | Extract a concrete value of type @v@ from a @ContextValue a@.
class FromValue v a where
  fromValue :: ContextValue a -> TemplateRunner a v

class FromValue' (flag :: Bool) v a where
  fromValue' :: Proxy flag -> ContextValue a -> TemplateRunner a v

instance (FString v ~ flag, FromValue' flag [v] a) => FromValue [v] a where
  fromValue :: ContextValue a -> TemplateRunner a [v]
fromValue = forall (flag :: Bool) v a.
FromValue' flag v a =>
Proxy flag -> ContextValue a -> TemplateRunner a v
fromValue' (forall {k} (t :: k). Proxy t
Proxy :: Proxy flag)

instance (FromValue v a) => FromValue' 'False [v] a where
  fromValue' :: Proxy 'False -> ContextValue a -> TemplateRunner a [v]
fromValue' Proxy 'False
flag = \case
    ListValue [ContextValue a]
xs -> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$ forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ContextValue a]
xs
    ThunkValue TemplateRunner a (ContextValue a)
fx -> forall (flag :: Bool) v a.
FromValue' flag v a =>
Proxy flag -> ContextValue a -> TemplateRunner a v
fromValue' Proxy 'False
flag forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TemplateRunner a (ContextValue a)
fx
    ContextValue a
x -> forall a b. FilePath -> TemplateRunner a b
tplFail forall a b. (a -> b) -> a -> b
$ FilePath
"Tried to get " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show ContextValue a
x forall a. [a] -> [a] -> [a]
++ FilePath
" as List"

instance FromValue' 'True String a where
  fromValue' :: Proxy 'True -> ContextValue a -> TemplateRunner a FilePath
fromValue' Proxy 'True
flag = \case
    StringValue FilePath
x -> forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
x
    ContextValue a
EmptyValue -> forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
""
    ThunkValue TemplateRunner a (ContextValue a)
fx -> forall (flag :: Bool) v a.
FromValue' flag v a =>
Proxy flag -> ContextValue a -> TemplateRunner a v
fromValue' Proxy 'True
flag forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TemplateRunner a (ContextValue a)
fx
    ContextValue a
x -> forall a b. FilePath -> TemplateRunner a b
tplFail forall a b. (a -> b) -> a -> b
$ FilePath
"Tried to get " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show ContextValue a
x forall a. [a] -> [a] -> [a]
++ FilePath
" as String"

instance FromValue (Context a) a where
  fromValue :: ContextValue a -> TemplateRunner a (Context a)
fromValue = \case
    ContextValue Context a
c -> forall (m :: * -> *) a. Monad m => a -> m a
return Context a
c
    ThunkValue TemplateRunner a (ContextValue a)
fx -> forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TemplateRunner a (ContextValue a)
fx
    ContextValue a
x -> forall a b. FilePath -> TemplateRunner a b
tplFail forall a b. (a -> b) -> a -> b
$ FilePath
"Tried to get " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show ContextValue a
x forall a. [a] -> [a] -> [a]
++ FilePath
" as Context"

instance FromValue (ContextValue a) a where
  fromValue :: ContextValue a -> TemplateRunner a (ContextValue a)
fromValue = forall (m :: * -> *) a. Monad m => a -> m a
return

instance FromValue Bool a where
  fromValue :: ContextValue a -> TemplateRunner a Bool
fromValue = \case
    BoolValue Bool
x -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
x
    ThunkValue TemplateRunner a (ContextValue a)
fx -> forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TemplateRunner a (ContextValue a)
fx
    ContextValue a
x -> forall a b. FilePath -> TemplateRunner a b
tplFail forall a b. (a -> b) -> a -> b
$ FilePath
"Tried to get " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show ContextValue a
x forall a. [a] -> [a] -> [a]
++ FilePath
" as Bool"

instance FromValue Double a where
  fromValue :: ContextValue a -> TemplateRunner a Double
fromValue = \case
    DoubleValue Double
x -> forall (m :: * -> *) a. Monad m => a -> m a
return Double
x
    ThunkValue TemplateRunner a (ContextValue a)
fx -> forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TemplateRunner a (ContextValue a)
fx
    ContextValue a
x -> forall a b. FilePath -> TemplateRunner a b
tplFail forall a b. (a -> b) -> a -> b
$ FilePath
"Tried to get " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show ContextValue a
x forall a. [a] -> [a] -> [a]
++ FilePath
" as Double"

instance FromValue Int a where
  fromValue :: ContextValue a -> TemplateRunner a Int
fromValue = \case
    IntValue Int
x -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
x
    ThunkValue TemplateRunner a (ContextValue a)
fx -> forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TemplateRunner a (ContextValue a)
fx
    ContextValue a
x -> forall a b. FilePath -> TemplateRunner a b
tplFail forall a b. (a -> b) -> a -> b
$ FilePath
"Tried to get " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show ContextValue a
x forall a. [a] -> [a] -> [a]
++ FilePath
" as Int"

instance FromValue (Item a) a where
  fromValue :: ContextValue a -> TemplateRunner a (Item a)
fromValue = \case
    ItemValue Item a
item -> forall (m :: * -> *) a. Monad m => a -> m a
return Item a
item
    ThunkValue TemplateRunner a (ContextValue a)
fx -> forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TemplateRunner a (ContextValue a)
fx
    ContextValue a
x -> forall a b. FilePath -> TemplateRunner a b
tplFail forall a b. (a -> b) -> a -> b
$ FilePath
"Tried to get " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show ContextValue a
x forall a. [a] -> [a] -> [a]
++ FilePath
" as Item"

instance FromValue Block a where
  fromValue :: ContextValue a -> TemplateRunner a Block
fromValue = \case
    BlockValue Block
block -> forall (m :: * -> *) a. Monad m => a -> m a
return Block
block
    ThunkValue TemplateRunner a (ContextValue a)
fx -> forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TemplateRunner a (ContextValue a)
fx
    ContextValue a
x -> forall a b. FilePath -> TemplateRunner a b
tplFail forall a b. (a -> b) -> a -> b
$ FilePath
"Tried to get " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show ContextValue a
x forall a. [a] -> [a] -> [a]
++ FilePath
" as Block"

instance (IntoValue v a, FromValue w a) => FromValue (FunctionValue v w a) a where
  fromValue :: ContextValue a -> TemplateRunner a (FunctionValue v w a)
fromValue ContextValue a
cv = case ContextValue a
cv of
    FunctionValue ContextValue a -> TemplateRunner a (ContextValue a)
f -> forall (m :: * -> *) a. Monad m => a -> m a
return FunctionValue v w a
f'
      where
        f' :: FunctionValue v w a
f' v
v = forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ContextValue a -> TemplateRunner a (ContextValue a)
f (forall v a. IntoValue v a => v -> ContextValue a
intoValue v
v)
    ThunkValue TemplateRunner a (ContextValue a)
fx -> forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TemplateRunner a (ContextValue a)
fx
    ContextValue a
x -> forall a b. FilePath -> TemplateRunner a b
tplFail forall a b. (a -> b) -> a -> b
$ FilePath
"Tried to get " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show ContextValue a
x forall a. [a] -> [a] -> [a]
++ FilePath
" as Function"

instance (IntoValue v a, IntoValue x a, FromValue w a) => FromValue (FunctionValue2 v x w a) a where
  fromValue :: ContextValue a -> TemplateRunner a (FunctionValue2 v x w a)
fromValue ContextValue a
cv = case ContextValue a
cv of
    FunctionValue ContextValue a -> TemplateRunner a (ContextValue a)
f -> forall (m :: * -> *) a. Monad m => a -> m a
return FunctionValue2 v x w a
f'
      where
        f' :: FunctionValue2 v x w a
f' v
v x
x = do
          x -> StateT (TemplateState a) Compiler w
g <- forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ContextValue a -> TemplateRunner a (ContextValue a)
f (forall v a. IntoValue v a => v -> ContextValue a
intoValue v
v)
          x -> StateT (TemplateState a) Compiler w
g x
x
    ThunkValue TemplateRunner a (ContextValue a)
fx -> forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TemplateRunner a (ContextValue a)
fx
    ContextValue a
x -> forall a b. FilePath -> TemplateRunner a b
tplFail forall a b. (a -> b) -> a -> b
$ FilePath
"Tried to get " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show ContextValue a
x forall a. [a] -> [a] -> [a]
++ FilePath
" as Function2"

instance (IntoValue v a, IntoValue x a, IntoValue y a, FromValue w a) => FromValue (FunctionValue3 v x y w a) a where
  fromValue :: ContextValue a -> TemplateRunner a (FunctionValue3 v x y w a)
fromValue = \case
    FunctionValue ContextValue a -> TemplateRunner a (ContextValue a)
f -> forall (m :: * -> *) a. Monad m => a -> m a
return FunctionValue3 v x y w a
f'
      where
        f' :: FunctionValue3 v x y w a
f' v
v x
x y
y = do
          x
-> StateT
     (TemplateState a)
     Compiler
     (y -> StateT (TemplateState a) Compiler w)
g <- forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ContextValue a -> TemplateRunner a (ContextValue a)
f (forall v a. IntoValue v a => v -> ContextValue a
intoValue v
v)
          y -> StateT (TemplateState a) Compiler w
h <- x
-> StateT
     (TemplateState a)
     Compiler
     (y -> StateT (TemplateState a) Compiler w)
g x
x
          y -> StateT (TemplateState a) Compiler w
h y
y
    ThunkValue TemplateRunner a (ContextValue a)
fx -> forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TemplateRunner a (ContextValue a)
fx
    ContextValue a
x -> forall a b. FilePath -> TemplateRunner a b
tplFail forall a b. (a -> b) -> a -> b
$ FilePath
"Tried to get " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show ContextValue a
x forall a. [a] -> [a] -> [a]
++ FilePath
" as Function3"

instance (IntoValue v a, IntoValue x a, IntoValue y a, IntoValue z a, FromValue w a) => FromValue (FunctionValue4 v x y z w a) a where
  fromValue :: ContextValue a -> TemplateRunner a (FunctionValue4 v x y z w a)
fromValue = \case
    FunctionValue ContextValue a -> TemplateRunner a (ContextValue a)
f -> forall (m :: * -> *) a. Monad m => a -> m a
return FunctionValue4 v x y z w a
f'
      where
        f' :: FunctionValue4 v x y z w a
f' v
v x
x y
y z
z = do
          x
-> StateT
     (TemplateState a)
     Compiler
     (y
      -> StateT
           (TemplateState a)
           Compiler
           (z -> StateT (TemplateState a) Compiler w))
g <- forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ContextValue a -> TemplateRunner a (ContextValue a)
f (forall v a. IntoValue v a => v -> ContextValue a
intoValue v
v)
          y
-> StateT
     (TemplateState a)
     Compiler
     (z -> StateT (TemplateState a) Compiler w)
h <- x
-> StateT
     (TemplateState a)
     Compiler
     (y
      -> StateT
           (TemplateState a)
           Compiler
           (z -> StateT (TemplateState a) Compiler w))
g x
x
          z -> StateT (TemplateState a) Compiler w
i <- y
-> StateT
     (TemplateState a)
     Compiler
     (z -> StateT (TemplateState a) Compiler w)
h y
y
          z -> StateT (TemplateState a) Compiler w
i z
z
    ThunkValue TemplateRunner a (ContextValue a)
fx -> forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TemplateRunner a (ContextValue a)
fx
    ContextValue a
x -> forall a b. FilePath -> TemplateRunner a b
tplFail forall a b. (a -> b) -> a -> b
$ FilePath
"Tried to get " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show ContextValue a
x forall a. [a] -> [a] -> [a]
++ FilePath
" as Function4"

instance (FromValue v a, FromValue x a) => FromValue (v, x) a where
  fromValue :: ContextValue a -> TemplateRunner a (v, x)
fromValue = \case
    PairValue (ContextValue a
a, ContextValue a
b) -> (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue ContextValue a
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue ContextValue a
b
    ThunkValue TemplateRunner a (ContextValue a)
fx -> forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TemplateRunner a (ContextValue a)
fx
    ContextValue a
x -> forall a b. FilePath -> TemplateRunner a b
tplFail forall a b. (a -> b) -> a -> b
$ FilePath
"Tried to get " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show ContextValue a
x forall a. [a] -> [a] -> [a]
++ FilePath
" as Pair"