mustache-2.3.0/app/0000755000000000000000000000000013200570152012266 5ustar0000000000000000mustache-2.3.0/src/0000755000000000000000000000000013200570152012275 5ustar0000000000000000mustache-2.3.0/src/Text/0000755000000000000000000000000013200570152013221 5ustar0000000000000000mustache-2.3.0/src/Text/Mustache/0000755000000000000000000000000013205773425015007 5ustar0000000000000000mustache-2.3.0/src/Text/Mustache/Internal/0000755000000000000000000000000013200570152016546 5ustar0000000000000000mustache-2.3.0/test/0000755000000000000000000000000013200570152012465 5ustar0000000000000000mustache-2.3.0/test/integration/0000755000000000000000000000000013200570152015010 5ustar0000000000000000mustache-2.3.0/test/unit/0000755000000000000000000000000013200570152013444 5ustar0000000000000000mustache-2.3.0/test/unit/examples/0000755000000000000000000000000013200570152015262 5ustar0000000000000000mustache-2.3.0/test/unit/examples/partials/0000755000000000000000000000000013200570152017101 5ustar0000000000000000mustache-2.3.0/src/Text/Mustache.hs0000644000000000000000000001372513200570152015336 0ustar0000000000000000{-| Module : $Header$ Description : Basic functions for dealing with mustache templates. Copyright : (c) Justus Adam, 2015 License : BSD3 Maintainer : dev@justus.science Stability : experimental Portability : POSIX = How to use this library This module exposes some of the most convenient functions for dealing with mustache templates. == Compiling with automatic partial discovery The easiest way of compiling a file and its potential includes (called partials) is by using the 'automaticCompile' function. @ main :: IO () main = do let searchSpace = [".", "./templates"] templateName = "main.mustache" compiled <- automaticCompile searchSpace templateName case compiled of Left err -> print err Right template -> return () -- this is where you can start using it @ The @searchSpace@ encompasses all directories in which the compiler should search for the template source files. The search itself is conducted in order, from left to right. Should your search space be only the current working directory, you can use 'localAutomaticCompile'. The @templateName@ is the relative path of the template to any directory of the search space. 'automaticCompile' not only finds and compiles the template for you, it also recursively finds any partials included in the template as well, compiles them and stores them in the 'partials' hash attached to the resulting template. The compiler will throw errors if either the template is malformed or the source file for a partial or the template itself could not be found in any of the directories in @searchSpace@. == Substituting In order to substitute data into the template it must be an instance of the 'ToMustache' typeclass or be of type 'Value'. This libray tries to imitate the API of by allowing you to define conversions of your own custom data types into 'Value', the type used internally by the substitutor via typeclass and a selection of operators and convenience functions. === Example @ data Person = { age :: Int, name :: String } instance ToMustache Person where toMustache person = object [ "age" ~> age person , "name" ~> name person ] @ The values to the left of the '~>' operator has to be of type 'Text', hence the @OverloadedStrings@ can becomes very handy here. Values to the right of the '~>' operator must be an instance of the 'ToMustache' typeclass. Alternatively, if your value to the right of the '~>' operator is not an instance of 'ToMustache' but an instance of 'ToJSON' you can use the '~=' operator, which accepts 'ToJSON' values. @ data Person = { age :: Int, name :: String, address :: Address } data Address = ... instance ToJSON Address where ... instance ToMustache Person where toMustache person = object [ "age" ~> age person , "name" ~> name person , "address" ~= address person ] @ All operators are also provided in a unicode form, for those that, like me, enjoy unicode operators. == Manual compiling You can compile templates manually without requiring the IO monad at all, using the 'compileTemplate' function. This is the same function internally used by 'automaticCompile' and does not check if required partial are present. More functions for manual compilation can be found in the 'Text.Mustache.Compile' module. Including helpers for finding lists of partials in templates. Additionally the 'compileTemplateWithCache' function is exposed here which you may use to automatically compile a template but avoid some of the compilation overhead by providing already compiled partials as well. == Fundamentals This library builds on three important data structures/types. ['Value'] A data structure almost identical to Data.Aeson.Value extended with lambda functions which represents the data the template is being filled with. ['ToMustache'] A typeclass for converting arbitrary types to 'Value', similar to Data.Aeson.ToJSON but with support for lambdas. ['Template'] Contains the 'STree', the syntax tree, which is basically a list of text blocks and mustache tags. The 'name' of the template and its 'partials' cache. === Compiling During the compilation step the template file is located, read, then parsed in a single pass ('compileTemplate'), resulting in a 'Template' with an empty 'partials' section. Subsequenty the 'STree' of the template is scanned for included partials, any present 'TemplateCache' is queried for the partial ('compileTemplateWithCache'), if not found it will be searched for in the @searchSpace@, compiled and inserted into the template's own cache as well as the global cache for the compilation process. Internally no partial is compiled twice, as long as the names stay consistent. Once compiled templates may be used multiple times for substitution or as partial for other templates. Partials are not being embedded into the templates during compilation, but during substitution, hence the 'partials' cache is vital to the template even after compilation has been completed. Any non existent partial in the cache will rsubstitute to an empty string. === Substituting -} {-# LANGUAGE LambdaCase #-} module Text.Mustache ( -- * Compiling -- ** Automatic automaticCompile, localAutomaticCompile -- ** Manually , compileTemplateWithCache, compileTemplate, Template(..) -- * Rendering -- ** Generic , substitute, checkedSubstitute -- ** Specialized , substituteValue, checkedSubstituteValue -- ** In Lambdas , substituteNode, substituteAST, catchSubstitute -- * Data Conversion , ToMustache, toMustache, object, (~>), (~=) -- ** Utilities for lambdas , overText ) where 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 mustache-2.3.0/src/Text/Mustache/Types.hs0000644000000000000000000000520713200570152016436 0ustar0000000000000000{-| Module : $Header$ Description : Types and conversions Copyright : (c) Justus Adam, 2015 License : BSD3 Maintainer : dev@justus.science Stability : experimental Portability : POSIX -} module Text.Mustache.Types ( -- * Types for the Parser / Template ASTree , STree , Node(..) , DataIdentifier(..) , Template(..) , TemplateCache -- * Types for the Substitution / Data , Value(..) , Key -- ** Converting , object , (~>), (↝), (~=), (⥱) , ToMustache, toMustache, mFromJSON -- ** Representation , Array, Object, Pair , SubM, askContext, askPartials , Context(..) ) where 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. -- -- This function is supposed to be used in conjuction with the '~>' and '~=' operators. -- -- ==== __Examples__ -- -- @ -- data Address = Address { ... } -- -- instance Address ToJSON where -- ... -- -- data Person = Person { name :: String, address :: Address } -- -- instance ToMustache Person where -- toMustache (Person { name, address }) = object -- [ "name" ~> name -- , "address" ~= address -- ] -- @ -- -- Here we can see that we can use the '~>' operator for values that have -- themselves a 'ToMustache' instance, or alternatively if they lack such an -- instance but provide an instance for the 'ToJSON' typeclass we can use the -- '~=' operator. object :: [Pair] -> Value object = Object . HM.fromList -- | Map keys to values that provide a 'ToMustache' instance -- -- Recommended in conjunction with the `OverloadedStrings` extension. (~>) :: ToMustache ω => Text -> ω -> Pair (~>) t = (t, ) . toMustache {-# INLINEABLE (~>) #-} infixr 8 ~> -- | Unicode version of '~>' (↝) :: ToMustache ω => Text -> ω -> Pair (↝) = (~>) {-# INLINEABLE (↝) #-} infixr 8 ↝ -- | Map keys to values that provide a 'ToJSON' instance -- -- Recommended in conjunction with the `OverloadedStrings` extension. (~=) :: Aeson.ToJSON ι => Text -> ι -> Pair (~=) t = (t ~>) . Aeson.toJSON {-# INLINEABLE (~=) #-} infixr 8 ~= -- | Unicode version of '~=' (⥱) :: Aeson.ToJSON ι => Text -> ι -> Pair (⥱) = (~=) {-# INLINEABLE (⥱) #-} infixr 8 ⥱ -- | Converts a value that can be represented as JSON to a Value. mFromJSON :: Aeson.ToJSON ι => ι -> Value mFromJSON = toMustache . Aeson.toJSON askContext :: SubM (Context Value) askContext = asks fst askPartials :: SubM TemplateCache askPartials = asks snd mustache-2.3.0/src/Text/Mustache/Parser.hs0000644000000000000000000002204113200570152016561 0ustar0000000000000000{-| Module : $Header$ Description : Basic functions for dealing with mustache templates. Copyright : (c) Justus Adam, 2015 License : BSD3 Maintainer : dev@justus.science Stability : experimental Portability : POSIX -} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} module Text.Mustache.Parser ( -- * Generic parsing functions parse, parseWithConf -- * Configurations , MustacheConf(..), defaultConf -- * Parser , Parser, MustacheState -- * Mustache Constants , sectionBegin, sectionEnd, invertedSectionBegin, unescape2, unescape1 , delimiterChange, nestingSeparator ) where import Control.Monad import Data.Char (isAlphaNum, isSpace) import Data.List (nub) import Data.Monoid ((<>)) import Data.Text as T (Text, null, pack) import Prelude as Prel import Text.Mustache.Types import Text.Parsec as P hiding (endOfLine, parse) -- | Initial configuration for the parser data MustacheConf = MustacheConf { delimiters :: (String, String) } -- | User state for the parser data MustacheState = MustacheState { sDelimiters :: (String, String) , textStack :: Text , isBeginngingOfLine :: Bool , currentSectionName :: Maybe DataIdentifier } data ParseTagRes = SectionBegin Bool DataIdentifier | SectionEnd DataIdentifier | Tag (Node Text) | HandledTag -- | @#@ sectionBegin :: Char sectionBegin = '#' -- | @/@ sectionEnd :: Char sectionEnd = '/' -- | @>@ partialBegin :: Char partialBegin = '>' -- | @^@ invertedSectionBegin :: Char invertedSectionBegin = '^' -- | @{@ and @}@ unescape2 :: (Char, Char) unescape2 = ('{', '}') -- | @&@ unescape1 :: Char unescape1 = '&' -- | @=@ delimiterChange :: Char delimiterChange = '=' -- | @.@ nestingSeparator :: Char nestingSeparator = '.' -- | @!@ comment :: Char comment = '!' -- | @.@ implicitIterator :: Char implicitIterator = '.' -- | Cannot be a letter, number or the nesting separation Character @.@ isAllowedDelimiterCharacter :: Char -> Bool isAllowedDelimiterCharacter = not . Prel.or . sequence [ isSpace, isAlphaNum, (== nestingSeparator) ] allowedDelimiterCharacter :: Parser Char allowedDelimiterCharacter = satisfy isAllowedDelimiterCharacter -- | Empty configuration emptyState :: MustacheState emptyState = MustacheState ("", "") mempty True Nothing -- | Default configuration (delimiters = ("{{", "}}")) defaultConf :: MustacheConf defaultConf = MustacheConf ("{{", "}}") initState :: MustacheConf -> MustacheState initState (MustacheConf { delimiters }) = emptyState { sDelimiters = delimiters } setIsBeginning :: Bool -> Parser () setIsBeginning b = modifyState (\s -> s { isBeginngingOfLine = b }) -- | The parser monad in use type Parser = Parsec Text MustacheState (<<) :: Monad m => m b -> m a -> m b (<<) = flip (>>) endOfLine :: Parser String endOfLine = do r <- optionMaybe $ char '\r' n <- char '\n' return $ maybe id (:) r [n] {-| Runs the parser for a mustache template, returning the syntax tree. -} parse :: FilePath -> Text -> Either ParseError STree parse = parseWithConf defaultConf -- | Parse using a custom initial configuration parseWithConf :: MustacheConf -> FilePath -> Text -> Either ParseError STree parseWithConf = P.runParser parseText . initState parseText :: Parser STree parseText = do (MustacheState { isBeginngingOfLine }) <- getState if isBeginngingOfLine then parseLine else continueLine appendStringStack :: String -> Parser () appendStringStack t = modifyState (\s -> s { textStack = textStack s <> pack t}) continueLine :: Parser STree continueLine = do (MustacheState { sDelimiters = ( start@(x:_), _ )}) <- getState let forbidden = x : "\n\r" many (noneOf forbidden) >>= appendStringStack (try endOfLine >>= appendStringStack >> setIsBeginning True >> parseLine) <|> (try (string start) >> switchOnTag >>= continueFromTag) <|> (try eof >> finishFile) <|> (anyChar >>= appendStringStack . (:[]) >> continueLine) flushText :: Parser STree flushText = do s@(MustacheState { textStack = text }) <- getState putState $ s { textStack = mempty } return $ if T.null text then [] else [TextBlock text] finishFile :: Parser STree finishFile = getState >>= \case (MustacheState {currentSectionName = Nothing}) -> flushText (MustacheState {currentSectionName = Just name}) -> parserFail $ "Unclosed section " <> show name parseLine :: Parser STree parseLine = do (MustacheState { sDelimiters = ( start, _ ) }) <- getState initialWhitespace <- many (oneOf " \t") let handleStandalone = do tag <- switchOnTag let continueNoStandalone = do appendStringStack initialWhitespace setIsBeginning False continueFromTag tag standaloneEnding = do try (skipMany (oneOf " \t") >> (eof <|> void endOfLine)) setIsBeginning True case tag of Tag (Partial _ name) -> ( standaloneEnding >> continueFromTag (Tag (Partial (Just (pack initialWhitespace)) name)) ) <|> continueNoStandalone Tag _ -> continueNoStandalone _ -> ( standaloneEnding >> continueFromTag tag ) <|> continueNoStandalone (try (string start) >> handleStandalone) <|> (try eof >> appendStringStack initialWhitespace >> finishFile) <|> (appendStringStack initialWhitespace >> setIsBeginning False >> continueLine) continueFromTag :: ParseTagRes -> Parser STree continueFromTag (SectionBegin inverted name) = do textNodes <- flushText state@(MustacheState { currentSectionName = previousSection }) <- getState putState $ state { currentSectionName = return name } innerSectionContent <- parseText let sectionTag = if inverted then InvertedSection else Section modifyState $ \s -> s { currentSectionName = previousSection } outerSectionContent <- parseText return (textNodes <> [sectionTag name innerSectionContent] <> outerSectionContent) continueFromTag (SectionEnd name) = do (MustacheState { currentSectionName }) <- getState case currentSectionName of Just name' | name' == name -> flushText Just name' -> parserFail $ "Expected closing sequence for \"" <> show name <> "\" got \"" <> show name' <> "\"." Nothing -> parserFail $ "Encountered closing sequence for \"" <> show name <> "\" which has never been opened." continueFromTag (Tag tag) = do textNodes <- flushText furtherNodes <- parseText return $ textNodes <> return tag <> furtherNodes continueFromTag HandledTag = parseText switchOnTag :: Parser ParseTagRes switchOnTag = do (MustacheState { sDelimiters = ( _, end )}) <- getState choice [ SectionBegin False <$> (try (char sectionBegin) >> genParseTagEnd mempty) , SectionEnd <$> (try (char sectionEnd) >> genParseTagEnd mempty) , Tag . Variable False <$> (try (char unescape1) >> genParseTagEnd mempty) , Tag . Variable False <$> (try (char (fst unescape2)) >> genParseTagEnd (return $ snd unescape2)) , Tag . Partial Nothing <$> (try (char partialBegin) >> spaces >> (noneOf (nub end) `manyTill` try (spaces >> string end))) , return HandledTag << (try (char delimiterChange) >> parseDelimChange) , SectionBegin True <$> (try (char invertedSectionBegin) >> genParseTagEnd mempty >>= \case n@(NamedData _) -> return n _ -> parserFail "Inverted Sections can not be implicit." ) , return HandledTag << (try (char comment) >> manyTill anyChar (try $ string end)) , Tag . Variable True <$> genParseTagEnd mempty ] where parseDelimChange = do (MustacheState { sDelimiters = ( _, end )}) <- getState spaces delim1 <- allowedDelimiterCharacter `manyTill` space spaces delim2 <- allowedDelimiterCharacter `manyTill` try (spaces >> string (delimiterChange : end)) when (delim1 == mempty || delim2 == mempty) $ parserFail "Tags must contain more than 0 characters" oldState <- getState putState $ oldState { sDelimiters = (delim1, delim2) } genParseTagEnd :: String -> Parser DataIdentifier genParseTagEnd emod = do (MustacheState { sDelimiters = ( start, end ) }) <- getState let nEnd = emod <> end disallowed = nub $ nestingSeparator : start <> end parseOne :: Parser [Text] parseOne = do one <- noneOf disallowed `manyTill` lookAhead (try (spaces >> void (string nEnd)) <|> try (void $ char nestingSeparator)) others <- (char nestingSeparator >> parseOne) <|> (const mempty <$> (spaces >> string nEnd)) return $ pack one : others spaces (try (char implicitIterator) >> spaces >> string nEnd >> return Implicit) <|> (NamedData <$> parseOne) mustache-2.3.0/src/Text/Mustache/Compile.hs0000644000000000000000000001632513205776612016743 0ustar0000000000000000{-| Module : $Header$ Description : Basic functions for dealing with mustache templates. Copyright : (c) Justus Adam, 2015 License : BSD3 Maintainer : dev@justus.science Stability : experimental Portability : POSIX -} {-# OPTIONS_GHC -fno-warn-missing-fields #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} module Text.Mustache.Compile ( automaticCompile, localAutomaticCompile, TemplateCache, compileTemplateWithCache , compileTemplate, cacheFromList, getPartials, mustache, embedTemplate, embedSingleTemplate ) where import Control.Arrow ((&&&)) import Control.Monad import Control.Monad.Except import Control.Monad.State import Data.Bool import Data.HashMap.Strict as HM import Data.Text hiding (concat, find, map, uncons) import qualified Data.Text.IO as TIO import Language.Haskell.TH (Exp, Loc, Q, loc_filename, loc_start, location) import Language.Haskell.TH.Quote (QuasiQuoter (QuasiQuoter), quoteExp) import qualified Language.Haskell.TH.Syntax as THS import System.Directory import System.FilePath import Text.Mustache.Parser import Text.Mustache.Types import Text.Parsec.Error import Text.Parsec.Pos import Text.Printf {-| Compiles a mustache template provided by name including the mentioned partials. The same can be done manually using 'getFile', 'mustacheParser' and 'getPartials'. This function also ensures each partial is only compiled once even though it may be included by other partials including itself. A reference to the included template will be found in each including templates 'partials' section. -} automaticCompile :: [FilePath] -> FilePath -> IO (Either ParseError Template) automaticCompile searchSpace = compileTemplateWithCache searchSpace mempty -- | Compile the template with the search space set to only the current directory localAutomaticCompile :: FilePath -> IO (Either ParseError Template) localAutomaticCompile = automaticCompile ["."] {-| Compile a mustache template providing a list of precompiled templates that do not have to be recompiled. -} compileTemplateWithCache :: [FilePath] -> TemplateCache -> FilePath -> IO (Either ParseError Template) compileTemplateWithCache searchSpace templates initName = runExceptT $ evalStateT (compile' initName) $ flattenPartials templates where compile' :: FilePath -> StateT (HM.HashMap String Template) (ExceptT ParseError IO) Template compile' name' = do templates' <- get case HM.lookup name' templates' of Just template -> return template Nothing -> do rawSource <- lift $ getFile searchSpace name' compiled@(Template { ast = mSTree }) <- lift $ ExceptT . pure $ compileTemplate name' rawSource foldM (\st@(Template { partials = p }) partialName -> do nt <- compile' partialName modify (HM.insert partialName nt) return (st { partials = HM.insert partialName nt p }) ) compiled (getPartials mSTree) -- | Flatten a list of Templates into a single 'TemplateChache' cacheFromList :: [Template] -> TemplateCache cacheFromList = flattenPartials . fromList . fmap (name &&& id) -- | Compiles a 'Template' directly from 'Text' without checking for missing partials. -- the result will be a 'Template' with an empty 'partials' cache. compileTemplate :: String -> Text -> Either ParseError Template compileTemplate name' = fmap (flip (Template name') mempty) . parse name' {-| Find the names of all included partials in a mustache STree. Same as @join . fmap getPartials'@ -} getPartials :: STree -> [FilePath] getPartials = join . fmap getPartials' {-| Find partials in a single Node -} getPartials' :: Node Text -> [FilePath] getPartials' (Partial _ p) = return p getPartials' (Section _ n) = getPartials n getPartials' (InvertedSection _ n) = getPartials n getPartials' _ = mempty flattenPartials :: TemplateCache -> TemplateCache flattenPartials m = foldrWithKey (insertWith (\_ b -> b)) m m {-| @getFile searchSpace file@ iteratively searches all directories in @searchSpace@ for a @file@ returning it if found or raising an error if none of the directories contain the file. This trows 'ParseError's to be compatible with the internal Either Monad of 'compileTemplateWithCache'. -} getFile :: [FilePath] -> FilePath -> ExceptT ParseError IO Text getFile [] fp = throwError $ fileNotFound fp getFile (templateDir : xs) fp = lift (doesFileExist filePath) >>= bool (getFile xs fp) (lift $ TIO.readFile filePath) where filePath = templateDir fp -- | -- Compile a mustache 'Template' at compile time. Usage: -- -- > {-# LANGUAGE QuasiQuotes #-} -- > import Text.Mustache.Compile (mustache) -- > -- > foo :: Template -- > foo = [mustache|This is my inline {{ template }} created at compile time|] -- -- Partials are not supported in the QuasiQuoter mustache :: QuasiQuoter mustache = QuasiQuoter {quoteExp = \unprocessedTemplate -> do l <- location compileTemplateTH (fileAndLine l) unprocessedTemplate } -- | -- Compile a mustache 'Template' at compile time providing a search space for any partials. Usage: -- -- > {-# LANGUAGE TemplateHaskell #-} -- > import Text.Mustache.Compile (embedTemplate) -- > -- > foo :: Template -- > foo = $(embedTemplate ["dir", "dir/partials"] "file.mustache") -- embedTemplate :: [FilePath] -> FilePath -> Q Exp embedTemplate searchSpace filename = do template <- either (fail . ("Parse error in mustache template: " ++) . show) pure =<< THS.runIO (automaticCompile searchSpace filename) let possiblePaths = do fname <- (filename:) . HM.keys . partials $ template path <- searchSpace pure $ path fname mapM_ addDependentRelativeFile =<< THS.runIO (filterM doesFileExist possiblePaths) THS.lift template -- | -- Compile a mustache 'Template' at compile time. Usage: -- -- > {-# LANGUAGE TemplateHaskell #-} -- > import Text.Mustache.Compile (embedTemplate) -- > -- > foo :: Template -- > foo = $(embedTemplate "dir/file.mustache") -- -- Partials are not supported in embedSingleTemplate embedSingleTemplate :: FilePath -> Q Exp embedSingleTemplate filePath = do addDependentRelativeFile filePath compileTemplateTH filePath =<< THS.runIO (readFile filePath) fileAndLine :: Loc -> String fileAndLine loc = loc_filename loc ++ ":" ++ (show . fst . loc_start $ loc) compileTemplateTH :: String -> String -> Q Exp compileTemplateTH filename unprocessed = either (fail . ("Parse error in mustache template: " ++) . show) THS.lift $ compileTemplate filename (pack unprocessed) addDependentRelativeFile :: FilePath -> Q () addDependentRelativeFile = THS.qAddDependentFile <=< THS.runIO . makeAbsolute -- ERRORS fileNotFound :: FilePath -> ParseError fileNotFound fp = newErrorMessage (Message $ printf "Template file '%s' not found" fp) (initialPos fp) mustache-2.3.0/src/Text/Mustache/Render.hs0000644000000000000000000002145113200570152016550 0ustar0000000000000000{-| Module : $Header$ Description : Functions for rendering mustache templates. Copyright : (c) Justus Adam, 2015 License : BSD3 Maintainer : dev@justus.science Stability : experimental Portability : POSIX -} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Text.Mustache.Render ( -- * Substitution substitute, substituteValue -- * Checked substitution , checkedSubstitute, checkedSubstituteValue, SubstitutionError(..) -- * Working with Context , Context(..), search, innerSearch, SubM, substituteNode, substituteAST, catchSubstitute -- * Util , toString ) where 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 Control.Monad.Reader import Control.Monad.Writer 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 {-| Substitutes all mustache defined tokens (or tags) for values found in the provided data structure. Equivalent to @substituteValue . toMustache@. -} substitute :: ToMustache k => Template -> k -> Text substitute t = substituteValue t . toMustache {-| 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 = (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 dataStruct = second T.concat $ runSubM (substituteAST (ast template)) (Context mempty dataStruct) (partials template) -- | 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 hideResults = censor (\(errs, _) -> (errs, [])) -- | 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 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 (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 where preface = if T.null indentation then [] else [TextBlock indentation] content = if T.null indentation then ast' else reverse $ fromMaybe [] (uncurry (:) . first dropper <$> uncons (reverse fullIndented)) where 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') | T.null indent = p | otherwise = Partial (Just (indent <> indent')) name' indentBy indent (Partial Nothing name') = Partial (Just indent) name' indentBy indent (TextBlock t) = TextBlock $ replace "\n" ("\n" <> indent) t indentBy _ a = a -- | Converts values to Text as required by the mustache standard 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) mustache-2.3.0/src/Text/Mustache/Internal.hs0000644000000000000000000000163713200570152017111 0ustar0000000000000000{-| Module : $Header$ Description : Types and conversions Copyright : (c) Justus Adam, 2015 License : BSD3 Maintainer : dev@justus.science Stability : experimental Portability : POSIX escapeXML and xmlEntities curtesy to the tagsoup library. -} module Text.Mustache.Internal (uncons, escapeXMLText) where import Data.Char (ord) import qualified Data.IntMap as IntMap import qualified Data.Text as T uncons :: [α] -> Maybe (α, [α]) uncons [] = Nothing uncons (x:xs) = return (x, xs) escapeXMLText :: T.Text -> T.Text escapeXMLText = T.pack . escapeXML . T.unpack escapeXML :: String -> String escapeXML = concatMap $ \x -> IntMap.findWithDefault [x] (ord x) mp where mp = IntMap.fromList [(ord b, "&"++a++";") | (a,[b]) <- xmlEntities] xmlEntities :: [(String, String)] xmlEntities = [ ("quot", "\"") , ("#39", "'") , ("amp" , "&") , ("lt" , "<") , ("gt" , ">") ] mustache-2.3.0/src/Text/Mustache/Internal/Types.hs0000644000000000000000000002447313200570152020220 0ustar0000000000000000{-# 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 mustache-2.3.0/app/Main.hs0000644000000000000000000000424113200570152013507 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE NamedFieldPuns #-} module Main (main) where import Data.Aeson (Value, eitherDecode) import qualified Data.ByteString as B (readFile) import qualified Data.ByteString.Lazy as BS (readFile) import Data.Foldable (for_) import qualified Data.Text.IO as TIO (putStrLn) import Data.Yaml (decodeEither) import System.Console.CmdArgs.Implicit (Data, Typeable, argPos, args, cmdArgs, def, help, summary, typ, (&=)) import System.FilePath (takeExtension) import Text.Mustache (automaticCompile, substitute, toMustache) data Arguments = Arguments { template :: FilePath , templateDirs :: [FilePath] , dataFiles :: [FilePath] } deriving (Show, Data, Typeable) commandArgs :: Arguments commandArgs = Arguments { template = def &= argPos 0 &= typ "TEMPLATE" , dataFiles = def &= args &= typ "DATA-FILES" , templateDirs = ["."] &= help "The directories in which to search for the templates" &= typ "DIRECTORIES" } &= summary "Simple mustache template subtitution" readJSON :: FilePath -> IO (Either String Value) readJSON = fmap eitherDecode . BS.readFile readYAML :: FilePath -> IO (Either String Value) readYAML = fmap decodeEither . B.readFile main :: IO () main = do (Arguments { template, templateDirs, dataFiles }) <- cmdArgs commandArgs eitherTemplate <- automaticCompile templateDirs template case eitherTemplate of Left err -> print err Right compiledTemplate -> for_ dataFiles $ \file -> do let decoder = case takeExtension file of ".yml" -> readYAML ".yaml" -> readYAML _ -> readJSON decoded <- decoder file either putStrLn (TIO.putStrLn . substitute compiledTemplate . toMustache) decoded mustache-2.3.0/test/unit/Spec.hs0000644000000000000000000002222213200570152014672 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} module Main where import Control.Applicative ((<$>), (<*>)) import Data.Either import Data.Function (on) import Data.Monoid import qualified Data.Text as T import System.IO.Unsafe (unsafePerformIO) import Test.Hspec import Text.Mustache import Text.Mustache.Compile import Text.Mustache.Parser import Text.Mustache.Types escaped :: Bool escaped = True unescaped :: Bool unescaped = False parserSpec :: Spec parserSpec = describe "mustacheParser" $ do let lparse = parse "testsuite" let returnedOne = return . return let text = "test12356p0--=-34{}jnv,\n" it "parses text" $ lparse text `shouldBe` returnedOne (TextBlock text) it "parses a variable" $ lparse "{{name}}" `shouldBe` returnedOne (Variable escaped (NamedData ["name"])) it "parses a variable with whitespace" $ lparse "{{ name }}" `shouldBe` returnedOne (Variable escaped (NamedData ["name"])) it "allows '-' in variable names" $ lparse "{{ name-name }}" `shouldBe` returnedOne (Variable True (NamedData ["name-name"])) it "allows '_' in variable names" $ lparse "{{ name_name }}" `shouldBe` returnedOne (Variable True (NamedData ["name_name"])) it "parses a variable unescaped with {{{}}}" $ lparse "{{{name}}}" `shouldBe` returnedOne (Variable unescaped (NamedData ["name"])) it "parses a variable unescaped with {{{}}} with whitespace" $ lparse "{{{ name }}}" `shouldBe` returnedOne (Variable False (NamedData ["name"])) it "parses a variable unescaped with &" $ lparse "{{&name}}" `shouldBe` returnedOne (Variable unescaped (NamedData ["name"])) it "parses a variable unescaped with & with whitespace" $ lparse "{{& name }}" `shouldBe` returnedOne (Variable False (NamedData ["name"])) it "parses a partial" $ lparse "{{>myPartial}}" `shouldBe` returnedOne (Partial (Just "") "myPartial") it "parses a partial with whitespace" $ lparse "{{> myPartial }}" `shouldBe` returnedOne (Partial (Just "") "myPartial") it "parses the an empty section" $ lparse "{{#section}}{{/section}}" `shouldBe` returnedOne (Section (NamedData ["section"]) mempty) it "parses the an empty section with whitespace" $ lparse "{{# section }}{{/ section }}" `shouldBe` returnedOne (Section (NamedData ["section"]) mempty) it "parses a delimiter change" $ lparse "{{=<< >>=}}<>{{var}}" `shouldBe` return [Variable True (NamedData ["var"]), TextBlock "{{var}}"] it "parses a delimiter change with whitespace" $ lparse "{{=<< >>=}}<< var >>{{var}}" `shouldBe` return [Variable True (NamedData ["var"]), TextBlock "{{var}}"] it "parses two subsequent delimiter changes" $ lparse "{{=(( ))=}}(( var ))((=-- $-=))--#section$---/section$-" `shouldBe` return [Variable True (NamedData ["var"]), Section (NamedData ["section"]) []] it "propagates a delimiter change from a nested scope" $ lparse "{{#section}}{{=<< >>=}}<><>" `shouldBe` return [Section (NamedData ["section"]) [], Variable escaped (NamedData ["var"])] it "fails if the tag contains illegal characters" $ lparse "{{#&}}" `shouldSatisfy` isLeft it "parses a nested variable" $ lparse "{{ name.val }}" `shouldBe` returnedOne (Variable escaped (NamedData ["name", "val"])) it "parses a variable containing whitespace" $ lparse "{{ val space }}" `shouldBe` returnedOne (Variable escaped (NamedData ["val space"])) substituteSpec :: Spec substituteSpec = describe "substitute" $ do let toTemplate ast' = Template "testsuite" ast' mempty it "substitutes a html escaped value for a variable" $ substitute (toTemplate [Variable escaped (NamedData ["name"])]) (object ["name" ~> ("\" ' < > &" :: T.Text)]) `shouldBe` "" ' < > &" it "substitutes raw value for an unescaped variable" $ substitute (toTemplate [Variable unescaped (NamedData ["name"])]) (object ["name" ~> ("\" ' < > &" :: T.Text)]) `shouldBe` "\" ' < > &" it "substitutes a section when the key is present (and an empty object)" $ substitute (toTemplate [Section (NamedData ["section"]) [TextBlock "t"]]) (object ["section" ~> object []]) `shouldBe` "t" it "substitutes a section when the key is present (and 'true')" $ substitute (toTemplate [Section (NamedData ["section"]) [TextBlock "t"]]) (object ["section" ~> True]) `shouldBe` "t" it "substitutes a section once when the key is present and a singleton list" $ substitute (toTemplate [Section (NamedData ["section"]) [TextBlock "t"]]) (object ["section" ~> ["True" :: T.Text]]) `shouldBe` "t" it "substitutes a section twice when the key is present and a list with two items" $ substitute (toTemplate [Section (NamedData ["section"]) [TextBlock "t"]]) (object ["section" ~> (["True", "False"] :: [T.Text])]) `shouldBe` "tt" it "substitutes a section twice when the key is present and a list with two\ \ objects, changing the scope to each object" $ substitute (toTemplate [Section (NamedData ["section"]) [Variable escaped (NamedData ["t"])]]) (object [ "section" ~> [ object ["t" ~> ("var1" :: T.Text)] , object ["t" ~> ("var2" :: T.Text)] ] ]) `shouldBe` "var1var2" it "does not substitute a section when the key is not present" $ substitute (toTemplate [Section (NamedData ["section"]) [TextBlock "t"]]) (object []) `shouldBe` "" it "does not substitute a section when the key is present (and 'false')" $ substitute (toTemplate [Section (NamedData ["section"]) [TextBlock "t"]]) (object ["section" ~> False]) `shouldBe` "" it "does not substitute a section when the key is present (and null)" $ substitute (toTemplate [Section (NamedData ["section"]) [TextBlock "t"]]) (object ["section" ~> Null]) `shouldBe` "" it "does not substitute a section when the key is present (and empty list)" $ substitute (toTemplate [Section (NamedData ["section"]) [TextBlock "t"]]) (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"])]) (object [ "outer" ~> object ["inner" ~> ("success" :: T.Text)] , "inner" ~> ("error" :: T.Text) ] ) `shouldBe` "success" converterSpec :: Spec converterSpec = describe "toMustache" $ it "converts a String" $ toMustache ("My String" :: String) `shouldSatisfy` \case (String "My String") -> True; _ -> False -- This is a one-off instance to define how we want the Spec to compare templates instance Eq Template where (==) = (==) `on` ast compileTimeSpec :: Spec compileTimeSpec = describe "compileTimeCompiling" $ do it "creates compiled templates from a QuasiQuoter" $ Right [mustache|This {{ template }} was injected at compile time with a quasiquoter|] `shouldBe` compileTemplate "Template Name" "This {{ template }} was injected at compile time with a quasiquoter" it "creates compiled templates from an embedded file" $ Right $(embedTemplate ["test/unit/examples"] "test-template.txt.mustache") `shouldBe` compileTemplate "Template Name" "This {{ template }} was injected at compile time with an embedded file\n" it "creates compiled templates from a single embedded file" $ Right $(embedSingleTemplate "test/unit/examples/test-template.txt.mustache") `shouldBe` compileTemplate "Template Name" "This {{ template }} was injected at compile time with an embedded file\n" it "creates compiled templates from an embedded file containing partials" $ Right $(embedTemplate ["test/unit/examples", "test/unit/examples/partials"] "test-template-partials.txt.mustache") `shouldBe` unsafePerformIO (automaticCompile ["test/unit/examples", "test/unit/examples/partials"] "test-template-partials.txt.mustache") main :: IO () main = hspec $ do parserSpec substituteSpec converterSpec compileTimeSpec mustache-2.3.0/test/integration/Language.hs0000644000000000000000000000672513200570152017101 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE UnicodeSyntax #-} module Main where import qualified Codec.Archive.Tar as Tar import qualified Codec.Compression.GZip as GZip import Control.Applicative ((<$>), (<*>)) import Control.Lens import Control.Monad import Data.ByteString.Lazy (toStrict) import Data.Foldable (for_) import qualified Data.HashMap.Strict as HM (HashMap, empty, traverseWithKey) import Data.List import Data.Maybe (fromMaybe) import qualified Data.Text as T import Data.Yaml as Y (FromJSON, Value (..), decode, parseJSON, (.!=), (.:), (.:?)) import Network.Wreq import System.FilePath import Test.Hspec import Text.Mustache langspecs :: [String] langspecs = [ "https://codeload.github.com/andrewthad/spec/legacy.tar.gz/add_list_context_check" , "https://codeload.github.com/mustache/spec/tar.gz/v1.1.3" ] data LangSpecFile = LangSpecFile { overview :: String , tests :: [LangSpecTest] } data LangSpecTest = LangSpecTest { name :: String , specDescription :: String , specData :: Y.Value , template :: T.Text , expected :: T.Text , testPartials :: HM.HashMap String T.Text } instance FromJSON LangSpecFile where parseJSON (Y.Object o) = LangSpecFile <$> o .: "overview" <*> o .: "tests" parseJSON _ = mzero instance FromJSON LangSpecTest where parseJSON (Y.Object o) = LangSpecTest <$> o .: "name" <*> o .: "desc" <*> o .: "data" <*> o .: "template" <*> o .: "expected" <*> o .:? "partials" .!= HM.empty parseJSON _ = mzero getOfficialSpecRelease :: String -> IO [(String, LangSpecFile)] getOfficialSpecRelease releaseURL = do res <- get releaseURL let archive = Tar.read $ GZip.decompress (res ^. responseBody) return $ Tar.foldEntries handleEntry [] (error . show) archive where handleEntry e acc = case content of Tar.NormalFile f _ | takeExtension filename `elem` [".yml", ".yaml"] && not ("~" `isPrefixOf` takeFileName filename) -> (filename, fromMaybe (error $ "Error parsing spec file " ++ filename) $ decode $ toStrict f):acc _ -> acc where filename = Tar.entryPath e content = Tar.entryContent e testOfficialLangSpec :: [(String, LangSpecFile)] -> Spec testOfficialLangSpec testfiles = for_ testfiles $ \(filename, LangSpecFile { tests }) -> describe ("File: " ++ takeFileName filename) $ for_ tests $ \(LangSpecTest { .. }) -> it ("Name: " ++ name ++ " Description: " ++ specDescription) $ let compiled = do partials' <- HM.traverseWithKey compileTemplate testPartials template' <- compileTemplate name template return $ template' { partials = partials' } in case compiled of Left m -> expectationFailure $ show m Right tmp -> substituteValue tmp (toMustache specData) `shouldBe` expected main :: IO () main = void $ do specs <- mapM getOfficialSpecRelease langspecs hspec $ mapM_ testOfficialLangSpec specs mustache-2.3.0/LICENSE0000644000000000000000000000276513200570152012525 0ustar0000000000000000Copyright (c) 2015, 2016 Justus Adam All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Justus Adam nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. mustache-2.3.0/Setup.hs0000644000000000000000000000007013200570152013137 0ustar0000000000000000import Distribution.Simple main = defaultMain mustache-2.3.0/mustache.cabal0000644000000000000000000000575113206232160014313 0ustar0000000000000000-- This file has been generated from package.yaml by hpack version 0.17.1. -- -- see: https://github.com/sol/hpack name: mustache version: 2.3.0 synopsis: A mustache template parser library. description: Allows parsing and rendering template files with mustache markup. See the mustache . . Implements the mustache spec version 1.1.3. . /Note/: Versions including and beyond 0.4 are compatible with ghc 7.8 again. category: Development homepage: https://github.com/JustusAdam/mustache bug-reports: https://github.com/JustusAdam/mustache/issues author: Justus Adam maintainer: dev@justus.science copyright: (c) 2015, 2016 Justus Adam license: BSD3 license-file: LICENSE tested-with: GHC>=7.8 && <=7.10.2 build-type: Simple cabal-version: >= 1.10 extra-source-files: CHANGELOG.md README.md test/unit/examples/partials/test-partial.txt.mustache test/unit/examples/test-template-partials.txt.mustache test/unit/examples/test-template.txt.mustache source-repository head type: git location: git://github.com/JustusAdam/mustache.git library hs-source-dirs: src default-extensions: LambdaCase TupleSections other-extensions: NamedFieldPuns OverloadedStrings LambdaCase TupleSections TemplateHaskell QuasiQuotes ghc-options: -Wall build-depends: base >=4.7 && <5 , text , aeson , bytestring , filepath , parsec , mtl >=2.2.1 , either , unordered-containers , vector , directory , scientific , containers , template-haskell , th-lift exposed-modules: Text.Mustache Text.Mustache.Types Text.Mustache.Parser Text.Mustache.Compile Text.Mustache.Render other-modules: Text.Mustache.Internal Text.Mustache.Internal.Types Paths_mustache default-language: Haskell2010 executable haskell-mustache main-is: Main.hs hs-source-dirs: app ghc-options: -threaded -Wall build-depends: base >=4.7 && <5 , text , aeson , bytestring , filepath , mustache , yaml , cmdargs default-language: Haskell2010 test-suite language-specifications type: exitcode-stdio-1.0 main-is: Language.hs hs-source-dirs: test/integration build-depends: base >=4.7 && <5 , text , aeson , bytestring , filepath , hspec , mustache , unordered-containers , yaml , base-unicode-symbols , wreq , zlib , tar , lens default-language: Haskell2010 test-suite unit-tests type: exitcode-stdio-1.0 main-is: Spec.hs hs-source-dirs: test/unit build-depends: base >=4.7 && <5 , text , aeson , bytestring , filepath , hspec , mustache , unordered-containers , yaml , process , temporary , directory default-language: Haskell2010 mustache-2.3.0/CHANGELOG.md0000644000000000000000000000377013205777036013345 0ustar0000000000000000# Mustache library changelog ## v2.3.0 - Changed `EitherT` to `ExceptT` (deprecation) - removed `getFile` from public API ## 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 ## v2.1.3 - Added excaping for the apostrophe "'" as per xml spec, courtesy to @tfausak ## v2.1.2 - Fixed template cache again, as the spec requires access to the previous cache in partials as well ## v2.1.1 - Fixed an error where the substitution of partials would not use the template cache of the new partial ## 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. ## v1.0 - Stabilised API's ## v0.5.1.0rc-7 - Removed dependency tagsoup - Added ToMustache instances for some numbers ## v0.5.0.0rc-6 - Removed any dependency on ghc 7.10-type OverlappingInstances - Resolved String/List overlapping instances ## v0.4.0.1rc-5 - Added a necessary OVERLAPPABLE pragma ## v0.4.0.0rc-4 (current stable version) - Removed `conversion` and `conversion-text` dependency. - Subsequently removed any dependency on overlapping instances - Readded support for ghc version 7.8 - Removed `Char -> Value` instance of `ToMustache` (because of overlap) - Renamed `AST` ## v0.3.1.0rc-3 - Added infix precedence to conversion operators - Added `INLINEABLE` pragma to conversion functions ## v0.3.0.1rc-2 Dropped GHC 7.8 support in favor of efficient and easy data conversion. ## v0.3.0.0rc-1 - improved documentation - fixed a bug with scope - small interface changes mustache-2.3.0/README.md0000644000000000000000000000433113200570152012766 0ustar0000000000000000# mustache [![Travis Status](https://travis-ci.org/JustusAdam/mustache.svg?branch=master)](https://travis-ci.org/JustusAdam/mustache) [![Hackage](https://img.shields.io/hackage/v/mustache.svg)](https://hackage.haskell.org/package/mustache) [![Join the chat at https://gitter.im/JustusAdam/mustache](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/JustusAdam/mustache?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) Haskell implementation of [mustache templates][mustache-homepage]. [mustache-homepage]: https://mustache.github.io Implements the official [specs version 1.1.3](https://github.com/mustache/spec/releases/tag/v1.1.3) ## Motivation The old Haskell implementation of mustache templates [hastache][] seemed pretty abandoned to me. This implementation aims to be much easier to use and (fingers crossed) better maintained. [hastache]: https://hackage.haskell.org/package/hastache Since it is so easy to use and requires but a few files of code, I've also written a small executable that compiles and renders mustache templates with data input from json or yaml files. ## Usage ### Library Please refer to the [documentation][] on hackage. [documentation]: https://hackage.haskell.org/package/mustache ### Executable `haskell-mustache` $ haskell-mustache --help Simple mustache template substitution arguments [OPTIONS] TEMPLATE [DATA-FILES] Common flags: -t --templatedirs[=DIRECTORY] The directory in which to search for the templates -? --help Display help message -V --version Print version information Current implementation substitutes the `TEMPLATE` once with each `DATA-FILE` #### Example $ haskell-mustache my-template-file data-file-1.json data-file-2.json data-file-3.json ## Roadmap - [x] String parser for mustache templates - [x] Template substitution - [x] Standalone executable - [x] Support for 'set delimiter' - [x] More efficiency using `Text` rather than `String` - [x] More efficient Text parsing - [x] Test coverage provided via the official [specs](https://github.com/mustache/spec) - [x] Haddock documentation - [ ] More instances for `ToMustache` typeclass mustache-2.3.0/test/unit/examples/partials/test-partial.txt.mustache0000644000000000000000000000002313200570152024056 0ustar0000000000000000and {{ partials }} mustache-2.3.0/test/unit/examples/test-template-partials.txt.mustache0000644000000000000000000000015013200570152024234 0ustar0000000000000000This {{ template }} was injected at compile time with an embedded file {{> test-partial.txt.mustache }} mustache-2.3.0/test/unit/examples/test-template.txt.mustache0000644000000000000000000000010713200570152022421 0ustar0000000000000000This {{ template }} was injected at compile time with an embedded file