Hello community, here is the log from the commit of package ghc-mustache for openSUSE:Factory checked in at 2017-08-31 20:57:25 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-mustache (Old) and /work/SRC/openSUSE:Factory/.ghc-mustache.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-mustache" Thu Aug 31 20:57:25 2017 rev:5 rq:513436 version:2.2.3 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-mustache/ghc-mustache.changes 2017-06-04 01:58:01.999421652 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-mustache.new/ghc-mustache.changes 2017-08-31 20:57:27.003099675 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:08:12 UTC 2017 - psimons@suse.com + +- Update to version 2.2.3. + +------------------------------------------------------------------- Old: ---- mustache-2.1.4.tar.gz New: ---- mustache-2.2.3.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-mustache.spec ++++++ --- /var/tmp/diff_new_pack.FzgPLK/_old 2017-08-31 20:57:28.286919294 +0200 +++ /var/tmp/diff_new_pack.FzgPLK/_new 2017-08-31 20:57:28.298917608 +0200 @@ -19,7 +19,7 @@ %global pkg_name mustache %bcond_with tests Name: ghc-%{pkg_name} -Version: 2.1.4 +Version: 2.2.3 Release: 0 Summary: A mustache template parser library License: BSD-3-Clause ++++++ mustache-2.1.4.tar.gz -> mustache-2.2.3.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mustache-2.1.4/CHANGELOG.md new/mustache-2.2.3/CHANGELOG.md --- old/mustache-2.1.4/CHANGELOG.md 2017-05-13 21:10:14.000000000 +0200 +++ new/mustache-2.2.3/CHANGELOG.md 2017-05-21 11:08:53.000000000 +0200 @@ -1,5 +1,22 @@ # Mustache library changelog +## v2.2.3 + +- Quick fix to prevent catchSubstitute from reporting substitutions to the renderer. + +## v2.2.2 + +- Added a function to catch a substitution result + +## v2.2.1 + +- Quickfix for an issue with resolving in context + +## v2.2 + +- changed substitution into a new monad + + easier usage in lambdas and lambdas can now do nested substitution + ## v2.1.4 - Treat Null as falsy in sections @@ -10,7 +27,7 @@ ## v2.1.2 -- Fixed template cahce again, as the spec requires access to the previous cache in partials as well +- Fixed template cache again, as the spec requires access to the previous cache in partials as well ## v2.1.1 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mustache-2.1.4/mustache.cabal new/mustache-2.2.3/mustache.cabal --- old/mustache-2.1.4/mustache.cabal 2017-05-13 21:10:14.000000000 +0200 +++ new/mustache-2.2.3/mustache.cabal 2017-05-21 11:08:53.000000000 +0200 @@ -1,5 +1,5 @@ name: mustache -version: 2.1.4 +version: 2.2.3 synopsis: A mustache template parser library. description: Allows parsing and rendering template files with mustache markup. See the @@ -29,13 +29,6 @@ type: git location: git://github.com/JustusAdam/mustache.git -source-repository this - type: git - branch: master - location: git://github.com/JustusAdam/mustache.git - tag: v2.1.4 - - library exposed-modules: Text.Mustache @@ -44,6 +37,7 @@ , Text.Mustache.Compile , Text.Mustache.Render other-modules: Text.Mustache.Internal + , Text.Mustache.Internal.Types other-extensions: NamedFieldPuns , OverloadedStrings , LambdaCase @@ -69,6 +63,8 @@ default-language: Haskell2010 ghc-options: -Wall + default-extensions: LambdaCase + , TupleSections executable haskell-mustache diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mustache-2.1.4/src/Text/Mustache/Internal/Types.hs new/mustache-2.2.3/src/Text/Mustache/Internal/Types.hs --- old/mustache-2.1.4/src/Text/Mustache/Internal/Types.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/mustache-2.2.3/src/Text/Mustache/Internal/Types.hs 2017-05-18 13:52:32.000000000 +0200 @@ -0,0 +1,356 @@ +{-# 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 (key:nextKeys) = (>>= innerSearch nextKeys) <$> go + where + go = asks fst >>= \case + Context parents focus -> do + let searchParents = case parents of + (newFocus: newParents) -> shiftContext (Context newParents newFocus) $ go + _ -> return Nothing + case focus of + Object o -> + case HM.lookup key o of + Just res -> return $ Just res + _ -> searchParents + _ -> searchParents + + +-- | 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 + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mustache-2.1.4/src/Text/Mustache/Render.hs new/mustache-2.2.3/src/Text/Mustache/Render.hs --- old/mustache-2.1.4/src/Text/Mustache/Render.hs 2017-05-13 21:10:14.000000000 +0200 +++ new/mustache-2.2.3/src/Text/Mustache/Render.hs 2017-05-21 11:08:53.000000000 +0200 @@ -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, catchSubstitute -- * 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.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.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 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,92 @@ -} 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 +-- | Catch the results of running the inner substitution. +catchSubstitute :: SubM a -> SubM (a, Text) +catchSubstitute = fmap (second (T.concat . snd)) . SubM . hideResults . listen . runSubM' where - -- Main substitution function - substitute' :: Context Value -> Node Text -> Substitution () - - -- subtituting text - substitute' _ (TextBlock t) = tellSuccess t + hideResults = censor (\(errs, _) -> (errs, [])) - -- 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' -> - 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 - - -- 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 +-- | Substitute an entire 'STree' rather than just a single 'Node' +substituteAST :: STree -> SubM () +substituteAST = mapM_ substituteNode + + +-- | 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 shiftContext newContext $ substituteAST secSTree + Context _ (Object _) -> substituteAST secSTree + Context _ v -> tellError $ InvalidImplicitSectionContextType $ showValueType v + +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 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 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 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 +194,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 +212,33 @@ 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 + + +instance ToMustache (Context Value -> STree -> STree) where + toMustache f = Lambda $ (<$> askContext) . flip f + +instance ToMustache (Context Value -> STree -> Text) where + toMustache = lambdaHelper id + +instance ToMustache (Context Value -> STree -> LT.Text) where + toMustache = lambdaHelper LT.toStrict + +instance ToMustache (Context Value -> STree -> String) where + toMustache = lambdaHelper pack + +lambdaHelper :: (r -> Text) -> (Context Value -> STree -> r) -> Value +lambdaHelper conv f = Lambda $ (<$> askContext) . wrapper + where + wrapper :: STree -> Context Value -> STree + wrapper lSTree c = [TextBlock $ conv $ f c lSTree] + +instance ToMustache (STree -> SubM Text) where + toMustache f = Lambda (fmap (return . TextBlock) . f) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mustache-2.1.4/src/Text/Mustache/Types.hs new/mustache-2.2.3/src/Text/Mustache/Types.hs --- old/mustache-2.1.4/src/Text/Mustache/Types.hs 2017-03-30 19:35:27.000000000 +0200 +++ new/mustache-2.2.3/src/Text/Mustache/Types.hs 2017-05-18 12:56:04.000000000 +0200 @@ -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,293 +25,17 @@ , 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 - - --- | 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 - ] +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 + -- | Convenience function for creating Object values. -- @@ -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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mustache-2.1.4/src/Text/Mustache.hs new/mustache-2.2.3/src/Text/Mustache.hs --- old/mustache-2.1.4/src/Text/Mustache.hs 2017-03-30 19:35:27.000000000 +0200 +++ new/mustache-2.2.3/src/Text/Mustache.hs 2017-05-20 11:58:30.000000000 +0200 @@ -171,8 +171,17 @@ , substituteValue, checkedSubstituteValue - -- ** Data Conversion + -- ** In Lambdas + + , substituteNode, substituteAST, catchSubstitute + + -- * Data Conversion , ToMustache, toMustache, object, (~>), (~=) + + -- ** Utilities for lambdas + + , overText + ) where @@ -180,3 +189,9 @@ import Text.Mustache.Compile import Text.Mustache.Render import Text.Mustache.Types +import qualified Data.Text as T + + +-- | Creates a 'Lambda' which first renders the contained section and then applies the supplied function +overText :: (T.Text -> T.Text) -> Value +overText f = toMustache $ fmap (f . snd) . catchSubstitute . substituteAST diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mustache-2.1.4/test/unit/Spec.hs new/mustache-2.2.3/test/unit/Spec.hs --- old/mustache-2.1.4/test/unit/Spec.hs 2017-05-13 21:10:14.000000000 +0200 +++ new/mustache-2.2.3/test/unit/Spec.hs 2017-05-21 11:08:53.000000000 +0200 @@ -185,6 +185,22 @@ (object ["section" ~> ([] :: [T.Text])]) `shouldBe` "" + it "substitutes a lambda by applying lambda to contained text" $ + substitute + (toTemplate [Section (NamedData ["lambda"]) [TextBlock "t"]]) + (object ["lambda" ~> (overText T.toUpper)]) + `shouldBe` "T" + + + it "substitutes a lambda by applying lambda to the nested substitution results" $ + substitute + (toTemplate [Section (NamedData ["lambda"]) [TextBlock "t", Variable escaped (NamedData ["inner"])]]) + (object [ "lambda" ~> (overText T.toUpper) + , "inner" ~> ("var" :: T.Text) + ]) + `shouldBe` "TVAR" + + it "substitutes a nested section" $ substitute (toTemplate [Variable escaped (NamedData ["outer", "inner"])])