diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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. diff --git a/mustache.cabal b/mustache.cabal --- a/mustache.cabal +++ b/mustache.cabal @@ -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 diff --git a/src/Text/Mustache/Render.hs b/src/Text/Mustache/Render.hs --- a/src/Text/Mustache/Render.hs +++ b/src/Text/Mustache/Render.hs @@ -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 diff --git a/src/Text/Mustache/Types.hs b/src/Text/Mustache/Types.hs --- a/src/Text/Mustache/Types.hs +++ b/src/Text/Mustache/Types.hs @@ -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]