module Text.Mustache.Types
(
ASTree
, STree
, Node(..)
, DataIdentifier(..)
, Template(..)
, TemplateCache
, Value(..)
, Key
, object
, (~>), (↝), (~=), (⥱)
, ToMustache, toMustache, mFromJSON
, Array, Object, Pair
, Context(..)
) where
import qualified Data.Aeson as Aeson
import Data.HashMap.Strict as HM
import qualified Data.HashSet as HS
import qualified Data.Map as Map
import Data.Scientific
import Data.Text
import qualified Data.Text.Lazy as LT
import qualified Data.Vector as V
import Language.Haskell.TH.Lift (Lift (lift), deriveLift)
type STree = ASTree Text
type ASTree α = [Node α]
data Node α
= TextBlock α
| Section DataIdentifier (ASTree α)
| InvertedSection DataIdentifier (ASTree α)
| Variable Bool DataIdentifier
| Partial (Maybe α) FilePath
deriving (Show, Eq)
data DataIdentifier
= NamedData [Key]
| Implicit
deriving (Show, Eq)
type Array = V.Vector Value
type Object = HM.HashMap Text Value
type Pair = (Text, Value)
data Context α = Context [α] α
deriving (Eq, Show, Ord)
data Value
= Object !Object
| Array !Array
| Number !Scientific
| String !Text
| Lambda (Context Value -> STree -> STree)
| Bool !Bool
| Null
instance Show Value where
show (Lambda _) = "Lambda function"
show (Object o) = show o
show (Array a) = show a
show (String s) = show s
show (Number n) = show n
show (Bool b) = show b
show Null = "null"
class ToMustache ω where
toMustache :: ω -> Value
listToMustache :: [ω] -> Value
listToMustache = Array . V.fromList . fmap toMustache
instance ToMustache Float where
toMustache = Number . fromFloatDigits
instance ToMustache Double where
toMustache = Number . fromFloatDigits
instance ToMustache Integer where
toMustache = Number . fromInteger
instance ToMustache Int where
toMustache = toMustache . toInteger
instance ToMustache Char where
toMustache = toMustache . (:[])
listToMustache = String . pack
instance ToMustache Value where
toMustache = id
instance ToMustache Bool where
toMustache = Bool
instance ToMustache () where
toMustache = const Null
instance ToMustache Text where
toMustache = String
instance ToMustache LT.Text where
toMustache = String . LT.toStrict
instance ToMustache Scientific where
toMustache = Number
instance ToMustache α => ToMustache [α] where
toMustache = listToMustache
instance ToMustache ω => ToMustache (V.Vector ω) where
toMustache = toMustache . fmap toMustache
instance (ToMustache ω) => ToMustache (Map.Map Text ω) where
toMustache = mapInstanceHelper id
instance (ToMustache ω) => ToMustache (Map.Map LT.Text ω) where
toMustache = mapInstanceHelper LT.toStrict
instance (ToMustache ω) => ToMustache (Map.Map String ω) where
toMustache = mapInstanceHelper pack
mapInstanceHelper :: ToMustache v => (a -> Text) -> Map.Map a v -> Value
mapInstanceHelper conv =
toMustache
. Map.foldrWithKey
(\k -> HM.insert (conv k) . toMustache)
HM.empty
instance ToMustache ω => ToMustache (HM.HashMap Text ω) where
toMustache = toMustache . fmap toMustache
instance ToMustache ω => ToMustache (HM.HashMap LT.Text ω) where
toMustache = hashMapInstanceHelper LT.toStrict
instance ToMustache ω => ToMustache (HM.HashMap String ω) where
toMustache = hashMapInstanceHelper pack
hashMapInstanceHelper :: ToMustache v => (a -> Text) -> HM.HashMap a v -> Value
hashMapInstanceHelper conv =
toMustache
. HM.foldrWithKey
(\k -> HM.insert (conv k) . toMustache)
HM.empty
instance ToMustache (Context Value -> STree -> STree) where
toMustache = Lambda
instance ToMustache (Context Value -> STree -> Text) where
toMustache = lambdaInstanceHelper id
instance ToMustache (Context Value -> STree -> LT.Text) where
toMustache = lambdaInstanceHelper LT.toStrict
instance ToMustache (Context Value -> STree -> String) where
toMustache = lambdaInstanceHelper pack
lambdaInstanceHelper :: (a -> Text) -> (Context Value -> STree -> a) -> Value
lambdaInstanceHelper conv f = Lambda wrapper
where
wrapper :: Context Value -> STree -> STree
wrapper c lSTree = return . TextBlock $ conv $ f c lSTree
instance ToMustache (STree -> STree) where
toMustache f = toMustache (const f :: Context Value -> STree -> STree)
instance ToMustache (STree -> Text) where
toMustache f = toMustache wrapper
where
wrapper :: Context Value -> STree -> STree
wrapper _ = (return . TextBlock) . f
instance ToMustache Aeson.Value where
toMustache (Aeson.Object o) = Object $ fmap toMustache o
toMustache (Aeson.Array a) = Array $ fmap toMustache a
toMustache (Aeson.Number n) = Number n
toMustache (Aeson.String s) = String s
toMustache (Aeson.Bool b) = Bool b
toMustache Aeson.Null = Null
instance ToMustache ω => ToMustache (HS.HashSet ω) where
toMustache = toMustache . HS.toList
instance (ToMustache α, ToMustache β) => ToMustache (α, β) where
toMustache (a, b) = toMustache [toMustache a, toMustache b]
instance (ToMustache α, ToMustache β, ToMustache γ)
=> ToMustache (α, β, γ) where
toMustache (a, b, c) = toMustache [toMustache a, toMustache b, toMustache c]
instance (ToMustache α, ToMustache β, ToMustache γ, ToMustache δ)
=> ToMustache (α, β, γ, δ) where
toMustache (a, b, c, d) = toMustache
[ toMustache a
, toMustache b
, toMustache c
, toMustache d
]
instance ( ToMustache α
, ToMustache β
, ToMustache γ
, ToMustache δ
, ToMustache ε
) => ToMustache (α, β, γ, δ, ε) where
toMustache (a, b, c, d, e) = toMustache
[ toMustache a
, toMustache b
, toMustache c
, toMustache d
, toMustache e
]
instance ( ToMustache α
, ToMustache β
, ToMustache γ
, ToMustache δ
, ToMustache ε
, ToMustache ζ
) => ToMustache (α, β, γ, δ, ε, ζ) where
toMustache (a, b, c, d, e, f) = toMustache
[ toMustache a
, toMustache b
, toMustache c
, toMustache d
, toMustache e
, toMustache f
]
instance ( ToMustache α
, ToMustache β
, ToMustache γ
, ToMustache δ
, ToMustache ε
, ToMustache ζ
, ToMustache η
) => ToMustache (α, β, γ, δ, ε, ζ, η) where
toMustache (a, b, c, d, e, f, g) = toMustache
[ toMustache a
, toMustache b
, toMustache c
, toMustache d
, toMustache e
, toMustache f
, toMustache g
]
instance ( ToMustache α
, ToMustache β
, ToMustache γ
, ToMustache δ
, ToMustache ε
, ToMustache ζ
, ToMustache η
, ToMustache θ
) => ToMustache (α, β, γ, δ, ε, ζ, η, θ) where
toMustache (a, b, c, d, e, f, g, h) = toMustache
[ toMustache a
, toMustache b
, toMustache c
, toMustache d
, toMustache e
, toMustache f
, toMustache g
, toMustache h
]
object :: [Pair] -> Value
object = Object . HM.fromList
(~>) :: ToMustache ω => Text -> ω -> Pair
(~>) t = (t, ) . toMustache
infixr 8 ~>
(↝) :: ToMustache ω => Text -> ω -> Pair
(↝) = (~>)
infixr 8 ↝
(~=) :: Aeson.ToJSON ι => Text -> ι -> Pair
(~=) t = (t ~>) . Aeson.toJSON
infixr 8 ~=
(⥱) :: Aeson.ToJSON ι => Text -> ι -> Pair
(⥱) = (~=)
infixr 8 ⥱
mFromJSON :: Aeson.ToJSON ι => ι -> Value
mFromJSON = toMustache . Aeson.toJSON
type TemplateCache = HM.HashMap String Template
type Key = Text
data Template = Template
{ name :: String
, ast :: STree
, partials :: TemplateCache
} deriving (Show)
instance Lift TemplateCache where
lift m = [| HM.fromList $(lift $ HM.toList m) |]
instance Lift Text where
lift = lift . unpack
deriveLift ''DataIdentifier
deriveLift ''Node
deriveLift ''Template