mustache 2.0.1 → 2.1
raw patch · 4 files changed
+145/−51 lines, 4 files
Files
- CHANGELOG.md +5/−0
- mustache.cabal +2/−2
- src/Text/Mustache/Render.hs +115/−44
- src/Text/Mustache/Types.hs +23/−5
CHANGELOG.md view
@@ -1,5 +1,10 @@ # Mustache library changelog +# v2.1++- Added API preserving checked substitution with 'checkedSubstitute' and 'checkedSubstituteValue'+- Better and more ToMustache instances. No longer are all sequences of characters serialised as strings+ ## v2.0 - Added QuasiQuotes and template Haskell functions for compile time template embedding.
mustache.cabal view
@@ -1,5 +1,5 @@ name: mustache-version: 2.0.1+version: 2.1 synopsis: A mustache template parser library. description: Allows parsing and rendering template files with mustache markup. See the@@ -33,7 +33,7 @@ type: git branch: master location: git://github.com/JustusAdam/mustache.git- tag: v2.0+ tag: v2.1
src/Text/Mustache/Render.hs view
@@ -12,6 +12,8 @@ ( -- * Substitution substitute, substituteValue+ -- * Checked substitution+ , checkedSubstitute, checkedSubstituteValue, SubstitutionError(..) -- * Working with Context , Context(..), search, innerSearch -- * Util@@ -20,24 +22,47 @@ import Control.Applicative ((<|>))-import Control.Arrow (first)+import Control.Arrow (first, second) import Control.Monad -import Data.Foldable (fold)+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, null, pack,- replace, stripSuffix)+import Data.Text as T (Text, isSuffixOf, pack, replace,+ stripSuffix) import qualified Data.Vector as V import Prelude hiding (length, lines, unlines) -import Data.Monoid ((<>))+import Control.Monad.Writer+import qualified Data.Text as T import Text.Mustache.Internal 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.@@ -50,77 +75,122 @@ {-| Substitutes all mustache defined tokens (or tags) for values found in the+ provided data structure and report any errors and warnings encountered during+ substitution.++ This function always produces results, as in a fully substituted/rendered template,+ it never halts on errors. It simply reports them in the first part of the tuple.+ Sites with errors are usually substituted with empty string.++ The second value in the tuple is a template rendered with errors ignored.+ Therefore if you must enforce that there were no errors during substitution+ you must check that the error list in the first tuple value is empty.++ Equivalent to @checkedSubstituteValue . toMustache@.+-}+checkedSubstitute :: ToMustache k => Template -> k -> ([SubstitutionError], Text)+checkedSubstitute t = checkedSubstituteValue t . toMustache+++{-|+ Substitutes all mustache defined tokens (or tags) for values found in the provided data structure. -} substituteValue :: Template -> Value -> Text-substituteValue (Template { ast = cAst, partials = cPartials }) dataStruct =- joinSubstituted (substitute' (Context mempty dataStruct)) cAst- where- joinSubstituted f = fold . fmap f+substituteValue = (snd .) . checkedSubstituteValue ++{-|+ Substitutes all mustache defined tokens (or tags) for values found in the+ provided data structure and report any errors and warnings encountered during+ substitution.++ This function always produces results, as in a fully substituted/rendered template,+ it never halts on errors. It simply reports them in the first part of the tuple.+ Sites with errors are usually substituted with empty string.++ The second value in the tuple is a template rendered with errors ignored.+ Therefore if you must enforce that there were no errors during substitution+ you must check that the error list in the first tuple value is empty.+-}+checkedSubstituteValue :: Template -> Value -> ([SubstitutionError], Text)+checkedSubstituteValue (Template { ast = cAst, partials = cPartials }) dataStruct =+ second T.concat $ execWriter $ mapM (substitute' (Context mempty dataStruct)) cAst+ where -- Main substitution function- substitute' :: Context Value -> Node Text -> Text+ substitute' :: Context Value -> Node Text -> Substitution () -- subtituting text- substitute' _ (TextBlock t) = t+ 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 = mempty- | otherwise = flip joinSubstituted a $ \focus' ->+ | V.null a = return ()+ | otherwise = for_ a $ \focus' -> let newContext = Context (focus:parents) focus' in- joinSubstituted (substitute' newContext) secSTree+ mapM_ (substitute' newContext) secSTree substitute' context@(Context _ (Object _)) (Section Implicit secSTree) =- joinSubstituted (substitute' context) secSTree- substitute' _ (Section Implicit _) = mempty+ 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 mempty- else flip joinSubstituted arrCont $ \focus' ->+ then return ()+ else for_ arrCont $ \focus' -> let newContext = Context (arr:focus:parents) focus' in- joinSubstituted (substitute' newContext) secSTree- Just (Bool False) -> mempty- Just (Lambda l) -> joinSubstituted (substitute' context) (l context secSTree)+ mapM_ (substitute' newContext) secSTree+ Just (Bool False) -> return ()+ Just (Lambda l) -> mapM_ (substitute' context) (l context secSTree) Just focus' -> let newContext = Context (focus:parents) focus' in- joinSubstituted (substitute' newContext) secSTree- Nothing -> mempty+ mapM_ (substitute' newContext) secSTree+ Nothing -> tellError $ SectionTargetNotFound secName -- substituting an inverted section- substitute' _ (InvertedSection Implicit _ ) = mempty+ 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- _ -> mempty+ _ -> return () where- contents = joinSubstituted (substitute' context) invSecSTree+ contents = mapM_ (substitute' context) invSecSTree -- substituting a variable- substitute' (Context _ current) (Variable _ Implicit) = toString current+ substitute' (Context _ current) (Variable _ Implicit) = toString current >>= tellSuccess substitute' context (Variable escaped (NamedData varName)) = maybe- mempty- (if escaped then escapeXMLText else id)- $ toString <$> search context varName+ (tellError $ VariableNotFound varName)+ (toString >=> tellSuccess . (if escaped then escapeXMLText else id))+ $ search context varName -- substituting a partial substitute' context (Partial indent pName) = maybe- mempty- (joinSubstituted (substitute' context) . handleIndent indent . ast)+ (tellError $ PartialNotFound pName)+ (mapM_ (substitute' context) . handleIndent indent . ast) $ HM.lookup pName cPartials +showValueType :: Value -> String+showValueType Null = "Null"+showValueType (Object _) = "Object"+showValueType (Array _) = "Array"+showValueType (String _) = "String"+showValueType (Lambda _) = "Lambda"+showValueType (Number _) = "Number"+showValueType (Bool _) = "Bool"++ handleIndent :: Maybe Text -> STree -> STree handleIndent Nothing ast' = ast' handleIndent (Just indentation) ast' = preface <> content@@ -149,16 +219,15 @@ search _ [] = Nothing search ctx keys@(_:nextKeys) = go ctx keys >>= innerSearch nextKeys where- go _ [] = Nothing- go (Context parents focus) val@(x:_) =- ( case focus of- (Object o) -> HM.lookup x o- _ -> Nothing- )- <|> ( do+ go _ [] = Nothing+ go (Context parents focus) val@(x:_) = searchCurrentContext <|> searchParentContext+ where+ searchCurrentContext = case focus of+ (Object o) -> HM.lookup x o+ _ -> Nothing+ searchParentContext = do (newFocus, newParents) <- uncons parents go (Context newParents newFocus) val- ) indentBy :: Text -> Node Text -> Node Text indentBy indent p@(Partial (Just indent') name')@@ -178,7 +247,9 @@ -- | Converts values to Text as required by the mustache standard-toString :: Value -> Text-toString (String t) = t-toString (Number n) = either (pack . show) (pack . show) (floatingOrInteger n :: Either Double Integer)-toString e = pack $ show e+toString :: Value -> Substitution 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
src/Text/Mustache/Types.hs view
@@ -36,10 +36,13 @@ import qualified Data.Aeson as Aeson-import Data.HashMap.Strict as HM+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@@ -101,11 +104,16 @@ 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 = Array . V.fromList . fmap toMustache+ listToMustache = listToMustache' instance ToMustache Float where toMustache = Number . fromFloatDigits@@ -132,6 +140,10 @@ 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 @@ -144,8 +156,11 @@ instance ToMustache α => ToMustache [α] where toMustache = listToMustache +instance ToMustache ω => ToMustache (Seq.Seq ω) where+ toMustache = listToMustache' . toList+ instance ToMustache ω => ToMustache (V.Vector ω) where- toMustache = toMustache . fmap toMustache+ toMustache = Array . fmap toMustache instance (ToMustache ω) => ToMustache (Map.Map Text ω) where toMustache = mapInstanceHelper id@@ -164,7 +179,7 @@ HM.empty instance ToMustache ω => ToMustache (HM.HashMap Text ω) where- toMustache = toMustache . fmap toMustache+ toMustache = Object . fmap toMustache instance ToMustache ω => ToMustache (HM.HashMap LT.Text ω) where toMustache = hashMapInstanceHelper LT.toStrict@@ -215,7 +230,10 @@ toMustache Aeson.Null = Null instance ToMustache ω => ToMustache (HS.HashSet ω) where- toMustache = toMustache . HS.toList+ 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]