{-# OPTIONS_GHC -fno-warn-orphans  #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TupleSections              #-}
module Text.Mustache.Internal.Types where


import           Control.Arrow
import           Control.Monad.RWS        hiding (lift)
import qualified Data.Aeson               as Aeson
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.KeyMap        as KM
#endif
import           Data.Int                 (Int8, Int16, Int32, Int64)
import           Data.Foldable            (toList)
import qualified Data.HashMap.Strict      as HM
import qualified Data.HashSet             as HS
import qualified Data.Map                 as Map
import           Data.Scientific
import qualified Data.Sequence            as Seq
import qualified Data.Set                 as Set
import           Data.Text
import qualified Data.Text.Lazy           as LT
import qualified Data.Vector              as V
import           Data.Word                (Word8, Word16, Word32, Word64)
import           Language.Haskell.TH.Lift (deriveLift)
import           Language.Haskell.TH.Syntax
import           Numeric.Natural          (Natural)


-- | Type of errors we may encounter during substitution.
data SubstitutionError
  = VariableNotFound [Key] -- ^ The template contained a variable for which there was no data counterpart in the current context
  | InvalidImplicitSectionContextType String -- ^ When substituting an implicit section the current context had an unsubstitutable type
  | InvertedImplicitSection -- ^ Inverted implicit sections should never occur
  | SectionTargetNotFound [Key] -- ^ The template contained a section for which there was no data counterpart in the current context
  | PartialNotFound FilePath -- ^ The template contained a partial for which there was no data counterpart in the current context
  | DirectlyRenderedValue Value -- ^ A complex value such as an Object or Array was directly rendered into the template (warning)
  deriving (Int -> SubstitutionError -> ShowS
[SubstitutionError] -> ShowS
SubstitutionError -> String
(Int -> SubstitutionError -> ShowS)
-> (SubstitutionError -> String)
-> ([SubstitutionError] -> ShowS)
-> Show SubstitutionError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubstitutionError] -> ShowS
$cshowList :: [SubstitutionError] -> ShowS
show :: SubstitutionError -> String
$cshow :: SubstitutionError -> String
showsPrec :: Int -> SubstitutionError -> ShowS
$cshowsPrec :: Int -> SubstitutionError -> ShowS
Show)


tellError :: SubstitutionError -> SubM ()
tellError :: SubstitutionError -> SubM ()
tellError SubstitutionError
e = RWS
  (Context Value, TemplateCache) ([SubstitutionError], [Text]) () ()
-> SubM ()
forall a.
RWS
  (Context Value, TemplateCache) ([SubstitutionError], [Text]) () a
-> SubM a
SubM (RWS
   (Context Value, TemplateCache) ([SubstitutionError], [Text]) () ()
 -> SubM ())
-> RWS
     (Context Value, TemplateCache) ([SubstitutionError], [Text]) () ()
-> SubM ()
forall a b. (a -> b) -> a -> b
$ ([SubstitutionError], [Text])
-> RWS
     (Context Value, TemplateCache) ([SubstitutionError], [Text]) () ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([SubstitutionError
e], [])


tellSuccess :: Text -> SubM ()
tellSuccess :: Text -> SubM ()
tellSuccess Text
s = RWS
  (Context Value, TemplateCache) ([SubstitutionError], [Text]) () ()
-> SubM ()
forall a.
RWS
  (Context Value, TemplateCache) ([SubstitutionError], [Text]) () a
-> SubM a
SubM (RWS
   (Context Value, TemplateCache) ([SubstitutionError], [Text]) () ()
 -> SubM ())
-> RWS
     (Context Value, TemplateCache) ([SubstitutionError], [Text]) () ()
-> SubM ()
forall a b. (a -> b) -> a -> b
$ ([SubstitutionError], [Text])
-> RWS
     (Context Value, TemplateCache) ([SubstitutionError], [Text]) () ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([], [Text
s])


newtype SubM a = SubM { SubM a
-> RWS
     (Context Value, TemplateCache) ([SubstitutionError], [Text]) () a
runSubM' :: RWS (Context Value, TemplateCache) ([SubstitutionError], [Text]) ()  a } deriving (Applicative SubM
a -> SubM a
Applicative SubM
-> (forall a b. SubM a -> (a -> SubM b) -> SubM b)
-> (forall a b. SubM a -> SubM b -> SubM b)
-> (forall a. a -> SubM a)
-> Monad SubM
SubM a -> (a -> SubM b) -> SubM b
SubM a -> SubM b -> SubM b
forall a. a -> SubM a
forall a b. SubM a -> SubM b -> SubM b
forall a b. SubM a -> (a -> SubM b) -> SubM b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> SubM a
$creturn :: forall a. a -> SubM a
>> :: SubM a -> SubM b -> SubM b
$c>> :: forall a b. SubM a -> SubM b -> SubM b
>>= :: SubM a -> (a -> SubM b) -> SubM b
$c>>= :: forall a b. SubM a -> (a -> SubM b) -> SubM b
$cp1Monad :: Applicative SubM
Monad, a -> SubM b -> SubM a
(a -> b) -> SubM a -> SubM b
(forall a b. (a -> b) -> SubM a -> SubM b)
-> (forall a b. a -> SubM b -> SubM a) -> Functor SubM
forall a b. a -> SubM b -> SubM a
forall a b. (a -> b) -> SubM a -> SubM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> SubM b -> SubM a
$c<$ :: forall a b. a -> SubM b -> SubM a
fmap :: (a -> b) -> SubM a -> SubM b
$cfmap :: forall a b. (a -> b) -> SubM a -> SubM b
Functor, Functor SubM
a -> SubM a
Functor SubM
-> (forall a. a -> SubM a)
-> (forall a b. SubM (a -> b) -> SubM a -> SubM b)
-> (forall a b c. (a -> b -> c) -> SubM a -> SubM b -> SubM c)
-> (forall a b. SubM a -> SubM b -> SubM b)
-> (forall a b. SubM a -> SubM b -> SubM a)
-> Applicative SubM
SubM a -> SubM b -> SubM b
SubM a -> SubM b -> SubM a
SubM (a -> b) -> SubM a -> SubM b
(a -> b -> c) -> SubM a -> SubM b -> SubM c
forall a. a -> SubM a
forall a b. SubM a -> SubM b -> SubM a
forall a b. SubM a -> SubM b -> SubM b
forall a b. SubM (a -> b) -> SubM a -> SubM b
forall a b c. (a -> b -> c) -> SubM a -> SubM b -> SubM c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: SubM a -> SubM b -> SubM a
$c<* :: forall a b. SubM a -> SubM b -> SubM a
*> :: SubM a -> SubM b -> SubM b
$c*> :: forall a b. SubM a -> SubM b -> SubM b
liftA2 :: (a -> b -> c) -> SubM a -> SubM b -> SubM c
$cliftA2 :: forall a b c. (a -> b -> c) -> SubM a -> SubM b -> SubM c
<*> :: SubM (a -> b) -> SubM a -> SubM b
$c<*> :: forall a b. SubM (a -> b) -> SubM a -> SubM b
pure :: a -> SubM a
$cpure :: forall a. a -> SubM a
$cp1Applicative :: Functor SubM
Applicative, MonadReader (Context Value, TemplateCache))

runSubM :: SubM a -> Context Value -> TemplateCache -> ([SubstitutionError], [Text])
runSubM :: SubM a
-> Context Value -> TemplateCache -> ([SubstitutionError], [Text])
runSubM SubM a
comp Context Value
ctx TemplateCache
cache = (a, ([SubstitutionError], [Text])) -> ([SubstitutionError], [Text])
forall a b. (a, b) -> b
snd ((a, ([SubstitutionError], [Text]))
 -> ([SubstitutionError], [Text]))
-> (a, ([SubstitutionError], [Text]))
-> ([SubstitutionError], [Text])
forall a b. (a -> b) -> a -> b
$ RWS
  (Context Value, TemplateCache) ([SubstitutionError], [Text]) () a
-> (Context Value, TemplateCache)
-> ()
-> (a, ([SubstitutionError], [Text]))
forall r w s a. RWS r w s a -> r -> s -> (a, w)
evalRWS (SubM a
-> RWS
     (Context Value, TemplateCache) ([SubstitutionError], [Text]) () a
forall a.
SubM a
-> RWS
     (Context Value, TemplateCache) ([SubstitutionError], [Text]) () a
runSubM' SubM a
comp) (Context Value
ctx, TemplateCache
cache) ()

shiftContext :: Context Value -> SubM a -> SubM a
shiftContext :: Context Value -> SubM a -> SubM a
shiftContext = ((Context Value, TemplateCache) -> (Context Value, TemplateCache))
-> SubM a -> SubM a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (((Context Value, TemplateCache) -> (Context Value, TemplateCache))
 -> SubM a -> SubM a)
-> (Context Value
    -> (Context Value, TemplateCache)
    -> (Context Value, TemplateCache))
-> Context Value
-> SubM a
-> SubM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Context Value -> Context Value)
-> (Context Value, TemplateCache) -> (Context Value, TemplateCache)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((Context Value -> Context Value)
 -> (Context Value, TemplateCache)
 -> (Context Value, TemplateCache))
-> (Context Value -> Context Value -> Context Value)
-> Context Value
-> (Context Value, TemplateCache)
-> (Context Value, TemplateCache)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context Value -> Context Value -> Context Value
forall a b. a -> b -> a
const

-- | Search for a key in the current context.
--
-- The search is conducted inside out mening the current focus
-- is searched first. If the key is not found the outer scopes are recursively
-- searched until the key is found, then 'innerSearch' is called on the result.
search :: [Key] -> SubM (Maybe Value)
search :: [Text] -> SubM (Maybe Value)
search [] = Maybe Value -> SubM (Maybe Value)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Value
forall a. Maybe a
Nothing
search (Text
key:[Text]
nextKeys) = (Maybe Value -> (Value -> Maybe Value) -> Maybe Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Text] -> Value -> Maybe Value
innerSearch [Text]
nextKeys) (Maybe Value -> Maybe Value)
-> SubM (Maybe Value) -> SubM (Maybe Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SubM (Maybe Value)
go
  where
    go :: SubM (Maybe Value)
go = ((Context Value, TemplateCache) -> Context Value)
-> SubM (Context Value)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Context Value, TemplateCache) -> Context Value
forall a b. (a, b) -> a
fst SubM (Context Value)
-> (Context Value -> SubM (Maybe Value)) -> SubM (Maybe Value)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Context [Value]
parents Value
focus -> do
        let searchParents :: SubM (Maybe Value)
searchParents = case [Value]
parents of
                  (Value
newFocus: [Value]
newParents) -> Context Value -> SubM (Maybe Value) -> SubM (Maybe Value)
forall a. Context Value -> SubM a -> SubM a
shiftContext ([Value] -> Value -> Context Value
forall α. [α] -> α -> Context α
Context [Value]
newParents Value
newFocus) (SubM (Maybe Value) -> SubM (Maybe Value))
-> SubM (Maybe Value) -> SubM (Maybe Value)
forall a b. (a -> b) -> a -> b
$ SubM (Maybe Value)
go
                  [Value]
_ -> Maybe Value -> SubM (Maybe Value)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Value
forall a. Maybe a
Nothing
        case Value
focus of
          Object Object
o ->
            case Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
key Object
o of
              Just Value
res -> Maybe Value -> SubM (Maybe Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Value -> SubM (Maybe Value))
-> Maybe Value -> SubM (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just Value
res
              Maybe Value
_ -> SubM (Maybe Value)
searchParents
          Value
_ -> SubM (Maybe Value)
searchParents


-- | Searches nested scopes navigating inward. Fails if it encunters something
-- other than an object before the key is expended.
innerSearch :: [Key] -> Value -> Maybe Value
innerSearch :: [Text] -> Value -> Maybe Value
innerSearch []     Value
v          = Value -> Maybe Value
forall a. a -> Maybe a
Just Value
v
innerSearch (Text
y:[Text]
ys) (Object Object
o) = Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
y Object
o Maybe Value -> (Value -> Maybe Value) -> Maybe Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Text] -> Value -> Maybe Value
innerSearch [Text]
ys
innerSearch [Text]
_      Value
_          = Maybe Value
forall a. Maybe a
Nothing



-- | Syntax tree for a mustache template
type STree = ASTree Text


type ASTree α = [Node α]


-- | Basic values composing the STree
data Node α
  = TextBlock α
  | Section DataIdentifier (ASTree α)
  | InvertedSection DataIdentifier (ASTree α)
  | Variable Bool DataIdentifier
  | Partial (Maybe α) FilePath
  deriving (Int -> Node α -> ShowS
[Node α] -> ShowS
Node α -> String
(Int -> Node α -> ShowS)
-> (Node α -> String) -> ([Node α] -> ShowS) -> Show (Node α)
forall α. Show α => Int -> Node α -> ShowS
forall α. Show α => [Node α] -> ShowS
forall α. Show α => Node α -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Node α] -> ShowS
$cshowList :: forall α. Show α => [Node α] -> ShowS
show :: Node α -> String
$cshow :: forall α. Show α => Node α -> String
showsPrec :: Int -> Node α -> ShowS
$cshowsPrec :: forall α. Show α => Int -> Node α -> ShowS
Show, Node α -> Node α -> Bool
(Node α -> Node α -> Bool)
-> (Node α -> Node α -> Bool) -> Eq (Node α)
forall α. Eq α => Node α -> Node α -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Node α -> Node α -> Bool
$c/= :: forall α. Eq α => Node α -> Node α -> Bool
== :: Node α -> Node α -> Bool
$c== :: forall α. Eq α => Node α -> Node α -> Bool
Eq)


-- | Kinds of identifiers for Variables and sections
data DataIdentifier
  = NamedData [Key]
  | Implicit
  deriving (Int -> DataIdentifier -> ShowS
[DataIdentifier] -> ShowS
DataIdentifier -> String
(Int -> DataIdentifier -> ShowS)
-> (DataIdentifier -> String)
-> ([DataIdentifier] -> ShowS)
-> Show DataIdentifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataIdentifier] -> ShowS
$cshowList :: [DataIdentifier] -> ShowS
show :: DataIdentifier -> String
$cshow :: DataIdentifier -> String
showsPrec :: Int -> DataIdentifier -> ShowS
$cshowsPrec :: Int -> DataIdentifier -> ShowS
Show, DataIdentifier -> DataIdentifier -> Bool
(DataIdentifier -> DataIdentifier -> Bool)
-> (DataIdentifier -> DataIdentifier -> Bool) -> Eq DataIdentifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataIdentifier -> DataIdentifier -> Bool
$c/= :: DataIdentifier -> DataIdentifier -> Bool
== :: DataIdentifier -> DataIdentifier -> Bool
$c== :: DataIdentifier -> DataIdentifier -> Bool
Eq)


-- | A list-like structure used in 'Value'
type Array  = V.Vector Value
-- | A map-like structure used in 'Value'
type Object = HM.HashMap Text Value
-- | Source type for constructing 'Object's
type Pair   = (Text, Value)


-- | Representation of stateful context for the substitution process
data Context α = Context { Context α -> [α]
ctxtParents :: [α], Context α -> α
ctxtFocus :: α }
  deriving (Context α -> Context α -> Bool
(Context α -> Context α -> Bool)
-> (Context α -> Context α -> Bool) -> Eq (Context α)
forall α. Eq α => Context α -> Context α -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Context α -> Context α -> Bool
$c/= :: forall α. Eq α => Context α -> Context α -> Bool
== :: Context α -> Context α -> Bool
$c== :: forall α. Eq α => Context α -> Context α -> Bool
Eq, Int -> Context α -> ShowS
[Context α] -> ShowS
Context α -> String
(Int -> Context α -> ShowS)
-> (Context α -> String)
-> ([Context α] -> ShowS)
-> Show (Context α)
forall α. Show α => Int -> Context α -> ShowS
forall α. Show α => [Context α] -> ShowS
forall α. Show α => Context α -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Context α] -> ShowS
$cshowList :: forall α. Show α => [Context α] -> ShowS
show :: Context α -> String
$cshow :: forall α. Show α => Context α -> String
showsPrec :: Int -> Context α -> ShowS
$cshowsPrec :: forall α. Show α => Int -> Context α -> ShowS
Show, Eq (Context α)
Eq (Context α)
-> (Context α -> Context α -> Ordering)
-> (Context α -> Context α -> Bool)
-> (Context α -> Context α -> Bool)
-> (Context α -> Context α -> Bool)
-> (Context α -> Context α -> Bool)
-> (Context α -> Context α -> Context α)
-> (Context α -> Context α -> Context α)
-> Ord (Context α)
Context α -> Context α -> Bool
Context α -> Context α -> Ordering
Context α -> Context α -> Context α
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
forall α. Ord α => Eq (Context α)
forall α. Ord α => Context α -> Context α -> Bool
forall α. Ord α => Context α -> Context α -> Ordering
forall α. Ord α => Context α -> Context α -> Context α
min :: Context α -> Context α -> Context α
$cmin :: forall α. Ord α => Context α -> Context α -> Context α
max :: Context α -> Context α -> Context α
$cmax :: forall α. Ord α => Context α -> Context α -> Context α
>= :: Context α -> Context α -> Bool
$c>= :: forall α. Ord α => Context α -> Context α -> Bool
> :: Context α -> Context α -> Bool
$c> :: forall α. Ord α => Context α -> Context α -> Bool
<= :: Context α -> Context α -> Bool
$c<= :: forall α. Ord α => Context α -> Context α -> Bool
< :: Context α -> Context α -> Bool
$c< :: forall α. Ord α => Context α -> Context α -> Bool
compare :: Context α -> Context α -> Ordering
$ccompare :: forall α. Ord α => Context α -> Context α -> Ordering
$cp1Ord :: forall α. Ord α => Eq (Context α)
Ord)

-- | Internal value representation
data Value
  = Object !Object
  | Array  !Array
  | Number !Scientific
  | String !Text
  | Lambda (STree -> SubM STree)
  | Bool   !Bool
  | Null


instance Show Value where
  show :: Value -> String
show (Lambda STree -> SubM STree
_) = String
"Lambda function"
  show (Object Object
o) = Object -> String
forall a. Show a => a -> String
show Object
o
  show (Array  Array
a) = Array -> String
forall a. Show a => a -> String
show Array
a
  show (String Text
s) = Text -> String
forall a. Show a => a -> String
show Text
s
  show (Number Scientific
n) = Scientific -> String
forall a. Show a => a -> String
show Scientific
n
  show (Bool   Bool
b) = Bool -> String
forall a. Show a => a -> String
show Bool
b
  show Value
Null       = String
"null"


listToMustache' :: ToMustache ω => [ω] -> Value
listToMustache' :: [ω] -> Value
listToMustache' = Array -> Value
Array (Array -> Value) -> ([ω] -> Array) -> [ω] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Array
forall a. [a] -> Vector a
V.fromList ([Value] -> Array) -> ([ω] -> [Value]) -> [ω] -> Array
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ω -> Value) -> [ω] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ω -> Value
forall ω. ToMustache ω => ω -> Value
toMustache

integralToMustache :: Integral ω => ω -> Value
integralToMustache :: ω -> Value
integralToMustache = Integer -> Value
forall ω. ToMustache ω => ω -> Value
toMustache (Integer -> Value) -> (ω -> Integer) -> ω -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ω -> Integer
forall a. Integral a => a -> Integer
toInteger

-- | Conversion class
class ToMustache ω where
  toMustache :: ω -> Value
  listToMustache :: [ω] -> Value
  listToMustache = [ω] -> Value
forall ω. ToMustache ω => [ω] -> Value
listToMustache'

instance ToMustache Float where
  toMustache :: Float -> Value
toMustache = Scientific -> Value
Number (Scientific -> Value) -> (Float -> Scientific) -> Float -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Scientific
forall a. RealFloat a => a -> Scientific
fromFloatDigits

instance ToMustache Double where
  toMustache :: Double -> Value
toMustache = Scientific -> Value
Number (Scientific -> Value) -> (Double -> Scientific) -> Double -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Scientific
forall a. RealFloat a => a -> Scientific
fromFloatDigits

instance ToMustache Integer where
  toMustache :: Integer -> Value
toMustache = Scientific -> Value
Number (Scientific -> Value)
-> (Integer -> Scientific) -> Integer -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Scientific
forall a. Num a => Integer -> a
fromInteger

instance ToMustache Natural where
  toMustache :: Natural -> Value
toMustache = Natural -> Value
forall ω. Integral ω => ω -> Value
integralToMustache

instance ToMustache Int where
  toMustache :: Int -> Value
toMustache = Int -> Value
forall ω. Integral ω => ω -> Value
integralToMustache

instance ToMustache Word where
  toMustache :: Word -> Value
toMustache = Word -> Value
forall ω. Integral ω => ω -> Value
integralToMustache

instance ToMustache Int8 where
  toMustache :: Int8 -> Value
toMustache = Int8 -> Value
forall ω. Integral ω => ω -> Value
integralToMustache

instance ToMustache Int16 where
  toMustache :: Int16 -> Value
toMustache = Int16 -> Value
forall ω. Integral ω => ω -> Value
integralToMustache

instance ToMustache Int32 where
  toMustache :: Int32 -> Value
toMustache = Int32 -> Value
forall ω. Integral ω => ω -> Value
integralToMustache

instance ToMustache Int64 where
  toMustache :: Int64 -> Value
toMustache = Int64 -> Value
forall ω. Integral ω => ω -> Value
integralToMustache

instance ToMustache Word8 where
  toMustache :: Word8 -> Value
toMustache = Word8 -> Value
forall ω. Integral ω => ω -> Value
integralToMustache

instance ToMustache Word16 where
  toMustache :: Word16 -> Value
toMustache = Word16 -> Value
forall ω. Integral ω => ω -> Value
integralToMustache

instance ToMustache Word32 where
  toMustache :: Word32 -> Value
toMustache = Word32 -> Value
forall ω. Integral ω => ω -> Value
integralToMustache

instance ToMustache Word64 where
  toMustache :: Word64 -> Value
toMustache = Word64 -> Value
forall ω. Integral ω => ω -> Value
integralToMustache

instance ToMustache Char where
  toMustache :: Char -> Value
toMustache = String -> Value
forall ω. ToMustache ω => ω -> Value
toMustache (String -> Value) -> (Char -> String) -> Char -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> ShowS
forall a. a -> [a] -> [a]
:[])
  listToMustache :: String -> Value
listToMustache = Text -> Value
String (Text -> Value) -> (String -> Text) -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack

instance ToMustache Value where
  toMustache :: Value -> Value
toMustache = Value -> Value
forall a. a -> a
id

instance ToMustache Bool where
  toMustache :: Bool -> Value
toMustache = Bool -> Value
Bool

instance ToMustache () where
  toMustache :: () -> Value
toMustache = Value -> () -> Value
forall a b. a -> b -> a
const Value
Null

instance ToMustache ω => ToMustache (Maybe ω) where
  toMustache :: Maybe ω -> Value
toMustache (Just ω
w) = ω -> Value
forall ω. ToMustache ω => ω -> Value
toMustache ω
w
  toMustache Maybe ω
Nothing  = Value
Null

instance ToMustache Text where
  toMustache :: Text -> Value
toMustache = Text -> Value
String

instance ToMustache LT.Text where
  toMustache :: Text -> Value
toMustache = Text -> Value
String (Text -> Value) -> (Text -> Text) -> Text -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LT.toStrict

instance ToMustache Scientific where
  toMustache :: Scientific -> Value
toMustache = Scientific -> Value
Number

instance ToMustache α => ToMustache [α] where
  toMustache :: [α] -> Value
toMustache = [α] -> Value
forall ω. ToMustache ω => [ω] -> Value
listToMustache

instance ToMustache ω => ToMustache (Seq.Seq ω) where
  toMustache :: Seq ω -> Value
toMustache = [ω] -> Value
forall ω. ToMustache ω => [ω] -> Value
listToMustache' ([ω] -> Value) -> (Seq ω -> [ω]) -> Seq ω -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq ω -> [ω]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

instance ToMustache ω => ToMustache (V.Vector ω) where
  toMustache :: Vector ω -> Value
toMustache = Array -> Value
Array (Array -> Value) -> (Vector ω -> Array) -> Vector ω -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ω -> Value) -> Vector ω -> Array
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ω -> Value
forall ω. ToMustache ω => ω -> Value
toMustache

instance (ToMustache ω) => ToMustache (Map.Map Text ω) where
  toMustache :: Map Text ω -> Value
toMustache = (Text -> Text) -> Map Text ω -> Value
forall v a. ToMustache v => (a -> Text) -> Map a v -> Value
mapInstanceHelper Text -> Text
forall a. a -> a
id

instance (ToMustache ω) => ToMustache (Map.Map LT.Text ω) where
  toMustache :: Map Text ω -> Value
toMustache = (Text -> Text) -> Map Text ω -> Value
forall v a. ToMustache v => (a -> Text) -> Map a v -> Value
mapInstanceHelper Text -> Text
LT.toStrict

instance (ToMustache ω) => ToMustache (Map.Map String ω) where
  toMustache :: Map String ω -> Value
toMustache = (String -> Text) -> Map String ω -> Value
forall v a. ToMustache v => (a -> Text) -> Map a v -> Value
mapInstanceHelper String -> Text
pack

mapInstanceHelper :: ToMustache v => (a -> Text) -> Map.Map a v -> Value
mapInstanceHelper :: (a -> Text) -> Map a v -> Value
mapInstanceHelper a -> Text
conv =
  Object -> Value
forall ω. ToMustache ω => ω -> Value
toMustache
  (Object -> Value) -> (Map a v -> Object) -> Map a v -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> v -> Object -> Object) -> Object -> Map a v -> Object
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey
    (\a
k -> Text -> Value -> Object -> Object
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert (a -> Text
conv a
k) (Value -> Object -> Object)
-> (v -> Value) -> v -> Object -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Value
forall ω. ToMustache ω => ω -> Value
toMustache)
    Object
forall k v. HashMap k v
HM.empty

instance ToMustache ω => ToMustache (HM.HashMap Text ω) where
  toMustache :: HashMap Text ω -> Value
toMustache = Object -> Value
Object (Object -> Value)
-> (HashMap Text ω -> Object) -> HashMap Text ω -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ω -> Value) -> HashMap Text ω -> Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ω -> Value
forall ω. ToMustache ω => ω -> Value
toMustache

instance ToMustache ω => ToMustache (HM.HashMap LT.Text ω) where
  toMustache :: HashMap Text ω -> Value
toMustache = (Text -> Text) -> HashMap Text ω -> Value
forall v a. ToMustache v => (a -> Text) -> HashMap a v -> Value
hashMapInstanceHelper Text -> Text
LT.toStrict

instance ToMustache ω => ToMustache (HM.HashMap String ω) where
  toMustache :: HashMap String ω -> Value
toMustache = (String -> Text) -> HashMap String ω -> Value
forall v a. ToMustache v => (a -> Text) -> HashMap a v -> Value
hashMapInstanceHelper String -> Text
pack

hashMapInstanceHelper :: ToMustache v => (a -> Text) -> HM.HashMap a v -> Value
hashMapInstanceHelper :: (a -> Text) -> HashMap a v -> Value
hashMapInstanceHelper a -> Text
conv =
  Object -> Value
forall ω. ToMustache ω => ω -> Value
toMustache
  (Object -> Value)
-> (HashMap a v -> Object) -> HashMap a v -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> v -> Object -> Object) -> Object -> HashMap a v -> Object
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HM.foldrWithKey
    (\a
k -> Text -> Value -> Object -> Object
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert (a -> Text
conv a
k) (Value -> Object -> Object)
-> (v -> Value) -> v -> Object -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Value
forall ω. ToMustache ω => ω -> Value
toMustache)
    Object
forall k v. HashMap k v
HM.empty

instance ToMustache (STree -> SubM STree) where
    toMustache :: (STree -> SubM STree) -> Value
toMustache = (STree -> SubM STree) -> Value
Lambda

instance ToMustache Aeson.Value where
  toMustache :: Value -> Value
toMustache (Aeson.Object Object
o) = Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ (Value -> Value) -> HashMap Text Value -> Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Value
forall ω. ToMustache ω => ω -> Value
toMustache
#if MIN_VERSION_aeson(2,0,0)
    (Object -> HashMap Text Value
forall v. KeyMap v -> HashMap Text v
KM.toHashMapText Object
o)
#else
    o
#endif
  toMustache (Aeson.Array  Array
a) = Array -> Value
Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ (Value -> Value) -> Array -> Array
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Value
forall ω. ToMustache ω => ω -> Value
toMustache Array
a
  toMustache (Aeson.Number Scientific
n) = Scientific -> Value
Number Scientific
n
  toMustache (Aeson.String Text
s) = Text -> Value
String Text
s
  toMustache (Aeson.Bool   Bool
b) = Bool -> Value
Bool Bool
b
  toMustache Value
Aeson.Null       = Value
Null

instance ToMustache ω => ToMustache (HS.HashSet ω) where
  toMustache :: HashSet ω -> Value
toMustache = [ω] -> Value
forall ω. ToMustache ω => [ω] -> Value
listToMustache' ([ω] -> Value) -> (HashSet ω -> [ω]) -> HashSet ω -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet ω -> [ω]
forall a. HashSet a -> [a]
HS.toList

instance ToMustache ω => ToMustache (Set.Set ω) where
  toMustache :: Set ω -> Value
toMustache = [ω] -> Value
forall ω. ToMustache ω => [ω] -> Value
listToMustache' ([ω] -> Value) -> (Set ω -> [ω]) -> Set ω -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set ω -> [ω]
forall a. Set a -> [a]
Set.toList

instance (ToMustache α, ToMustache β) => ToMustache (α, β) where
  toMustache :: (α, β) -> Value
toMustache (α
a, β
b) = [Value] -> Value
forall ω. ToMustache ω => ω -> Value
toMustache [α -> Value
forall ω. ToMustache ω => ω -> Value
toMustache α
a, β -> Value
forall ω. ToMustache ω => ω -> Value
toMustache β
b]

instance (ToMustache α, ToMustache β, ToMustache γ)
         => ToMustache (α, β, γ) where
  toMustache :: (α, β, γ) -> Value
toMustache (α
a, β
b, γ
c) = [Value] -> Value
forall ω. ToMustache ω => ω -> Value
toMustache [α -> Value
forall ω. ToMustache ω => ω -> Value
toMustache α
a, β -> Value
forall ω. ToMustache ω => ω -> Value
toMustache β
b, γ -> Value
forall ω. ToMustache ω => ω -> Value
toMustache γ
c]

instance (ToMustache α, ToMustache β, ToMustache γ, ToMustache δ)
         => ToMustache (α, β, γ, δ) where
  toMustache :: (α, β, γ, δ) -> Value
toMustache (α
a, β
b, γ
c, δ
d) = [Value] -> Value
forall ω. ToMustache ω => ω -> Value
toMustache
    [ α -> Value
forall ω. ToMustache ω => ω -> Value
toMustache α
a
    , β -> Value
forall ω. ToMustache ω => ω -> Value
toMustache β
b
    , γ -> Value
forall ω. ToMustache ω => ω -> Value
toMustache γ
c
    , δ -> Value
forall ω. ToMustache ω => ω -> Value
toMustache δ
d
    ]

instance ( ToMustache α
         , ToMustache β
         , ToMustache γ
         , ToMustache δ
         , ToMustache ε
         ) => ToMustache (α, β, γ, δ, ε) where
  toMustache :: (α, β, γ, δ, ε) -> Value
toMustache (α
a, β
b, γ
c, δ
d, ε
e) = [Value] -> Value
forall ω. ToMustache ω => ω -> Value
toMustache
    [ α -> Value
forall ω. ToMustache ω => ω -> Value
toMustache α
a
    , β -> Value
forall ω. ToMustache ω => ω -> Value
toMustache β
b
    , γ -> Value
forall ω. ToMustache ω => ω -> Value
toMustache γ
c
    , δ -> Value
forall ω. ToMustache ω => ω -> Value
toMustache δ
d
    , ε -> Value
forall ω. ToMustache ω => ω -> Value
toMustache ε
e
    ]

instance ( ToMustache α
         , ToMustache β
         , ToMustache γ
         , ToMustache δ
         , ToMustache ε
         , ToMustache ζ
         ) => ToMustache (α, β, γ, δ, ε, ζ) where
  toMustache :: (α, β, γ, δ, ε, ζ) -> Value
toMustache (α
a, β
b, γ
c, δ
d, ε
e, ζ
f) = [Value] -> Value
forall ω. ToMustache ω => ω -> Value
toMustache
    [ α -> Value
forall ω. ToMustache ω => ω -> Value
toMustache α
a
    , β -> Value
forall ω. ToMustache ω => ω -> Value
toMustache β
b
    , γ -> Value
forall ω. ToMustache ω => ω -> Value
toMustache γ
c
    , δ -> Value
forall ω. ToMustache ω => ω -> Value
toMustache δ
d
    , ε -> Value
forall ω. ToMustache ω => ω -> Value
toMustache ε
e
    , ζ -> Value
forall ω. ToMustache ω => ω -> Value
toMustache ζ
f
    ]

instance ( ToMustache α
         , ToMustache β
         , ToMustache γ
         , ToMustache δ
         , ToMustache ε
         , ToMustache ζ
         , ToMustache η
         ) => ToMustache (α, β, γ, δ, ε, ζ, η) where
  toMustache :: (α, β, γ, δ, ε, ζ, η) -> Value
toMustache (α
a, β
b, γ
c, δ
d, ε
e, ζ
f, η
g) = [Value] -> Value
forall ω. ToMustache ω => ω -> Value
toMustache
    [ α -> Value
forall ω. ToMustache ω => ω -> Value
toMustache α
a
    , β -> Value
forall ω. ToMustache ω => ω -> Value
toMustache β
b
    , γ -> Value
forall ω. ToMustache ω => ω -> Value
toMustache γ
c
    , δ -> Value
forall ω. ToMustache ω => ω -> Value
toMustache δ
d
    , ε -> Value
forall ω. ToMustache ω => ω -> Value
toMustache ε
e
    , ζ -> Value
forall ω. ToMustache ω => ω -> Value
toMustache ζ
f
    , η -> Value
forall ω. ToMustache ω => ω -> Value
toMustache η
g
    ]

instance ( ToMustache α
         , ToMustache β
         , ToMustache γ
         , ToMustache δ
         , ToMustache ε
         , ToMustache ζ
         , ToMustache η
         , ToMustache θ
         ) => ToMustache (α, β, γ, δ, ε, ζ, η, θ) where
  toMustache :: (α, β, γ, δ, ε, ζ, η, θ) -> Value
toMustache (α
a, β
b, γ
c, δ
d, ε
e, ζ
f, η
g, θ
h) = [Value] -> Value
forall ω. ToMustache ω => ω -> Value
toMustache
    [ α -> Value
forall ω. ToMustache ω => ω -> Value
toMustache α
a
    , β -> Value
forall ω. ToMustache ω => ω -> Value
toMustache β
b
    , γ -> Value
forall ω. ToMustache ω => ω -> Value
toMustache γ
c
    , δ -> Value
forall ω. ToMustache ω => ω -> Value
toMustache δ
d
    , ε -> Value
forall ω. ToMustache ω => ω -> Value
toMustache ε
e
    , ζ -> Value
forall ω. ToMustache ω => ω -> Value
toMustache ζ
f
    , η -> Value
forall ω. ToMustache ω => ω -> Value
toMustache η
g
    , θ -> Value
forall ω. ToMustache ω => ω -> Value
toMustache θ
h
    ]

-- | A collection of templates with quick access via their hashed names
type TemplateCache = HM.HashMap String Template

-- | Type of key used for retrieving data from 'Value's
type Key = Text

{-|
  A compiled Template with metadata.
-}
data Template = Template
  { Template -> String
name     :: String
  , Template -> STree
ast      :: STree
  , Template -> TemplateCache
partials :: TemplateCache
  } deriving (Int -> Template -> ShowS
[Template] -> ShowS
Template -> String
(Int -> Template -> ShowS)
-> (Template -> String) -> ([Template] -> ShowS) -> Show Template
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Template] -> ShowS
$cshowList :: [Template] -> ShowS
show :: Template -> String
$cshow :: Template -> String
showsPrec :: Int -> Template -> ShowS
$cshowsPrec :: Int -> Template -> ShowS
Show)


deriveLift ''DataIdentifier
deriveLift ''Node
deriveLift ''Template

-- Data.HashMap 0.2.17.0 introduces its own Lift instance
#if !MIN_VERSION_unordered_containers(0,2,17)
instance Lift TemplateCache where
#if MIN_VERSION_template_haskell(2,16,0)
  liftTyped m = [|| HM.fromList $$(liftTyped $ HM.toList m) ||]
#else
  lift m = [| HM.fromList $(lift $ HM.toList m) |]
#endif
#endif

--Data.Text 1.2.4.0 introduces its own Lift Text instance
#if !MIN_VERSION_text(1,2,4)
instance Lift Text where
  lift :: Text -> Q Exp
lift = String -> Q Exp
forall t. Lift t => t -> Q Exp
lift (String -> Q Exp) -> (Text -> String) -> Text -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack
#endif