{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
module Text.Mustache.Internal.Types
( Array
, ASTree
, Context (..)
, DataIdentifier (..)
, Key
, Node (..)
, Object
, Pair
, STree
, SubM (..)
, SubstitutionError (..)
, Template (..)
, TemplateCache
, ToMustache (..)
, Value (..)
, innerSearch
, integralToMustache
, runSubM
, search
, shiftContext
, tellError
, tellSuccess
) where
import Control.Arrow ( Arrow (..) )
import Control.Monad.RWS
( MonadReader (..), MonadWriter (..), RWS, RWST (..), asks
, evalRWS
)
import qualified Data.Aeson as Aeson
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.KeyMap as KM
#endif
import Data.Foldable ( toList )
import qualified Data.HashMap.Strict as HM
import qualified Data.HashSet as HS
import Data.Int ( Int8, Int16, Int32, Int64 )
import qualified Data.Map as Map
import Data.Scientific ( Scientific, fromFloatDigits )
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
import Data.Text ( Text )
import qualified Data.Text as T
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)
#if !MIN_VERSION_unordered_containers(0,2,17) || !MIN_VERSION_text(1,2,4)
import Language.Haskell.TH.Syntax ( Lift (..) )
#endif
import Numeric.Natural ( Natural )
data SubstitutionError
= VariableNotFound [Key]
| InvalidImplicitSectionContextType String
| InvertedImplicitSection
| SectionTargetNotFound [Key]
| PartialNotFound FilePath
| DirectlyRenderedValue Value
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
$cshowsPrec :: Int -> SubstitutionError -> ShowS
showsPrec :: Int -> SubstitutionError -> ShowS
$cshow :: SubstitutionError -> String
show :: SubstitutionError -> String
$cshowList :: [SubstitutionError] -> ShowS
showList :: [SubstitutionError] -> ShowS
Show)
tellError :: SubstitutionError -> SubM ()
tellError :: SubstitutionError -> SubM ()
tellError SubstitutionError
e = RWS
(Context Value, TemplateCache) ([SubstitutionError], [Key]) () ()
-> SubM ()
forall a.
RWS
(Context Value, TemplateCache) ([SubstitutionError], [Key]) () a
-> SubM a
SubM (RWS
(Context Value, TemplateCache) ([SubstitutionError], [Key]) () ()
-> SubM ())
-> RWS
(Context Value, TemplateCache) ([SubstitutionError], [Key]) () ()
-> SubM ()
forall a b. (a -> b) -> a -> b
$ ([SubstitutionError], [Key])
-> RWS
(Context Value, TemplateCache) ([SubstitutionError], [Key]) () ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([SubstitutionError
e], [])
tellSuccess :: Text -> SubM ()
tellSuccess :: Key -> SubM ()
tellSuccess Key
s = RWS
(Context Value, TemplateCache) ([SubstitutionError], [Key]) () ()
-> SubM ()
forall a.
RWS
(Context Value, TemplateCache) ([SubstitutionError], [Key]) () a
-> SubM a
SubM (RWS
(Context Value, TemplateCache) ([SubstitutionError], [Key]) () ()
-> SubM ())
-> RWS
(Context Value, TemplateCache) ([SubstitutionError], [Key]) () ()
-> SubM ()
forall a b. (a -> b) -> a -> b
$ ([SubstitutionError], [Key])
-> RWS
(Context Value, TemplateCache) ([SubstitutionError], [Key]) () ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([], [Key
s])
newtype SubM a = SubM
{ forall a.
SubM a
-> RWS
(Context Value, TemplateCache) ([SubstitutionError], [Key]) () a
runSubM' :: RWS (Context Value, TemplateCache) ([SubstitutionError], [Text]) () a
}
deriving (Applicative SubM
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
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
$c>>= :: forall a b. SubM a -> (a -> SubM b) -> SubM b
>>= :: forall a b. SubM a -> (a -> SubM b) -> SubM b
$c>> :: forall a b. SubM a -> SubM b -> SubM b
>> :: forall a b. SubM a -> SubM b -> SubM b
$creturn :: forall a. a -> SubM a
return :: forall a. a -> SubM a
Monad, (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
$cfmap :: forall a b. (a -> b) -> SubM a -> SubM b
fmap :: forall a b. (a -> b) -> SubM a -> SubM b
$c<$ :: forall a b. a -> SubM b -> SubM a
<$ :: forall a b. a -> SubM b -> SubM a
Functor, Functor SubM
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
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
$cpure :: forall a. a -> SubM a
pure :: forall a. a -> SubM a
$c<*> :: forall a b. SubM (a -> b) -> SubM a -> SubM b
<*> :: forall a b. SubM (a -> b) -> SubM a -> SubM b
$cliftA2 :: forall a b c. (a -> b -> c) -> SubM a -> SubM b -> SubM c
liftA2 :: forall a b c. (a -> b -> c) -> SubM a -> SubM b -> SubM c
$c*> :: forall a b. SubM a -> SubM b -> SubM b
*> :: forall a b. SubM a -> SubM b -> SubM b
$c<* :: forall a b. SubM a -> SubM b -> SubM a
<* :: forall a b. SubM a -> SubM b -> SubM a
Applicative, MonadReader (Context Value, TemplateCache))
runSubM :: SubM a -> Context Value -> TemplateCache -> ([SubstitutionError], [Text])
runSubM :: forall a.
SubM a
-> Context Value -> TemplateCache -> ([SubstitutionError], [Key])
runSubM SubM a
comp Context Value
ctx TemplateCache
cache = (a, ([SubstitutionError], [Key])) -> ([SubstitutionError], [Key])
forall a b. (a, b) -> b
snd ((a, ([SubstitutionError], [Key])) -> ([SubstitutionError], [Key]))
-> (a, ([SubstitutionError], [Key]))
-> ([SubstitutionError], [Key])
forall a b. (a -> b) -> a -> b
$ RWS
(Context Value, TemplateCache) ([SubstitutionError], [Key]) () a
-> (Context Value, TemplateCache)
-> ()
-> (a, ([SubstitutionError], [Key]))
forall r w s a. RWS r w s a -> r -> s -> (a, w)
evalRWS (SubM a
-> RWS
(Context Value, TemplateCache) ([SubstitutionError], [Key]) () a
forall a.
SubM a
-> RWS
(Context Value, TemplateCache) ([SubstitutionError], [Key]) () a
runSubM' SubM a
comp) (Context Value
ctx, TemplateCache
cache) ()
shiftContext :: Context Value -> SubM a -> SubM a
shiftContext :: forall a. Context Value -> SubM a -> SubM a
shiftContext = ((Context Value, TemplateCache) -> (Context Value, TemplateCache))
-> SubM a -> SubM a
forall a.
((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 b c d. (b -> c) -> (b, d) -> (c, d)
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 :: [Key] -> SubM (Maybe Value)
search :: [Key] -> SubM (Maybe Value)
search [] = Maybe Value -> SubM (Maybe Value)
forall a. a -> SubM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Value
forall a. Maybe a
Nothing
search (Key
key:[Key]
nextKeys) = (Maybe Value -> (Value -> Maybe Value) -> Maybe Value
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Key] -> Value -> Maybe Value
innerSearch [Key]
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 a b. SubM a -> (a -> SubM b) -> SubM b
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)
go
[Value]
_ -> Maybe Value -> SubM (Maybe Value)
forall a. a -> SubM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Value
forall a. Maybe a
Nothing
case Value
focus of
Object Object
o ->
case Key -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Key
key Object
o of
Just Value
res -> Maybe Value -> SubM (Maybe Value)
forall a. a -> SubM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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
innerSearch :: [Key] -> Value -> Maybe Value
innerSearch :: [Key] -> Value -> Maybe Value
innerSearch [] Value
v = Value -> Maybe Value
forall a. a -> Maybe a
Just Value
v
innerSearch (Key
y:[Key]
ys) (Object Object
o) = Key -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Key
y Object
o Maybe Value -> (Value -> Maybe Value) -> Maybe Value
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Key] -> Value -> Maybe Value
innerSearch [Key]
ys
innerSearch [Key]
_ Value
_ = Maybe Value
forall a. Maybe a
Nothing
type STree = ASTree Text
type ASTree α = [Node α]
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
$cshowsPrec :: forall α. Show α => Int -> Node α -> ShowS
showsPrec :: Int -> Node α -> ShowS
$cshow :: forall α. Show α => Node α -> String
show :: Node α -> String
$cshowList :: forall α. Show α => [Node α] -> ShowS
showList :: [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
$c== :: forall α. Eq α => Node α -> Node α -> Bool
== :: Node α -> Node α -> Bool
$c/= :: forall α. Eq α => Node α -> Node α -> Bool
/= :: Node α -> Node α -> Bool
Eq)
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
$cshowsPrec :: Int -> DataIdentifier -> ShowS
showsPrec :: Int -> DataIdentifier -> ShowS
$cshow :: DataIdentifier -> String
show :: DataIdentifier -> String
$cshowList :: [DataIdentifier] -> ShowS
showList :: [DataIdentifier] -> ShowS
Show, DataIdentifier -> DataIdentifier -> Bool
(DataIdentifier -> DataIdentifier -> Bool)
-> (DataIdentifier -> DataIdentifier -> Bool) -> Eq DataIdentifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DataIdentifier -> DataIdentifier -> Bool
== :: DataIdentifier -> DataIdentifier -> Bool
$c/= :: DataIdentifier -> DataIdentifier -> Bool
/= :: DataIdentifier -> DataIdentifier -> Bool
Eq)
type Array = V.Vector Value
type Object = HM.HashMap Text Value
type Pair = (Text, Value)
data Context α = Context { forall α. Context α -> [α]
ctxtParents :: [α], forall α. 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
$c== :: forall α. Eq α => Context α -> Context α -> Bool
== :: Context α -> Context α -> Bool
$c/= :: forall α. Eq α => Context α -> Context α -> Bool
/= :: 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
$cshowsPrec :: forall α. Show α => Int -> Context α -> ShowS
showsPrec :: Int -> Context α -> ShowS
$cshow :: forall α. Show α => Context α -> String
show :: Context α -> String
$cshowList :: forall α. Show α => [Context α] -> ShowS
showList :: [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 α
$ccompare :: forall α. Ord α => Context α -> Context α -> Ordering
compare :: Context α -> Context α -> Ordering
$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
>= :: Context α -> Context α -> Bool
$cmax :: forall α. Ord α => Context α -> Context α -> Context α
max :: Context α -> Context α -> Context α
$cmin :: forall α. Ord α => Context α -> Context α -> Context α
min :: Context α -> Context α -> Context α
Ord)
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 Key
s) = Key -> String
forall a. Show a => a -> String
show Key
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' :: forall ω. ToMustache ω => [ω] -> 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 a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ω -> Value
forall ω. ToMustache ω => ω -> Value
toMustache
integralToMustache :: Integral ω => ω -> Value
integralToMustache :: forall ω. Integral ω => ω -> 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
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 = Key -> Value
String (Key -> Value) -> (String -> Key) -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Key
T.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 :: Key -> Value
toMustache = Key -> Value
String
instance ToMustache LT.Text where
toMustache :: Text -> Value
toMustache = Key -> Value
String (Key -> Value) -> (Text -> Key) -> Text -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Key
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 a. Seq a -> [a]
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 a b. (a -> b) -> Vector a -> Vector b
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 Key ω -> Value
toMustache = (Key -> Key) -> Map Key ω -> Value
forall v a. ToMustache v => (a -> Key) -> Map a v -> Value
mapInstanceHelper Key -> Key
forall a. a -> a
id
instance (ToMustache ω) => ToMustache (Map.Map LT.Text ω) where
toMustache :: Map Text ω -> Value
toMustache = (Text -> Key) -> Map Text ω -> Value
forall v a. ToMustache v => (a -> Key) -> Map a v -> Value
mapInstanceHelper Text -> Key
LT.toStrict
instance (ToMustache ω) => ToMustache (Map.Map String ω) where
toMustache :: Map String ω -> Value
toMustache = (String -> Key) -> Map String ω -> Value
forall v a. ToMustache v => (a -> Key) -> Map a v -> Value
mapInstanceHelper String -> Key
T.pack
mapInstanceHelper :: ToMustache v => (a -> Text) -> Map.Map a v -> Value
mapInstanceHelper :: forall v a. ToMustache v => (a -> Key) -> Map a v -> Value
mapInstanceHelper a -> Key
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 -> Key -> Value -> Object -> Object
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert (a -> Key
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 Key ω -> Value
toMustache = Object -> Value
Object (Object -> Value)
-> (HashMap Key ω -> Object) -> HashMap Key ω -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ω -> Value) -> HashMap Key ω -> Object
forall a b. (a -> b) -> HashMap Key a -> HashMap Key b
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 -> Key) -> HashMap Text ω -> Value
forall v a. ToMustache v => (a -> Key) -> HashMap a v -> Value
hashMapInstanceHelper Text -> Key
LT.toStrict
instance ToMustache ω => ToMustache (HM.HashMap String ω) where
toMustache :: HashMap String ω -> Value
toMustache = (String -> Key) -> HashMap String ω -> Value
forall v a. ToMustache v => (a -> Key) -> HashMap a v -> Value
hashMapInstanceHelper String -> Key
T.pack
hashMapInstanceHelper :: ToMustache v => (a -> Text) -> HM.HashMap a v -> Value
hashMapInstanceHelper :: forall v a. ToMustache v => (a -> Key) -> HashMap a v -> Value
hashMapInstanceHelper a -> Key
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 -> Key -> Value -> Object -> Object
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert (a -> Key
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 Key Value -> Object
forall a b. (a -> b) -> HashMap Key a -> HashMap Key b
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 Key Value
forall v. KeyMap v -> HashMap Key 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 a b. (a -> b) -> Vector a -> Vector b
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 Key
s) = Key -> Value
String Key
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
]
type TemplateCache = HM.HashMap String Template
type Key = Text
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
$cshowsPrec :: Int -> Template -> ShowS
showsPrec :: Int -> Template -> ShowS
$cshow :: Template -> String
show :: Template -> String
$cshowList :: [Template] -> ShowS
showList :: [Template] -> ShowS
Show)
deriveLift ''DataIdentifier
deriveLift ''Node
deriveLift ''Template
#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
#if !MIN_VERSION_text(1,2,4)
instance Lift Text where
lift = lift . T.unpack
#endif