mustache 2.1.4 → 2.2
raw patch · 4 files changed
+490/−447 lines, 4 files
Files
- mustache.cabal +4/−1
- src/Text/Mustache/Internal/Types.hs +357/−0
- src/Text/Mustache/Render.hs +119/−136
- src/Text/Mustache/Types.hs +10/−310
mustache.cabal view
@@ -1,5 +1,5 @@ name: mustache-version: 2.1.4+version: 2.2 synopsis: A mustache template parser library. description: Allows parsing and rendering template files with mustache markup. See the@@ -44,6 +44,7 @@ , Text.Mustache.Compile , Text.Mustache.Render other-modules: Text.Mustache.Internal+ , Text.Mustache.Internal.Types other-extensions: NamedFieldPuns , OverloadedStrings , LambdaCase@@ -69,6 +70,8 @@ default-language: Haskell2010 ghc-options: -Wall+ default-extensions: LambdaCase+ , TupleSections executable haskell-mustache
+ src/Text/Mustache/Internal/Types.hs view
@@ -0,0 +1,357 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE FlexibleContexts #-}+{-# 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+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 Language.Haskell.TH.Lift (Lift (lift), deriveLift)+++-- | 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 (Show)+++tellError :: SubstitutionError -> SubM ()+tellError e = SubM $ tell ([e], [])+++tellSuccess :: Text -> SubM ()+tellSuccess s = SubM $ tell ([], [s])+++newtype SubM a = SubM { runSubM' :: RWS (Context Value, TemplateCache) ([SubstitutionError], [Text]) () a } deriving (Monad, Functor, Applicative, MonadReader (Context Value, TemplateCache))++runSubM :: SubM a -> Context Value -> TemplateCache -> ([SubstitutionError], [Text])+runSubM comp ctx cache = snd $ evalRWS (runSubM' comp) (ctx, cache) ()++shiftContext :: Context Value -> SubM a -> SubM a+shiftContext = local . first . 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 [] = return Nothing+search keys@(_:nextKeys) = (>>= innerSearch nextKeys) <$> go keys+ where+ go [] = return Nothing+ go val@(x:_) = do+ (Context parents focus) <- asks fst++ case focus of+ Object o ->+ case HM.lookup x o of+ Just res -> return $ Just res+ _ -> case parents of+ (newFocus: newParents) -> shiftContext (Context newParents newFocus) $ go val+ _ -> return Nothing+ _ -> return Nothing+++-- | 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 [] v = Just v+innerSearch (y:ys) (Object o) = HM.lookup y o >>= innerSearch ys+innerSearch _ _ = 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 (Show, Eq)+++-- | Kinds of identifiers for Variables and sections+data DataIdentifier+ = NamedData [Key]+ | Implicit+ deriving (Show, 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 { ctxtParents :: [α], ctxtFocus :: α }+ deriving (Eq, Show, 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 (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"+++listToMustache' :: ToMustache ω => [ω] -> Value+listToMustache' = Array . V.fromList . fmap toMustache+++-- | Conversion class+class ToMustache ω where+ toMustache :: ω -> Value+ listToMustache :: [ω] -> Value+ listToMustache = listToMustache'++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 ω => ToMustache (Maybe ω) where+ toMustache (Just w) = toMustache w+ toMustache Nothing = 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 (Seq.Seq ω) where+ toMustache = listToMustache' . toList++instance ToMustache ω => ToMustache (V.Vector ω) where+ toMustache = Array . 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 = Object . 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 (STree -> SubM STree) where+ toMustache = Lambda++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 = listToMustache' . HS.toList++instance ToMustache ω => ToMustache (Set.Set ω) where+ toMustache = listToMustache' . Set.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+ ]++-- | 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+ { 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+
src/Text/Mustache/Render.hs view
@@ -7,7 +7,11 @@ Stability : experimental Portability : POSIX -}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} module Text.Mustache.Render ( -- * Substitution@@ -15,54 +19,34 @@ -- * Checked substitution , checkedSubstitute, checkedSubstituteValue, SubstitutionError(..) -- * Working with Context- , Context(..), search, innerSearch+ , Context(..), search, innerSearch, SubM, substituteNode, substituteAST -- * Util , toString ) where -import Control.Applicative ((<|>))-import Control.Arrow (first, second)+import Control.Arrow (first, second) import Control.Monad -import Data.Foldable (for_)-import Data.HashMap.Strict as HM hiding (keys, map)-import Data.Maybe (fromMaybe)+import Data.Foldable (for_)+import Data.HashMap.Strict as HM hiding (keys, map)+import Data.Maybe (fromMaybe) -import Data.Scientific (floatingOrInteger)-import Data.Text as T (Text, isSuffixOf, pack, replace,- stripSuffix)-import qualified Data.Vector as V-import Prelude hiding (length, lines, unlines)+import Data.Scientific (floatingOrInteger)+import Data.Text as T (Text, isSuffixOf, pack,+ replace, stripSuffix)+import qualified Data.Vector as V+import Prelude hiding (length, lines, unlines) +import Control.Monad.Reader import Control.Monad.Writer-import qualified Data.Text as T+import qualified Data.Text as T+import qualified Data.Text.Lazy as LT import Text.Mustache.Internal+import Text.Mustache.Internal.Types import Text.Mustache.Types --- | 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 (Show)---type Substitution = Writer ([SubstitutionError], [Text])---tellError :: SubstitutionError -> Substitution ()-tellError e = tell ([e], [])---tellSuccess :: Text -> Substitution ()-tellSuccess s = tell ([], [s])-- {-| Substitutes all mustache defined tokens (or tags) for values found in the provided data structure.@@ -115,86 +99,88 @@ -} checkedSubstituteValue :: Template -> Value -> ([SubstitutionError], Text) checkedSubstituteValue template dataStruct =- second T.concat $ execWriter $ substituteASTWithValAndCache (ast template) (partials template) (Context mempty dataStruct)+ second T.concat $ runSubM (substituteAST (ast template)) (Context mempty dataStruct) (partials template) -substituteASTWithValAndCache :: STree -> TemplateCache -> Context Value -> Substitution ()-substituteASTWithValAndCache cAst cPartials ctx =- mapM_ (substitute' ctx) cAst- where- -- Main substitution function- substitute' :: Context Value -> Node Text -> Substitution ()+-- | Substitute an entire 'STree' rather than just a single 'Node'+substituteAST :: STree -> SubM ()+substituteAST = mapM_ substituteNode - -- subtituting text- substitute' _ (TextBlock t) = tellSuccess t - -- substituting a whole section (entails a focus shift)- substitute' (Context parents focus@(Array a)) (Section Implicit secSTree)- | V.null a = return ()- | otherwise = for_ a $ \focus' ->+-- | Main substitution function+substituteNode :: Node Text -> SubM ()++-- subtituting text+substituteNode (TextBlock t) = tellSuccess t++-- substituting a whole section (entails a focus shift)+substituteNode (Section Implicit secSTree) =+ asks fst >>= \case+ Context parents focus@(Array a)+ | V.null a -> return ()+ | otherwise -> for_ a $ \focus' -> let newContext = Context (focus:parents) focus' in- mapM_ (substitute' newContext) secSTree- substitute' context@(Context _ (Object _)) (Section Implicit secSTree) =- mapM_ (substitute' context) secSTree- substitute' (Context _ v) (Section Implicit _) =- tellError $ InvalidImplicitSectionContextType $ showValueType v- substitute' context@(Context parents focus) (Section (NamedData secName) secSTree) =- case search context secName of- Just arr@(Array arrCont) ->- if V.null arrCont- then return ()- else for_ arrCont $ \focus' ->- let- newContext = Context (arr:focus:parents) focus'- in- mapM_ (substitute' newContext) secSTree- Just (Bool False) -> return ()- Just Null -> return ()- Just (Lambda l) -> mapM_ (substitute' context) (l context secSTree)- Just focus' ->- let- newContext = Context (focus:parents) focus'- in- mapM_ (substitute' newContext) secSTree- Nothing -> tellError $ SectionTargetNotFound secName+ shiftContext newContext $ substituteAST secSTree+ Context _ (Object _) -> substituteAST secSTree+ Context _ v -> tellError $ InvalidImplicitSectionContextType $ showValueType v - -- substituting an inverted section- substitute' _ (InvertedSection Implicit _ ) = tellError InvertedImplicitSection- substitute' context (InvertedSection (NamedData secName) invSecSTree) =- case search context secName of- Just (Bool False) -> contents- Just (Array a) | V.null a -> contents- Nothing -> contents- _ -> return ()- where- contents = mapM_ (substitute' context) invSecSTree+substituteNode (Section (NamedData secName) secSTree) =+ search secName >>= \case+ Just arr@(Array arrCont) ->+ if V.null arrCont+ then return ()+ else do+ Context parents focus <- asks fst+ for_ arrCont $ \focus' ->+ let newContext = Context (arr:focus:parents) focus'+ in shiftContext newContext $ substituteAST secSTree+ Just (Bool False) -> return ()+ Just Null -> return ()+ Just (Lambda l) -> substituteAST =<< l secSTree+ Just focus' -> do+ Context parents focus <- asks fst+ let newContext = Context (focus:parents) focus'+ shiftContext newContext $ substituteAST secSTree+ Nothing -> tellError $ SectionTargetNotFound secName - -- substituting a variable- substitute' (Context _ current) (Variable _ Implicit) = toString current >>= tellSuccess- substitute' context (Variable escaped (NamedData varName)) =- maybe- (tellError $ VariableNotFound varName)- (toString >=> tellSuccess . (if escaped then escapeXMLText else id))- $ search context varName+-- substituting an inverted section+substituteNode (InvertedSection Implicit _) = tellError InvertedImplicitSection+substituteNode (InvertedSection (NamedData secName) invSecSTree) =+ search secName >>= \case+ Just (Bool False) -> contents+ Just (Array a) | V.null a -> contents+ Nothing -> contents+ _ -> return ()+ where+ contents = mapM_ substituteNode invSecSTree - -- substituting a partial- substitute' context (Partial indent pName) =- case HM.lookup pName cPartials of- Nothing -> tellError $ PartialNotFound pName- Just t ->- let ast' = handleIndent indent $ ast t- in substituteASTWithValAndCache ast' (partials t `HM.union` cPartials) context+-- substituting a variable+substituteNode (Variable _ Implicit) = asks (ctxtFocus . fst) >>= toString >>= tellSuccess+substituteNode (Variable escaped (NamedData varName)) =+ maybe+ (tellError $ VariableNotFound varName)+ (toString >=> tellSuccess . (if escaped then escapeXMLText else id))+ =<< search varName +-- substituting a partial+substituteNode (Partial indent pName) = do+ cPartials <- asks snd+ case HM.lookup pName cPartials of+ Nothing -> tellError $ PartialNotFound pName+ Just t ->+ let ast' = handleIndent indent $ ast t+ in local (second (partials t `HM.union`)) $ substituteAST ast' + showValueType :: Value -> String-showValueType Null = "Null"+showValueType Null = "Null" showValueType (Object _) = "Object"-showValueType (Array _) = "Array"+showValueType (Array _) = "Array" showValueType (String _) = "String" showValueType (Lambda _) = "Lambda" showValueType (Number _) = "Number"-showValueType (Bool _) = "Bool"+showValueType (Bool _) = "Bool" handleIndent :: Maybe Text -> STree -> STree@@ -204,36 +190,14 @@ preface = if T.null indentation then [] else [TextBlock indentation] content = if T.null indentation then ast'- else- let- fullIndented = fmap (indentBy indentation) ast'- dropper (TextBlock t) = TextBlock $- if ("\n" <> indentation) `isSuffixOf` t- then fromMaybe t $ stripSuffix indentation t- else t- dropper a = a- in- reverse $ fromMaybe [] (uncurry (:) . first dropper <$> uncons (reverse fullIndented))----- | 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 :: Context Value -> [Key] -> Maybe Value-search _ [] = Nothing-search ctx keys@(_:nextKeys) = go ctx keys >>= innerSearch nextKeys- where- go _ [] = Nothing- go (Context parents focus) val@(x:_) = searchCurrentContext <|> searchParentContext+ else reverse $ fromMaybe [] (uncurry (:) . first dropper <$> uncons (reverse fullIndented)) where- searchCurrentContext = case focus of- (Object o) -> HM.lookup x o- _ -> Nothing- searchParentContext = do- (newFocus, newParents) <- uncons parents- go (Context newParents newFocus) val+ fullIndented = fmap (indentBy indentation) ast'+ dropper (TextBlock t) = TextBlock $+ if ("\n" <> indentation) `isSuffixOf` t+ then fromMaybe t $ stripSuffix indentation t+ else t+ dropper a = a indentBy :: Text -> Node Text -> Node Text indentBy indent p@(Partial (Just indent') name')@@ -244,18 +208,37 @@ indentBy _ a = a --- | 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 [] v = Just v-innerSearch (y:ys) (Object o) = HM.lookup y o >>= innerSearch ys-innerSearch _ _ = Nothing - -- | Converts values to Text as required by the mustache standard-toString :: Value -> Substitution Text+toString :: Value -> SubM Text toString (String t) = return t toString (Number n) = return $ either (pack . show) (pack . show) (floatingOrInteger n :: Either Double Integer) toString e = do tellError $ DirectlyRenderedValue e return $ pack $ show e+++class ToText a where+ toText :: a -> Text++instance ToText Text where+ toText = id++instance ToText LT.Text where+ toText = LT.toStrict++instance ToText String where+ toText = pack+++instance ToMustache (Context Value -> STree -> STree) where+ toMustache f = Lambda $ (<$> askContext) . flip f++instance ToText t => ToMustache (Context Value -> STree -> t) where+ toMustache f = Lambda $ (<$> askContext) . wrapper+ where+ wrapper :: STree -> Context Value -> STree+ wrapper lSTree c = [TextBlock $ toText $ f c lSTree]++instance ToText t => ToMustache (STree -> SubM t) where+ toMustache f = Lambda (fmap (return . TextBlock . toText) . f)
src/Text/Mustache/Types.hs view
@@ -7,12 +7,6 @@ Stability : experimental Portability : POSIX -}-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TupleSections #-} module Text.Mustache.Types ( -- * Types for the Parser / Template@@ -31,294 +25,18 @@ , ToMustache, toMustache, mFromJSON -- ** Representation , Array, Object, Pair+ , SubM, askContext, askPartials , Context(..) ) where -import qualified Data.Aeson as Aeson-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 Language.Haskell.TH.Lift (Lift (lift), deriveLift)---- | 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 (Show, Eq)----- | Kinds of identifiers for Variables and sections-data DataIdentifier- = NamedData [Key]- | Implicit- deriving (Show, 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 [α] α- deriving (Eq, Show, Ord)---- | Internal value representation-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"---listToMustache' :: ToMustache ω => [ω] -> Value-listToMustache' = Array . V.fromList . fmap toMustache+import Control.Monad.Reader+import qualified Data.Aeson as Aeson+import qualified Data.HashMap.Strict as HM+import Data.Text (Text)+import Text.Mustache.Internal.Types --- | Conversion class-class ToMustache ω where- toMustache :: ω -> Value- listToMustache :: [ω] -> Value- listToMustache = listToMustache'--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 ω => ToMustache (Maybe ω) where- toMustache (Just w) = toMustache w- toMustache Nothing = 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 (Seq.Seq ω) where- toMustache = listToMustache' . toList--instance ToMustache ω => ToMustache (V.Vector ω) where- toMustache = Array . 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 = Object . 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 = listToMustache' . HS.toList--instance ToMustache ω => ToMustache (Set.Set ω) where- toMustache = listToMustache' . Set.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- ]- -- | Convenience function for creating Object values. -- -- This function is supposed to be used in conjuction with the '~>' and '~=' operators.@@ -384,27 +102,9 @@ mFromJSON = toMustache . Aeson.toJSON --- | A collection of templates with quick access via their hashed names-type TemplateCache = HM.HashMap String Template+askContext :: SubM (Context Value)+askContext = asks fst --- | Type of key used for retrieving data from 'Value's-type Key = Text -{-|- A compiled Template with metadata.--}-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+askPartials :: SubM TemplateCache+askPartials = asks snd