-- |
-- Module      :  Text.Microstache.Type
-- Copyright   :  © 2016–2017 Stack Buliders
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov@openmailbox.org>
-- Stability   :  experimental
-- Portability :  portable
--
-- Types used by the package. You don't usually need to import the module,
-- because "Text.Microstache" re-exports everything you may need, import that
-- module instead.

{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}

module Text.Microstache.Type
  ( Template (..)
  , Node (..)
  , Key (..)
  , showKey
  , PName (..)
  , MustacheException (..)
  , displayMustacheException
  , MustacheWarning (..)
  , displayMustacheWarning
  )
where

import Control.DeepSeq
import Control.Exception (Exception (..))
import Data.Data         (Data)
import Data.Map          (Map)
import Data.Semigroup
import Data.String       (IsString (..))
import Data.Text         (Text)
import Data.Typeable     (Typeable)
import Data.Word         (Word)
import GHC.Generics
import Text.Parsec

import qualified Data.Map  as Map
import qualified Data.Text as T

-- | Mustache template as name of “top-level” template and a collection of
-- all available templates (partials).
--
-- 'Template' is a 'Semigroup'. This means that you can combine 'Template's
-- (and their caches) using the @('<>')@ operator, the resulting 'Template'
-- will have the same currently selected template as the left one. Union of
-- caches is also left-biased.

data Template = Template
  { Template -> PName
templateActual :: PName
    -- ^ Name of currently “selected” template (top-level one).
  , Template -> Map PName [Node]
templateCache  :: Map PName [Node]
    -- ^ Collection of all templates that are available for interpolation
    -- (as partials). The top-level one is also contained here and the
    -- “focus” can be switched easily by modifying 'templateActual'.
  } deriving (Template -> Template -> Bool
(Template -> Template -> Bool)
-> (Template -> Template -> Bool) -> Eq Template
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Template -> Template -> Bool
$c/= :: Template -> Template -> Bool
== :: Template -> Template -> Bool
$c== :: Template -> Template -> Bool
Eq, Eq Template
Eq Template
-> (Template -> Template -> Ordering)
-> (Template -> Template -> Bool)
-> (Template -> Template -> Bool)
-> (Template -> Template -> Bool)
-> (Template -> Template -> Bool)
-> (Template -> Template -> Template)
-> (Template -> Template -> Template)
-> Ord Template
Template -> Template -> Bool
Template -> Template -> Ordering
Template -> Template -> Template
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Template -> Template -> Template
$cmin :: Template -> Template -> Template
max :: Template -> Template -> Template
$cmax :: Template -> Template -> Template
>= :: Template -> Template -> Bool
$c>= :: Template -> Template -> Bool
> :: Template -> Template -> Bool
$c> :: Template -> Template -> Bool
<= :: Template -> Template -> Bool
$c<= :: Template -> Template -> Bool
< :: Template -> Template -> Bool
$c< :: Template -> Template -> Bool
compare :: Template -> Template -> Ordering
$ccompare :: Template -> Template -> Ordering
$cp1Ord :: Eq Template
Ord, 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, Typeable Template
DataType
Constr
Typeable Template
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Template -> c Template)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Template)
-> (Template -> Constr)
-> (Template -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Template))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Template))
-> ((forall b. Data b => b -> b) -> Template -> Template)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Template -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Template -> r)
-> (forall u. (forall d. Data d => d -> u) -> Template -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Template -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Template -> m Template)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Template -> m Template)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Template -> m Template)
-> Data Template
Template -> DataType
Template -> Constr
(forall b. Data b => b -> b) -> Template -> Template
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Template -> c Template
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Template
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Template -> u
forall u. (forall d. Data d => d -> u) -> Template -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Template -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Template -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Template -> m Template
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Template -> m Template
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Template
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Template -> c Template
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Template)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Template)
$cTemplate :: Constr
$tTemplate :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Template -> m Template
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Template -> m Template
gmapMp :: (forall d. Data d => d -> m d) -> Template -> m Template
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Template -> m Template
gmapM :: (forall d. Data d => d -> m d) -> Template -> m Template
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Template -> m Template
gmapQi :: Int -> (forall d. Data d => d -> u) -> Template -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Template -> u
gmapQ :: (forall d. Data d => d -> u) -> Template -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Template -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Template -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Template -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Template -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Template -> r
gmapT :: (forall b. Data b => b -> b) -> Template -> Template
$cgmapT :: (forall b. Data b => b -> b) -> Template -> Template
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Template)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Template)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Template)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Template)
dataTypeOf :: Template -> DataType
$cdataTypeOf :: Template -> DataType
toConstr :: Template -> Constr
$ctoConstr :: Template -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Template
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Template
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Template -> c Template
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Template -> c Template
$cp1Data :: Typeable Template
Data, Typeable, (forall x. Template -> Rep Template x)
-> (forall x. Rep Template x -> Template) -> Generic Template
forall x. Rep Template x -> Template
forall x. Template -> Rep Template x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Template x -> Template
$cfrom :: forall x. Template -> Rep Template x
Generic)

instance Semigroup Template where
  (Template PName
pname Map PName [Node]
x) <> :: Template -> Template -> Template
<> (Template PName
_ Map PName [Node]
y) = PName -> Map PName [Node] -> Template
Template PName
pname (Map PName [Node] -> Map PName [Node] -> Map PName [Node]
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map PName [Node]
x Map PName [Node]
y)

-- | Structural element of template.

data Node
  = TextBlock       Text       -- ^ Plain text contained between tags
  | EscapedVar      Key        -- ^ HTML-escaped variable
  | UnescapedVar    Key        -- ^ Unescaped variable
  | Section         Key [Node] -- ^ Mustache section
  | InvertedSection Key [Node] -- ^ Inverted section
  | Partial         PName (Maybe Word)
    -- ^ Partial with indentation level ('Nothing' means it was inlined)
  deriving (Node -> Node -> Bool
(Node -> Node -> Bool) -> (Node -> Node -> Bool) -> Eq Node
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Node -> Node -> Bool
$c/= :: Node -> Node -> Bool
== :: Node -> Node -> Bool
$c== :: Node -> Node -> Bool
Eq, Eq Node
Eq Node
-> (Node -> Node -> Ordering)
-> (Node -> Node -> Bool)
-> (Node -> Node -> Bool)
-> (Node -> Node -> Bool)
-> (Node -> Node -> Bool)
-> (Node -> Node -> Node)
-> (Node -> Node -> Node)
-> Ord Node
Node -> Node -> Bool
Node -> Node -> Ordering
Node -> Node -> Node
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Node -> Node -> Node
$cmin :: Node -> Node -> Node
max :: Node -> Node -> Node
$cmax :: Node -> Node -> Node
>= :: Node -> Node -> Bool
$c>= :: Node -> Node -> Bool
> :: Node -> Node -> Bool
$c> :: Node -> Node -> Bool
<= :: Node -> Node -> Bool
$c<= :: Node -> Node -> Bool
< :: Node -> Node -> Bool
$c< :: Node -> Node -> Bool
compare :: Node -> Node -> Ordering
$ccompare :: Node -> Node -> Ordering
$cp1Ord :: Eq Node
Ord, Int -> Node -> ShowS
[Node] -> ShowS
Node -> String
(Int -> Node -> ShowS)
-> (Node -> String) -> ([Node] -> ShowS) -> Show Node
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Node] -> ShowS
$cshowList :: [Node] -> ShowS
show :: Node -> String
$cshow :: Node -> String
showsPrec :: Int -> Node -> ShowS
$cshowsPrec :: Int -> Node -> ShowS
Show, Typeable Node
DataType
Constr
Typeable Node
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Node -> c Node)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Node)
-> (Node -> Constr)
-> (Node -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Node))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Node))
-> ((forall b. Data b => b -> b) -> Node -> Node)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Node -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Node -> r)
-> (forall u. (forall d. Data d => d -> u) -> Node -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Node -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Node -> m Node)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Node -> m Node)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Node -> m Node)
-> Data Node
Node -> DataType
Node -> Constr
(forall b. Data b => b -> b) -> Node -> Node
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Node -> c Node
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Node
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Node -> u
forall u. (forall d. Data d => d -> u) -> Node -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Node -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Node -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Node -> m Node
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Node -> m Node
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Node
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Node -> c Node
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Node)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Node)
$cPartial :: Constr
$cInvertedSection :: Constr
$cSection :: Constr
$cUnescapedVar :: Constr
$cEscapedVar :: Constr
$cTextBlock :: Constr
$tNode :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Node -> m Node
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Node -> m Node
gmapMp :: (forall d. Data d => d -> m d) -> Node -> m Node
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Node -> m Node
gmapM :: (forall d. Data d => d -> m d) -> Node -> m Node
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Node -> m Node
gmapQi :: Int -> (forall d. Data d => d -> u) -> Node -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Node -> u
gmapQ :: (forall d. Data d => d -> u) -> Node -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Node -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Node -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Node -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Node -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Node -> r
gmapT :: (forall b. Data b => b -> b) -> Node -> Node
$cgmapT :: (forall b. Data b => b -> b) -> Node -> Node
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Node)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Node)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Node)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Node)
dataTypeOf :: Node -> DataType
$cdataTypeOf :: Node -> DataType
toConstr :: Node -> Constr
$ctoConstr :: Node -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Node
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Node
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Node -> c Node
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Node -> c Node
$cp1Data :: Typeable Node
Data, Typeable, (forall x. Node -> Rep Node x)
-> (forall x. Rep Node x -> Node) -> Generic Node
forall x. Rep Node x -> Node
forall x. Node -> Rep Node x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Node x -> Node
$cfrom :: forall x. Node -> Rep Node x
Generic)

-- | Identifier for values to interpolate.
--
-- The representation is the following:
--
--     * @[]@ — empty list means implicit iterators;
--     * @[text]@ — single key is a normal identifier;
--     * @[text1, text2]@ — multiple keys represent dotted names.

newtype Key = Key { Key -> [Text]
unKey :: [Text] }
  deriving (Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c== :: Key -> Key -> Bool
Eq, Eq Key
Eq Key
-> (Key -> Key -> Ordering)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Key)
-> (Key -> Key -> Key)
-> Ord Key
Key -> Key -> Bool
Key -> Key -> Ordering
Key -> Key -> Key
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Key -> Key -> Key
$cmin :: Key -> Key -> Key
max :: Key -> Key -> Key
$cmax :: Key -> Key -> Key
>= :: Key -> Key -> Bool
$c>= :: Key -> Key -> Bool
> :: Key -> Key -> Bool
$c> :: Key -> Key -> Bool
<= :: Key -> Key -> Bool
$c<= :: Key -> Key -> Bool
< :: Key -> Key -> Bool
$c< :: Key -> Key -> Bool
compare :: Key -> Key -> Ordering
$ccompare :: Key -> Key -> Ordering
$cp1Ord :: Eq Key
Ord, Int -> Key -> ShowS
[Key] -> ShowS
Key -> String
(Int -> Key -> ShowS)
-> (Key -> String) -> ([Key] -> ShowS) -> Show Key
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Key] -> ShowS
$cshowList :: [Key] -> ShowS
show :: Key -> String
$cshow :: Key -> String
showsPrec :: Int -> Key -> ShowS
$cshowsPrec :: Int -> Key -> ShowS
Show, b -> Key -> Key
NonEmpty Key -> Key
Key -> Key -> Key
(Key -> Key -> Key)
-> (NonEmpty Key -> Key)
-> (forall b. Integral b => b -> Key -> Key)
-> Semigroup Key
forall b. Integral b => b -> Key -> Key
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Key -> Key
$cstimes :: forall b. Integral b => b -> Key -> Key
sconcat :: NonEmpty Key -> Key
$csconcat :: NonEmpty Key -> Key
<> :: Key -> Key -> Key
$c<> :: Key -> Key -> Key
Semigroup, Semigroup Key
Key
Semigroup Key
-> Key -> (Key -> Key -> Key) -> ([Key] -> Key) -> Monoid Key
[Key] -> Key
Key -> Key -> Key
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Key] -> Key
$cmconcat :: [Key] -> Key
mappend :: Key -> Key -> Key
$cmappend :: Key -> Key -> Key
mempty :: Key
$cmempty :: Key
$cp1Monoid :: Semigroup Key
Monoid, Typeable Key
DataType
Constr
Typeable Key
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Key -> c Key)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Key)
-> (Key -> Constr)
-> (Key -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Key))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Key))
-> ((forall b. Data b => b -> b) -> Key -> Key)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r)
-> (forall u. (forall d. Data d => d -> u) -> Key -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Key -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Key -> m Key)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Key -> m Key)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Key -> m Key)
-> Data Key
Key -> DataType
Key -> Constr
(forall b. Data b => b -> b) -> Key -> Key
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Key -> c Key
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Key
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Key -> u
forall u. (forall d. Data d => d -> u) -> Key -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Key -> m Key
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Key -> m Key
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Key
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Key -> c Key
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Key)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Key)
$cKey :: Constr
$tKey :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Key -> m Key
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Key -> m Key
gmapMp :: (forall d. Data d => d -> m d) -> Key -> m Key
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Key -> m Key
gmapM :: (forall d. Data d => d -> m d) -> Key -> m Key
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Key -> m Key
gmapQi :: Int -> (forall d. Data d => d -> u) -> Key -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Key -> u
gmapQ :: (forall d. Data d => d -> u) -> Key -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Key -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r
gmapT :: (forall b. Data b => b -> b) -> Key -> Key
$cgmapT :: (forall b. Data b => b -> b) -> Key -> Key
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Key)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Key)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Key)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Key)
dataTypeOf :: Key -> DataType
$cdataTypeOf :: Key -> DataType
toConstr :: Key -> Constr
$ctoConstr :: Key -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Key
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Key
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Key -> c Key
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Key -> c Key
$cp1Data :: Typeable Key
Data, Typeable, (forall x. Key -> Rep Key x)
-> (forall x. Rep Key x -> Key) -> Generic Key
forall x. Rep Key x -> Key
forall x. Key -> Rep Key x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Key x -> Key
$cfrom :: forall x. Key -> Rep Key x
Generic)

instance NFData Key

-- | Pretty-print a key, this is helpful, for example, if you want to
-- display an error message.

showKey :: Key -> Text
showKey :: Key -> Text
showKey (Key []) = Text
"<implicit>"
showKey (Key [Text]
xs) = Text -> [Text] -> Text
T.intercalate Text
"." [Text]
xs

-- | Identifier for partials. Note that with the @OverloadedStrings@
-- extension you can use just string literals to create values of this type.

newtype PName = PName { PName -> Text
unPName :: Text }
  deriving (PName -> PName -> Bool
(PName -> PName -> Bool) -> (PName -> PName -> Bool) -> Eq PName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PName -> PName -> Bool
$c/= :: PName -> PName -> Bool
== :: PName -> PName -> Bool
$c== :: PName -> PName -> Bool
Eq, Eq PName
Eq PName
-> (PName -> PName -> Ordering)
-> (PName -> PName -> Bool)
-> (PName -> PName -> Bool)
-> (PName -> PName -> Bool)
-> (PName -> PName -> Bool)
-> (PName -> PName -> PName)
-> (PName -> PName -> PName)
-> Ord PName
PName -> PName -> Bool
PName -> PName -> Ordering
PName -> PName -> PName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PName -> PName -> PName
$cmin :: PName -> PName -> PName
max :: PName -> PName -> PName
$cmax :: PName -> PName -> PName
>= :: PName -> PName -> Bool
$c>= :: PName -> PName -> Bool
> :: PName -> PName -> Bool
$c> :: PName -> PName -> Bool
<= :: PName -> PName -> Bool
$c<= :: PName -> PName -> Bool
< :: PName -> PName -> Bool
$c< :: PName -> PName -> Bool
compare :: PName -> PName -> Ordering
$ccompare :: PName -> PName -> Ordering
$cp1Ord :: Eq PName
Ord, Int -> PName -> ShowS
[PName] -> ShowS
PName -> String
(Int -> PName -> ShowS)
-> (PName -> String) -> ([PName] -> ShowS) -> Show PName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PName] -> ShowS
$cshowList :: [PName] -> ShowS
show :: PName -> String
$cshow :: PName -> String
showsPrec :: Int -> PName -> ShowS
$cshowsPrec :: Int -> PName -> ShowS
Show, Typeable PName
DataType
Constr
Typeable PName
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> PName -> c PName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PName)
-> (PName -> Constr)
-> (PName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PName))
-> ((forall b. Data b => b -> b) -> PName -> PName)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PName -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PName -> r)
-> (forall u. (forall d. Data d => d -> u) -> PName -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> PName -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> PName -> m PName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PName -> m PName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PName -> m PName)
-> Data PName
PName -> DataType
PName -> Constr
(forall b. Data b => b -> b) -> PName -> PName
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PName -> c PName
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PName
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> PName -> u
forall u. (forall d. Data d => d -> u) -> PName -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PName -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PName -> m PName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PName -> m PName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PName -> c PName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PName)
$cPName :: Constr
$tPName :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> PName -> m PName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PName -> m PName
gmapMp :: (forall d. Data d => d -> m d) -> PName -> m PName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PName -> m PName
gmapM :: (forall d. Data d => d -> m d) -> PName -> m PName
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PName -> m PName
gmapQi :: Int -> (forall d. Data d => d -> u) -> PName -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PName -> u
gmapQ :: (forall d. Data d => d -> u) -> PName -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PName -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PName -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PName -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PName -> r
gmapT :: (forall b. Data b => b -> b) -> PName -> PName
$cgmapT :: (forall b. Data b => b -> b) -> PName -> PName
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PName)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c PName)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PName)
dataTypeOf :: PName -> DataType
$cdataTypeOf :: PName -> DataType
toConstr :: PName -> Constr
$ctoConstr :: PName -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PName
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PName -> c PName
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PName -> c PName
$cp1Data :: Typeable PName
Data, Typeable, (forall x. PName -> Rep PName x)
-> (forall x. Rep PName x -> PName) -> Generic PName
forall x. Rep PName x -> PName
forall x. PName -> Rep PName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PName x -> PName
$cfrom :: forall x. PName -> Rep PName x
Generic)

instance IsString PName where
  fromString :: String -> PName
fromString = Text -> PName
PName (Text -> PName) -> (String -> Text) -> String -> PName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

instance NFData PName

-- | Exception that is thrown when parsing of a template has failed or
-- referenced values were not provided.

data MustacheException
  = MustacheParserException ParseError
    -- ^ Template parser has failed. This contains the parse error.
  | MustacheRenderException PName Key
    -- ^ A referenced value was not provided. The exception provides info
    -- about partial in which the issue happened 'PName' and name of the
    -- missing key 'Key'.
  deriving (MustacheException -> MustacheException -> Bool
(MustacheException -> MustacheException -> Bool)
-> (MustacheException -> MustacheException -> Bool)
-> Eq MustacheException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MustacheException -> MustacheException -> Bool
$c/= :: MustacheException -> MustacheException -> Bool
== :: MustacheException -> MustacheException -> Bool
$c== :: MustacheException -> MustacheException -> Bool
Eq, Int -> MustacheException -> ShowS
[MustacheException] -> ShowS
MustacheException -> String
(Int -> MustacheException -> ShowS)
-> (MustacheException -> String)
-> ([MustacheException] -> ShowS)
-> Show MustacheException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MustacheException] -> ShowS
$cshowList :: [MustacheException] -> ShowS
show :: MustacheException -> String
$cshow :: MustacheException -> String
showsPrec :: Int -> MustacheException -> ShowS
$cshowsPrec :: Int -> MustacheException -> ShowS
Show, Typeable, (forall x. MustacheException -> Rep MustacheException x)
-> (forall x. Rep MustacheException x -> MustacheException)
-> Generic MustacheException
forall x. Rep MustacheException x -> MustacheException
forall x. MustacheException -> Rep MustacheException x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MustacheException x -> MustacheException
$cfrom :: forall x. MustacheException -> Rep MustacheException x
Generic)

{-# DEPRECATED MustacheRenderException "Not thrown anymore, will be removed in the next major version of microstache" #-}

-- | @since 1.0.1
displayMustacheException :: MustacheException -> String
displayMustacheException :: MustacheException -> String
displayMustacheException (MustacheParserException ParseError
e) = ParseError -> String
forall a. Show a => a -> String
show ParseError
e
displayMustacheException (MustacheRenderException PName
pname Key
key) =
    String
"Referenced value was not provided in partial \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack (PName -> Text
unPName PName
pname) String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
"\", key: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack (Key -> Text
showKey Key
key)

instance Exception MustacheException where
#if MIN_VERSION_base(4,8,0)
    displayException :: MustacheException -> String
displayException = MustacheException -> String
displayMustacheException
#endif

-- | @since 1.0.1
data MustacheWarning
  = MustacheVariableNotFound Key
    -- ^ The template contained a variable for which there was no data counterpart in the current context
  | MustacheDirectlyRenderedValue Key
    -- ^ A complex value such as an Object or Array was directly rendered into the template
  deriving (MustacheWarning -> MustacheWarning -> Bool
(MustacheWarning -> MustacheWarning -> Bool)
-> (MustacheWarning -> MustacheWarning -> Bool)
-> Eq MustacheWarning
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MustacheWarning -> MustacheWarning -> Bool
$c/= :: MustacheWarning -> MustacheWarning -> Bool
== :: MustacheWarning -> MustacheWarning -> Bool
$c== :: MustacheWarning -> MustacheWarning -> Bool
Eq, Int -> MustacheWarning -> ShowS
[MustacheWarning] -> ShowS
MustacheWarning -> String
(Int -> MustacheWarning -> ShowS)
-> (MustacheWarning -> String)
-> ([MustacheWarning] -> ShowS)
-> Show MustacheWarning
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MustacheWarning] -> ShowS
$cshowList :: [MustacheWarning] -> ShowS
show :: MustacheWarning -> String
$cshow :: MustacheWarning -> String
showsPrec :: Int -> MustacheWarning -> ShowS
$cshowsPrec :: Int -> MustacheWarning -> ShowS
Show, Typeable, (forall x. MustacheWarning -> Rep MustacheWarning x)
-> (forall x. Rep MustacheWarning x -> MustacheWarning)
-> Generic MustacheWarning
forall x. Rep MustacheWarning x -> MustacheWarning
forall x. MustacheWarning -> Rep MustacheWarning x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MustacheWarning x -> MustacheWarning
$cfrom :: forall x. MustacheWarning -> Rep MustacheWarning x
Generic)

-- | @since 1.0.1
displayMustacheWarning :: MustacheWarning -> String
displayMustacheWarning :: MustacheWarning -> String
displayMustacheWarning (MustacheVariableNotFound Key
key) =
    String
"Referenced value was not provided, key: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack (Key -> Text
showKey Key
key)
displayMustacheWarning (MustacheDirectlyRenderedValue Key
key) =
    String
"Complex value rendered as such, key: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack (Key -> Text
showKey Key
key)

instance Exception MustacheWarning where
#if MIN_VERSION_base(4,8,0)
    displayException :: MustacheWarning -> String
displayException = MustacheWarning -> String
displayMustacheWarning
#endif