{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Text.Mustache.Type
( Template (..),
Node (..),
Key (..),
showKey,
PName (..),
MustacheException (..),
MustacheWarning (..),
displayMustacheWarning,
)
where
import Control.DeepSeq
import Control.Exception (Exception (..))
import Data.Data (Data)
import Data.Map (Map)
import qualified Data.Map as M
import Data.String (IsString (..))
import Data.Text (Text)
import qualified Data.Text as T
import Data.Typeable (Typeable, cast)
import Data.Void
import GHC.Generics
import qualified Language.Haskell.TH.Syntax as TH
import Text.Megaparsec
data Template = Template
{
templateActual :: PName,
templateCache :: Map PName [Node]
}
deriving (Eq, Ord, Show, Data, Typeable, Generic)
instance Semigroup Template where
(Template pname x) <> (Template _ y) = Template pname (M.union x y)
instance TH.Lift Template where
lift = liftData
#if MIN_VERSION_template_haskell(2,16,0)
liftTyped = TH.unsafeTExpCoerce . TH.lift
#endif
data Node
=
TextBlock Text
|
EscapedVar Key
|
UnescapedVar Key
|
Section Key [Node]
|
InvertedSection Key [Node]
|
Partial PName (Maybe Pos)
deriving (Eq, Ord, Show, Data, Typeable, Generic)
instance TH.Lift Node where
lift = liftData
#if MIN_VERSION_template_haskell(2,16,0)
liftTyped = TH.unsafeTExpCoerce . TH.lift
#endif
newtype Key = Key {unKey :: [Text]}
deriving (Eq, Ord, Show, Semigroup, Monoid, Data, Typeable, Generic)
instance NFData Key
instance TH.Lift Key where
lift = liftData
#if MIN_VERSION_template_haskell(2,16,0)
liftTyped = TH.unsafeTExpCoerce . TH.lift
#endif
showKey :: Key -> Text
showKey (Key []) = "<implicit>"
showKey (Key xs) = T.intercalate "." xs
newtype PName = PName {unPName :: Text}
deriving (Eq, Ord, Show, Data, Typeable, Generic)
instance IsString PName where
fromString = PName . T.pack
instance NFData PName
instance TH.Lift PName where
lift = liftData
#if MIN_VERSION_template_haskell(2,16,0)
liftTyped = TH.unsafeTExpCoerce . TH.lift
#endif
newtype MustacheException
=
MustacheParserException (ParseErrorBundle Text Void)
deriving (Eq, Show, Typeable, Generic)
instance Exception MustacheException where
displayException (MustacheParserException b) = errorBundlePretty b
data MustacheWarning
=
MustacheVariableNotFound Key
|
MustacheDirectlyRenderedValue Key
deriving (Eq, Show, Typeable, Generic)
displayMustacheWarning :: MustacheWarning -> String
displayMustacheWarning (MustacheVariableNotFound key) =
"Referenced value was not provided, key: " ++ T.unpack (showKey key)
displayMustacheWarning (MustacheDirectlyRenderedValue key) =
"Complex value rendered as such, key: " ++ T.unpack (showKey key)
liftData :: Data a => a -> TH.Q TH.Exp
liftData = TH.dataToExpQ (fmap liftText . cast)
liftText :: Text -> TH.Q TH.Exp
liftText t = TH.AppE (TH.VarE 'T.pack) <$> TH.lift (T.unpack t)