mustache 1.0.2 → 2.0
raw patch · 10 files changed
+469/−374 lines, 10 filesdep +lensdep +tardep +template-haskell
Dependencies added: lens, tar, template-haskell, th-lift, wreq, zlib
Files
- CHANGELOG.md +8/−0
- app/Main.hs +20/−21
- mustache.cabal +12/−9
- src/Text/Mustache/Compile.hs +99/−34
- src/Text/Mustache/Internal.hs +5/−7
- src/Text/Mustache/Parser.hs +114/−118
- src/Text/Mustache/Render.hs +47/−47
- src/Text/Mustache/Types.hs +76/−66
- test/integration/Language.hs +53/−66
- test/unit/Spec.hs +35/−6
CHANGELOG.md view
@@ -1,5 +1,13 @@ # Mustache library changelog +## 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
app/Main.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE UnicodeSyntax #-} module Main (main) where @@ -10,7 +9,7 @@ import Data.Foldable (for_) import qualified Data.Text.IO as TIO (putStrLn) import Data.Yaml (decodeEither)-import Prelude.Unicode+ import System.Console.CmdArgs.Implicit (Data, Typeable, argPos, args, cmdArgs, def, help, summary, typ, (&=))@@ -20,13 +19,13 @@ data Arguments = Arguments- { template ∷ FilePath- , templateDirs ∷ [FilePath]- , dataFiles ∷ [FilePath]+ { template :: FilePath+ , templateDirs :: [FilePath]+ , dataFiles :: [FilePath] } deriving (Show, Data, Typeable) -commandArgs ∷ Arguments+commandArgs :: Arguments commandArgs = Arguments { template = def &= argPos 0@@ -40,33 +39,33 @@ } &= summary "Simple mustache template subtitution" -readJSON ∷ FilePath → IO (Either String Value)-readJSON = fmap eitherDecode ∘ BS.readFile+readJSON :: FilePath -> IO (Either String Value)+readJSON = fmap eitherDecode . BS.readFile -readYAML ∷ FilePath → IO (Either String Value)-readYAML = fmap decodeEither ∘ B.readFile+readYAML :: FilePath -> IO (Either String Value)+readYAML = fmap decodeEither . B.readFile -main ∷ IO ()+main :: IO () main = do- (Arguments { template, templateDirs, dataFiles }) ← cmdArgs commandArgs+ (Arguments { template, templateDirs, dataFiles }) <- cmdArgs commandArgs - eitherTemplate ← automaticCompile templateDirs template+ eitherTemplate <- automaticCompile templateDirs template case eitherTemplate of- Left err → print err- Right compiledTemplate →- for_ dataFiles $ \file → do+ Left err -> print err+ Right compiledTemplate ->+ for_ dataFiles $ \file -> do let decoder = case takeExtension file of- ".yml" → readYAML- ".yaml" → readYAML- _ → readJSON- decoded ← decoder file+ ".yml" -> readYAML+ ".yaml" -> readYAML+ _ -> readJSON+ decoded <- decoder file either putStrLn- (TIO.putStrLn ∘ substitute compiledTemplate ∘ toMustache)+ (TIO.putStrLn . substitute compiledTemplate . toMustache) decoded
mustache.cabal view
@@ -1,5 +1,5 @@ name: mustache-version: 1.0.2+version: 2.0 synopsis: A mustache template parser library. description: Allows parsing and rendering template files with mustache markup. See the@@ -28,9 +28,9 @@ source-repository this type: git- branch: export-fix+ branch: master location: git://github.com/JustusAdam/mustache.git- tag: v1.0.2+ tag: v2.0 @@ -45,6 +45,8 @@ , OverloadedStrings , LambdaCase , TupleSections+ , TemplateHaskell+ , QuasiQuotes build-depends: base >=4.7 && <5 , text , parsec@@ -57,8 +59,9 @@ , directory , filepath , scientific- , base-unicode-symbols , containers+ , template-haskell+ , th-lift hs-source-dirs: src default-language: Haskell2010 ghc-options:@@ -75,7 +78,6 @@ , cmdargs , text , filepath- , base-unicode-symbols default-language: Haskell2010 ghc-options: -threaded -Wall hs-source-dirs: app@@ -95,7 +97,6 @@ , process , temporary , directory- , base-unicode-symbols hs-source-dirs: test/unit default-language: Haskell2010 @@ -111,9 +112,11 @@ , unordered-containers , yaml , filepath- , process- , temporary- , directory , base-unicode-symbols+ , wreq+ , zlib+ , tar+ , lens+ , bytestring hs-source-dirs: test/integration default-language: Haskell2010
src/Text/Mustache/Compile.hs view
@@ -7,10 +7,12 @@ Stability : experimental Portability : POSIX -}-{-# LANGUAGE UnicodeSyntax #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-} module Text.Mustache.Compile ( automaticCompile, localAutomaticCompile, TemplateCache, compileTemplateWithCache- , compileTemplate, cacheFromList, getPartials, getFile+ , compileTemplate, cacheFromList, getPartials, getFile, mustache, embedTemplate, embedSingleTemplate ) where @@ -19,13 +21,15 @@ import Control.Monad.Except import Control.Monad.State import Control.Monad.Trans.Either-import Control.Monad.Unicode import Data.Bool import Data.HashMap.Strict as HM-import Data.Monoid.Unicode ((∅)) import Data.Text hiding (concat, find, map, uncons) import qualified Data.Text.IO as TIO-import Prelude.Unicode+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@@ -34,7 +38,6 @@ import Text.Parsec.Pos import Text.Printf - {-| Compiles a mustache template provided by name including the mentioned partials. @@ -46,12 +49,12 @@ 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 (∅)+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 :: FilePath -> IO (Either ParseError Template) localAutomaticCompile = automaticCompile ["."] @@ -59,30 +62,30 @@ 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 :: [FilePath]+ -> TemplateCache+ -> FilePath+ -> IO (Either ParseError Template) compileTemplateWithCache searchSpace templates initName = runEitherT $ evalStateT (compile' initName) $ flattenPartials templates where- compile' ∷ FilePath- → StateT+ compile' :: FilePath+ -> StateT (HM.HashMap String Template) (EitherT ParseError IO) Template compile' name' = do- templates' ← get+ templates' <- get case HM.lookup name' templates' of- Just template → return template- Nothing → do- rawSource ← lift $ getFile searchSpace name'- compiled@(Template { ast = mSTree }) ←+ Just template -> return template+ Nothing -> do+ rawSource <- lift $ getFile searchSpace name'+ compiled@(Template { ast = mSTree }) <- lift $ hoistEither $ compileTemplate name' rawSource foldM- (\st@(Template { partials = p }) partialName → do- nt ← compile' partialName+ (\st@(Template { partials = p }) partialName -> do+ nt <- compile' partialName modify (HM.insert partialName nt) return (st { partials = HM.insert partialName nt p }) )@@ -91,14 +94,14 @@ -- | Flatten a list of Templates into a single 'TemplateChache'-cacheFromList ∷ [Template] → TemplateCache-cacheFromList = flattenPartials ∘ fromList ∘ fmap (name &&& id)+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') (∅)) ∘ parse name'+compileTemplate :: String -> Text -> Either ParseError Template+compileTemplate name' = fmap (flip (Template name') mempty) . parse name' {-|@@ -106,21 +109,21 @@ Same as @join . fmap getPartials'@ -}-getPartials ∷ STree → [FilePath]-getPartials = join ∘ fmap getPartials'+getPartials :: STree -> [FilePath]+getPartials = join . fmap getPartials' {-| Find partials in a single Node -}-getPartials' ∷ Node Text → [FilePath]+getPartials' :: Node Text -> [FilePath] getPartials' (Partial _ p) = return p getPartials' (Section _ n) = getPartials n getPartials' (InvertedSection _ n) = getPartials n-getPartials' _ = (∅)+getPartials' _ = mempty -flattenPartials ∷ TemplateCache → TemplateCache+flattenPartials :: TemplateCache -> TemplateCache flattenPartials m = foldrWithKey (insertWith (\_ b -> b)) m m @@ -132,10 +135,10 @@ This trows 'ParseError's to be compatible with the internal Either Monad of 'compileTemplateWithCache'. -}-getFile ∷ [FilePath] → FilePath → EitherT ParseError IO Text+getFile :: [FilePath] -> FilePath -> EitherT ParseError IO Text getFile [] fp = throwError $ fileNotFound fp getFile (templateDir : xs) fp =- lift (doesFileExist filePath) ≫=+ lift (doesFileExist filePath) >>= bool (getFile xs fp) (lift $ TIO.readFile filePath)@@ -143,7 +146,69 @@ 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 :: FilePath -> ParseError fileNotFound fp = newErrorMessage (Message $ printf "Template file '%s' not found" fp) (initialPos fp)
src/Text/Mustache/Internal.hs view
@@ -9,23 +9,21 @@ escapeXML and xmlEntities curtesy to the tagsoup library. -}-{-# LANGUAGE UnicodeSyntax #-} module Text.Mustache.Internal (uncons, escapeXMLText) where -import Data.Char (ord)-import qualified Data.IntMap as IntMap-import qualified Data.Text as T-import Prelude.Unicode+import Data.Char (ord)+import qualified Data.IntMap as IntMap+import qualified Data.Text as T -uncons ∷ [α] → Maybe (α, [α])+uncons :: [α] -> Maybe (α, [α]) uncons [] = Nothing uncons (x:xs) = return (x, xs) escapeXMLText :: T.Text -> T.Text-escapeXMLText = T.pack ∘ escapeXML ∘ T.unpack+escapeXMLText = T.pack . escapeXML . T.unpack escapeXML :: String -> String
src/Text/Mustache/Parser.hs view
@@ -13,7 +13,6 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-}-{-# LANGUAGE UnicodeSyntax #-} module Text.Mustache.Parser ( -- * Generic parsing functions@@ -37,30 +36,27 @@ import Control.Monad-import Control.Monad.Unicode-import Data.Char (isAlphaNum, isSpace)-import Data.Functor ((<$>))-import Data.List (nub)-import Data.Monoid.Unicode ((∅), (⊕))-import Data.Text as T (Text, null, pack)-import Prelude as Prel-import Prelude.Unicode+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)+import Text.Parsec as P hiding (endOfLine, parse) -- | Initial configuration for the parser data MustacheConf = MustacheConf- { delimiters ∷ (String, String)+ { delimiters :: (String, String) } -- | User state for the parser data MustacheState = MustacheState- { sDelimiters ∷ (String, String)- , textStack ∷ Text- , isBeginngingOfLine ∷ Bool- , currentSectionName ∷ Maybe DataIdentifier+ { sDelimiters :: (String, String)+ , textStack :: Text+ , isBeginngingOfLine :: Bool+ , currentSectionName :: Maybe DataIdentifier } @@ -72,60 +68,60 @@ -- | @#@-sectionBegin ∷ Char+sectionBegin :: Char sectionBegin = '#' -- | @/@-sectionEnd ∷ Char+sectionEnd :: Char sectionEnd = '/' -- | @>@-partialBegin ∷ Char+partialBegin :: Char partialBegin = '>' -- | @^@-invertedSectionBegin ∷ Char+invertedSectionBegin :: Char invertedSectionBegin = '^' -- | @{@ and @}@-unescape2 ∷ (Char, Char)+unescape2 :: (Char, Char) unescape2 = ('{', '}') -- | @&@-unescape1 ∷ Char+unescape1 :: Char unescape1 = '&' -- | @=@-delimiterChange ∷ Char+delimiterChange :: Char delimiterChange = '=' -- | @.@-nestingSeparator ∷ Char+nestingSeparator :: Char nestingSeparator = '.' -- | @!@-comment ∷ Char+comment :: Char comment = '!' -- | @.@-implicitIterator ∷ Char+implicitIterator :: Char implicitIterator = '.' -- | Cannot be a letter, number or the nesting separation Character @.@-isAllowedDelimiterCharacter ∷ Char → Bool+isAllowedDelimiterCharacter :: Char -> Bool isAllowedDelimiterCharacter =- not ∘ Prel.or ∘ sequence- [ isSpace, isAlphaNum, (≡ nestingSeparator) ]-allowedDelimiterCharacter ∷ Parser Char+ not . Prel.or . sequence+ [ isSpace, isAlphaNum, (== nestingSeparator) ]+allowedDelimiterCharacter :: Parser Char allowedDelimiterCharacter = satisfy isAllowedDelimiterCharacter -- | Empty configuration-emptyState ∷ MustacheState-emptyState = MustacheState ("", "") (∅) True Nothing+emptyState :: MustacheState+emptyState = MustacheState ("", "") mempty True Nothing -- | Default configuration (delimiters = ("{{", "}}"))-defaultConf ∷ MustacheConf+defaultConf :: MustacheConf defaultConf = MustacheConf ("{{", "}}") -initState ∷ MustacheConf → MustacheState+initState :: MustacheConf -> MustacheState initState (MustacheConf { delimiters }) = emptyState { sDelimiters = delimiters } -setIsBeginning ∷ Bool → Parser ()+setIsBeginning :: Bool -> Parser () setIsBeginning b = modifyState (\s -> s { isBeginngingOfLine = b }) @@ -133,183 +129,183 @@ type Parser = Parsec Text MustacheState -(<<) ∷ Monad m ⇒ m b → m a → m b-(<<) = flip (≫)+(<<) :: Monad m => m b -> m a -> m b+(<<) = flip (>>) -endOfLine ∷ Parser String+endOfLine :: Parser String endOfLine = do- r ← optionMaybe $ char '\r'- n ← char '\n'+ 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 :: 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+parseWithConf :: MustacheConf -> FilePath -> Text -> Either ParseError STree+parseWithConf = P.runParser parseText . initState -parseText ∷ Parser STree+parseText :: Parser STree parseText = do- (MustacheState { isBeginngingOfLine }) ← getState+ (MustacheState { isBeginngingOfLine }) <- getState if isBeginngingOfLine then parseLine else continueLine -appendStringStack ∷ String → Parser ()-appendStringStack t = modifyState (\s → s { textStack = textStack s ⊕ pack t})+appendStringStack :: String -> Parser ()+appendStringStack t = modifyState (\s -> s { textStack = textStack s <> pack t}) -continueLine ∷ Parser STree+continueLine :: Parser STree continueLine = do- (MustacheState { sDelimiters = ( start@(x:_), _ )}) ← getState+ (MustacheState { sDelimiters = ( start@(x:_), _ )}) <- getState let forbidden = x : "\n\r" - many (noneOf forbidden) ≫= appendStringStack+ many (noneOf forbidden) >>= appendStringStack - (try endOfLine ≫= appendStringStack ≫ setIsBeginning True ≫ parseLine)- <|> (try (string start) ≫ switchOnTag ≫= continueFromTag)- <|> (try eof ≫ finishFile)- <|> (anyChar ≫= appendStringStack . (:[]) ≫ continueLine)+ (try endOfLine >>= appendStringStack >> setIsBeginning True >> parseLine)+ <|> (try (string start) >> switchOnTag >>= continueFromTag)+ <|> (try eof >> finishFile)+ <|> (anyChar >>= appendStringStack . (:[]) >> continueLine) -flushText ∷ Parser STree+flushText :: Parser STree flushText = do- s@(MustacheState { textStack = text }) ← getState- putState $ s { textStack = (∅) }+ s@(MustacheState { textStack = text }) <- getState+ putState $ s { textStack = mempty } return $ if T.null text then [] else [TextBlock text] -finishFile ∷ Parser STree+finishFile :: Parser STree finishFile =- getState ≫= \case- (MustacheState {currentSectionName = Nothing}) → flushText- (MustacheState {currentSectionName = Just name}) →- parserFail $ "Unclosed section " ⊕ show name+ getState >>= \case+ (MustacheState {currentSectionName = Nothing}) -> flushText+ (MustacheState {currentSectionName = Just name}) ->+ parserFail $ "Unclosed section " <> show name -parseLine ∷ Parser STree+parseLine :: Parser STree parseLine = do- (MustacheState { sDelimiters = ( start, _ ) }) ← getState- initialWhitespace ← many (oneOf " \t")+ (MustacheState { sDelimiters = ( start, _ ) }) <- getState+ initialWhitespace <- many (oneOf " \t") let handleStandalone = do- tag ← switchOnTag+ tag <- switchOnTag let continueNoStandalone = do appendStringStack initialWhitespace setIsBeginning False continueFromTag tag standaloneEnding = do- try (skipMany (oneOf " \t") ≫ (eof <|> void endOfLine))+ try (skipMany (oneOf " \t") >> (eof <|> void endOfLine)) setIsBeginning True case tag of- Tag (Partial _ name) →- ( standaloneEnding ≫+ Tag (Partial _ name) ->+ ( standaloneEnding >> continueFromTag (Tag (Partial (Just (pack initialWhitespace)) name)) ) <|> continueNoStandalone- Tag _ → continueNoStandalone- _ →- ( standaloneEnding ≫+ Tag _ -> continueNoStandalone+ _ ->+ ( standaloneEnding >> continueFromTag tag ) <|> continueNoStandalone- (try (string start) ≫ handleStandalone)- <|> (try eof ≫ appendStringStack initialWhitespace ≫ finishFile)- <|> (appendStringStack initialWhitespace ≫ setIsBeginning False ≫ continueLine)+ (try (string start) >> handleStandalone)+ <|> (try eof >> appendStringStack initialWhitespace >> finishFile)+ <|> (appendStringStack initialWhitespace >> setIsBeginning False >> continueLine) -continueFromTag ∷ ParseTagRes → Parser STree+continueFromTag :: ParseTagRes -> Parser STree continueFromTag (SectionBegin inverted name) = do- textNodes ← flushText+ textNodes <- flushText state@(MustacheState- { currentSectionName = previousSection }) ← getState+ { currentSectionName = previousSection }) <- getState putState $ state { currentSectionName = return name }- innerSectionContent ← parseText+ innerSectionContent <- parseText let sectionTag = if inverted then InvertedSection else Section- modifyState $ \s → s { currentSectionName = previousSection }- outerSectionContent ← parseText- return (textNodes ⊕ [sectionTag name innerSectionContent] ⊕ outerSectionContent)+ modifyState $ \s -> s { currentSectionName = previousSection }+ outerSectionContent <- parseText+ return (textNodes <> [sectionTag name innerSectionContent] <> outerSectionContent) continueFromTag (SectionEnd name) = do (MustacheState- { currentSectionName }) ← getState+ { 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."+ 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+ textNodes <- flushText+ furtherNodes <- parseText+ return $ textNodes <> return tag <> furtherNodes continueFromTag HandledTag = parseText -switchOnTag ∷ Parser ParseTagRes+switchOnTag :: Parser ParseTagRes switchOnTag = do- (MustacheState { sDelimiters = ( _, end )}) ← getState+ (MustacheState { sDelimiters = ( _, end )}) <- getState choice- [ SectionBegin False <$> (try (char sectionBegin) ≫ genParseTagEnd (∅))+ [ SectionBegin False <$> (try (char sectionBegin) >> genParseTagEnd mempty) , SectionEnd- <$> (try (char sectionEnd) ≫ genParseTagEnd (∅))- , Tag ∘ Variable False- <$> (try (char unescape1) ≫ genParseTagEnd (∅))- , 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)))+ <$> (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)+ << (try (char delimiterChange) >> parseDelimChange) , SectionBegin True- <$> (try (char invertedSectionBegin) ≫ genParseTagEnd (∅) ≫= \case- n@(NamedData _) → return n- _ → parserFail "Inverted Sections can not be implicit."+ <$> (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))+ , return HandledTag << (try (char comment) >> manyTill anyChar (try $ string end)) , Tag . Variable True- <$> genParseTagEnd (∅)+ <$> genParseTagEnd mempty ] where parseDelimChange = do- (MustacheState { sDelimiters = ( _, end )}) ← getState+ (MustacheState { sDelimiters = ( _, end )}) <- getState spaces- delim1 ← allowedDelimiterCharacter `manyTill` space+ delim1 <- allowedDelimiterCharacter `manyTill` space spaces- delim2 ← allowedDelimiterCharacter `manyTill` try (spaces ≫ string (delimiterChange : end))- when (delim1 ≡ (∅) ∨ delim2 ≡ (∅))+ delim2 <- allowedDelimiterCharacter `manyTill` try (spaces >> string (delimiterChange : end))+ when (delim1 == mempty || delim2 == mempty) $ parserFail "Tags must contain more than 0 characters"- oldState ← getState+ oldState <- getState putState $ oldState { sDelimiters = (delim1, delim2) } -genParseTagEnd ∷ String → Parser DataIdentifier+genParseTagEnd :: String -> Parser DataIdentifier genParseTagEnd emod = do- (MustacheState { sDelimiters = ( start, end ) }) ← getState+ (MustacheState { sDelimiters = ( start, end ) }) <- getState - let nEnd = emod ⊕ end- disallowed = nub $ nestingSeparator : start ⊕ end+ let nEnd = emod <> end+ disallowed = nub $ nestingSeparator : start <> end parseOne :: Parser [Text] parseOne = do - one ← noneOf disallowed+ one <- noneOf disallowed `manyTill` lookAhead- (try (spaces ≫ void (string nEnd))+ (try (spaces >> void (string nEnd)) <|> try (void $ char nestingSeparator)) - others ← (char nestingSeparator ≫ parseOne)- <|> (const (∅) <$> (spaces ≫ string nEnd))+ others <- (char nestingSeparator >> parseOne)+ <|> (const mempty <$> (spaces >> string nEnd)) return $ pack one : others spaces- (try (char implicitIterator) ≫ spaces ≫ string nEnd ≫ return Implicit)+ (try (char implicitIterator) >> spaces >> string nEnd >> return Implicit) <|> (NamedData <$> parseOne)
src/Text/Mustache/Render.hs view
@@ -8,7 +8,6 @@ Portability : POSIX -} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE UnicodeSyntax #-} module Text.Mustache.Render ( -- * Substitution@@ -20,20 +19,21 @@ ) where -import Control.Applicative ((<$>), (<|>))+import Control.Applicative ((<|>)) import Control.Arrow (first) import Control.Monad-import Control.Monad.Unicode+ import Data.Foldable (fold)-import Data.HashMap.Strict as HM hiding (map)+import Data.HashMap.Strict as HM hiding (keys, map) import Data.Maybe (fromMaybe)-import Data.Monoid.Unicode+ import Data.Scientific (floatingOrInteger) import Data.Text as T (Text, isSuffixOf, null, pack,- replace, stripSuffix)+ replace, stripSuffix) import qualified Data.Vector as V import Prelude hiding (length, lines, unlines)-import Prelude.Unicode++import Data.Monoid ((<>)) import Text.Mustache.Internal import Text.Mustache.Types @@ -44,64 +44,64 @@ Equivalent to @substituteValue . toMustache@. -}-substitute ∷ ToMustache κ ⇒ Template → κ → Text-substitute t = substituteValue t ∘ 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. -}-substituteValue ∷ Template → Value → Text+substituteValue :: Template -> Value -> Text substituteValue (Template { ast = cAst, partials = cPartials }) dataStruct =- joinSubstituted (substitute' (Context (∅) dataStruct)) cAst+ joinSubstituted (substitute' (Context mempty dataStruct)) cAst where- joinSubstituted f = fold ∘ fmap f+ joinSubstituted f = fold . fmap f -- Main substitution function- substitute' ∷ Context Value → Node Text → Text+ substitute' :: Context Value -> Node Text -> Text -- subtituting text substitute' _ (TextBlock t) = t -- substituting a whole section (entails a focus shift) substitute' (Context parents focus@(Array a)) (Section Implicit secSTree)- | V.null a = (∅)- | otherwise = flip joinSubstituted a $ \focus' →+ | V.null a = mempty+ | otherwise = flip joinSubstituted a $ \focus' -> let newContext = Context (focus:parents) focus' in joinSubstituted (substitute' newContext) secSTree substitute' context@(Context _ (Object _)) (Section Implicit secSTree) = joinSubstituted (substitute' context) secSTree- substitute' _ (Section Implicit _) = (∅)+ substitute' _ (Section Implicit _) = mempty substitute' context@(Context parents focus) (Section (NamedData secName) secSTree) = case search context secName of- Just arr@(Array arrCont) →+ Just arr@(Array arrCont) -> if V.null arrCont- then (∅)- else flip joinSubstituted arrCont $ \focus' →+ then mempty+ else flip joinSubstituted arrCont $ \focus' -> let newContext = Context (arr:focus:parents) focus' in joinSubstituted (substitute' newContext) secSTree- Just (Bool False) → (∅)- Just (Lambda l) → joinSubstituted (substitute' context) (l context secSTree)- Just focus' →+ Just (Bool False) -> mempty+ Just (Lambda l) -> joinSubstituted (substitute' context) (l context secSTree)+ Just focus' -> let newContext = Context (focus:parents) focus' in joinSubstituted (substitute' newContext) secSTree- Nothing → (∅)+ Nothing -> mempty -- substituting an inverted section- substitute' _ (InvertedSection Implicit _ ) = (∅)+ substitute' _ (InvertedSection Implicit _ ) = mempty substitute' context (InvertedSection (NamedData secName) invSecSTree) = case search context secName of- Just (Bool False) → contents- Just (Array a) | V.null a → contents- Nothing → contents- _ → (∅)+ Just (Bool False) -> contents+ Just (Array a) | V.null a -> contents+ Nothing -> contents+ _ -> mempty where contents = joinSubstituted (substitute' context) invSecSTree @@ -109,21 +109,21 @@ substitute' (Context _ current) (Variable _ Implicit) = toString current substitute' context (Variable escaped (NamedData varName)) = maybe- (∅)+ mempty (if escaped then escapeXMLText else id) $ toString <$> search context varName -- substituting a partial substitute' context (Partial indent pName) = maybe- (∅)- (joinSubstituted (substitute' context) ∘ handleIndent indent ∘ ast)+ mempty+ (joinSubstituted (substitute' context) . handleIndent indent . ast) $ HM.lookup pName cPartials -handleIndent ∷ Maybe Text → STree → STree+handleIndent :: Maybe Text -> STree -> STree handleIndent Nothing ast' = ast'-handleIndent (Just indentation) ast' = preface ⊕ content+handleIndent (Just indentation) ast' = preface <> content where preface = if T.null indentation then [] else [TextBlock indentation] content = if T.null indentation@@ -132,12 +132,12 @@ let fullIndented = fmap (indentBy indentation) ast' dropper (TextBlock t) = TextBlock $- if ("\n" ⊕ indentation) `isSuffixOf` t+ 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))+ reverse $ fromMaybe [] (uncurry (:) . first dropper <$> uncons (reverse fullIndented)) -- | Search for a key in the current context.@@ -145,40 +145,40 @@ -- 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 :: Context Value -> [Key] -> Maybe Value search _ [] = Nothing-search ctx keys@(_:nextKeys) = go ctx keys ≫= innerSearch nextKeys+search ctx keys@(_:nextKeys) = go ctx keys >>= innerSearch nextKeys where go _ [] = Nothing go (Context parents focus) val@(x:_) = ( case focus of- (Object o) → HM.lookup x o- _ → Nothing+ (Object o) -> HM.lookup x o+ _ -> Nothing ) <|> ( do- (newFocus, newParents) ← uncons parents+ (newFocus, newParents) <- uncons parents go (Context newParents newFocus) val ) -indentBy ∷ Text → Node Text → Node Text+indentBy :: Text -> Node Text -> Node Text indentBy indent p@(Partial (Just indent') name') | T.null indent = p- | otherwise = Partial (Just (indent ⊕ indent')) name'+ | 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 indent (TextBlock t) = TextBlock $ replace "\n" ("\n" <> indent) t 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 :: [Key] -> Value -> Maybe Value innerSearch [] v = Just v-innerSearch (y:ys) (Object o) = HM.lookup y o ≫= innerSearch ys+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 → Text+toString :: Value -> Text toString (String t) = t-toString (Number n) = either (pack ∘ show) (pack ∘ show) (floatingOrInteger n ∷ Either Double Integer)+toString (Number n) = either (pack . show) (pack . show) (floatingOrInteger n :: Either Double Integer) toString e = pack $ show e
src/Text/Mustache/Types.hs view
@@ -7,12 +7,12 @@ Stability : experimental Portability : POSIX -}+{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-}-{-# LANGUAGE UnicodeSyntax #-}-{-# LANGUAGE BangPatterns #-} module Text.Mustache.Types ( -- * Types for the Parser / Template@@ -35,15 +35,15 @@ ) where -import qualified Data.Aeson as Aeson-import Data.HashMap.Strict as HM-import qualified Data.HashSet as HS-import qualified Data.Map as Map+import qualified Data.Aeson as Aeson+import Data.HashMap.Strict as HM+import qualified Data.HashSet as HS+import qualified Data.Map as Map import Data.Scientific import Data.Text-import qualified Data.Text.Lazy as LT-import qualified Data.Vector as V-import Prelude.Unicode+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@@ -87,7 +87,7 @@ | Array !Array | Number !Scientific | String !Text- | Lambda (Context Value → STree → STree)+ | Lambda (Context Value -> STree -> STree) | Bool !Bool | Null @@ -103,25 +103,25 @@ -- | Conversion class class ToMustache ω where- toMustache ∷ ω → Value- listToMustache ∷ [ω] → Value- listToMustache = Array ∘ V.fromList ∘ fmap toMustache+ toMustache :: ω -> Value+ listToMustache :: [ω] -> Value+ listToMustache = Array . V.fromList . fmap toMustache instance ToMustache Float where- toMustache = Number ∘ fromFloatDigits+ toMustache = Number . fromFloatDigits instance ToMustache Double where- toMustache = Number ∘ fromFloatDigits+ toMustache = Number . fromFloatDigits instance ToMustache Integer where- toMustache = Number ∘ fromInteger+ toMustache = Number . fromInteger instance ToMustache Int where toMustache = toMustache . toInteger instance ToMustache Char where- toMustache = toMustache ∘ (:[])- listToMustache = String ∘ pack+ toMustache = toMustache . (:[])+ listToMustache = String . pack instance ToMustache Value where toMustache = id@@ -136,75 +136,75 @@ toMustache = String instance ToMustache LT.Text where- toMustache = String ∘ LT.toStrict+ toMustache = String . LT.toStrict instance ToMustache Scientific where toMustache = Number -instance ToMustache α ⇒ ToMustache [α] where+instance ToMustache α => ToMustache [α] where toMustache = listToMustache -instance ToMustache ω ⇒ ToMustache (V.Vector ω) where- toMustache = toMustache ∘ fmap toMustache+instance ToMustache ω => ToMustache (V.Vector ω) where+ toMustache = toMustache . fmap toMustache -instance (ToMustache ω) ⇒ ToMustache (Map.Map Text ω) where+instance (ToMustache ω) => ToMustache (Map.Map Text ω) where toMustache = mapInstanceHelper id -instance (ToMustache ω) ⇒ ToMustache (Map.Map LT.Text ω) where+instance (ToMustache ω) => ToMustache (Map.Map LT.Text ω) where toMustache = mapInstanceHelper LT.toStrict -instance (ToMustache ω) ⇒ ToMustache (Map.Map String ω) where+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)+ . Map.foldrWithKey+ (\k -> HM.insert (conv k) . toMustache) HM.empty -instance ToMustache ω ⇒ ToMustache (HM.HashMap Text ω) where- toMustache = toMustache ∘ fmap toMustache+instance ToMustache ω => ToMustache (HM.HashMap Text ω) where+ toMustache = toMustache . fmap toMustache -instance ToMustache ω ⇒ ToMustache (HM.HashMap LT.Text ω) where+instance ToMustache ω => ToMustache (HM.HashMap LT.Text ω) where toMustache = hashMapInstanceHelper LT.toStrict -instance ToMustache ω ⇒ ToMustache (HM.HashMap String ω) where+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.foldrWithKey+ (\k -> HM.insert (conv k) . toMustache) HM.empty -instance ToMustache (Context Value → STree → STree) where+instance ToMustache (Context Value -> STree -> STree) where toMustache = Lambda -instance ToMustache (Context Value → STree → Text) where+instance ToMustache (Context Value -> STree -> Text) where toMustache = lambdaInstanceHelper id -instance ToMustache (Context Value → STree → LT.Text) where+instance ToMustache (Context Value -> STree -> LT.Text) where toMustache = lambdaInstanceHelper LT.toStrict -instance ToMustache (Context Value → STree → String) where+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+ 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 -> STree) where+ toMustache f = toMustache (const f :: Context Value -> STree -> STree) -instance ToMustache (STree → Text) where+instance ToMustache (STree -> Text) where toMustache f = toMustache wrapper where- wrapper ∷ Context Value → STree → STree- wrapper _ = (return ∘ TextBlock) ∘ f+ wrapper :: Context Value -> STree -> STree+ wrapper _ = (return . TextBlock) . f instance ToMustache Aeson.Value where toMustache (Aeson.Object o) = Object $ fmap toMustache o@@ -214,18 +214,18 @@ toMustache (Aeson.Bool b) = Bool b toMustache Aeson.Null = Null -instance ToMustache ω ⇒ ToMustache (HS.HashSet ω) where- toMustache = toMustache ∘ HS.toList+instance ToMustache ω => ToMustache (HS.HashSet ω) where+ toMustache = toMustache . HS.toList -instance (ToMustache α, ToMustache β) ⇒ ToMustache (α, β) where+instance (ToMustache α, ToMustache β) => ToMustache (α, β) where toMustache (a, b) = toMustache [toMustache a, toMustache b] instance (ToMustache α, ToMustache β, ToMustache γ)- ⇒ ToMustache (α, β, γ) where+ => ToMustache (α, β, γ) where toMustache (a, b, c) = toMustache [toMustache a, toMustache b, toMustache c] instance (ToMustache α, ToMustache β, ToMustache γ, ToMustache δ)- ⇒ ToMustache (α, β, γ, δ) where+ => ToMustache (α, β, γ, δ) where toMustache (a, b, c, d) = toMustache [ toMustache a , toMustache b@@ -238,7 +238,7 @@ , ToMustache γ , ToMustache δ , ToMustache ε- ) ⇒ ToMustache (α, β, γ, δ, ε) where+ ) => ToMustache (α, β, γ, δ, ε) where toMustache (a, b, c, d, e) = toMustache [ toMustache a , toMustache b@@ -253,7 +253,7 @@ , ToMustache δ , ToMustache ε , ToMustache ζ- ) ⇒ ToMustache (α, β, γ, δ, ε, ζ) where+ ) => ToMustache (α, β, γ, δ, ε, ζ) where toMustache (a, b, c, d, e, f) = toMustache [ toMustache a , toMustache b@@ -270,7 +270,7 @@ , ToMustache ε , ToMustache ζ , ToMustache η- ) ⇒ ToMustache (α, β, γ, δ, ε, ζ, η) where+ ) => ToMustache (α, β, γ, δ, ε, ζ, η) where toMustache (a, b, c, d, e, f, g) = toMustache [ toMustache a , toMustache b@@ -289,7 +289,7 @@ , ToMustache ζ , ToMustache η , ToMustache θ- ) ⇒ ToMustache (α, β, γ, δ, ε, ζ, η, θ) where+ ) => ToMustache (α, β, γ, δ, ε, ζ, η, θ) where toMustache (a, b, c, d, e, f, g, h) = toMustache [ toMustache a , toMustache b@@ -326,20 +326,20 @@ -- 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+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+(~>) :: ToMustache ω => Text -> ω -> Pair+(~>) t = (t, ) . toMustache {-# INLINEABLE (~>) #-} infixr 8 ~> -- | Unicode version of '~>'-(↝) ∷ ToMustache ω ⇒ Text → ω → Pair+(↝) :: ToMustache ω => Text -> ω -> Pair (↝) = (~>) {-# INLINEABLE (↝) #-} infixr 8 ↝@@ -348,22 +348,22 @@ -- | Map keys to values that provide a 'ToJSON' instance -- -- Recommended in conjunction with the `OverloadedStrings` extension.-(~=) ∷ Aeson.ToJSON ι ⇒ Text → ι → Pair-(~=) t = (t ~>) ∘ Aeson.toJSON+(~=) :: Aeson.ToJSON ι => Text -> ι -> Pair+(~=) t = (t ~>) . Aeson.toJSON {-# INLINEABLE (~=) #-} infixr 8 ~= -- | Unicode version of '~='-(⥱) ∷ Aeson.ToJSON ι ⇒ Text → ι → Pair+(⥱) :: 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+mFromJSON :: Aeson.ToJSON ι => ι -> Value+mFromJSON = toMustache . Aeson.toJSON -- | A collection of templates with quick access via their hashed names@@ -376,7 +376,17 @@ A compiled Template with metadata. -} data Template = Template- { name ∷ String- , ast ∷ STree- , partials ∷ TemplateCache+ { 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
test/integration/Language.hs view
@@ -1,36 +1,35 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE UnicodeSyntax #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE UnicodeSyntax #-} module Main where -import Control.Applicative ((<$>), (<*>))+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.Either-import Data.Foldable (for_)-import qualified Data.HashMap.Strict as HM (HashMap, elems, empty, lookup,- traverseWithKey)+import Data.ByteString.Lazy (toStrict)+import Data.Foldable (for_)+import qualified Data.HashMap.Strict as HM (HashMap, empty,+ traverseWithKey) import Data.List-import Data.Monoid (mempty, (<>))-import qualified Data.Text as T-import Data.Yaml as Y (FromJSON, Value (..), decodeFile,- parseJSON, (.!=), (.:), (.:?))-import Debug.Trace (traceShowId)-import System.Directory+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 System.IO.Temp-import System.Process import Test.Hspec import Text.Mustache-import Text.Mustache.Parser-import Text.Mustache.Types --- (langspecDir, specDir, releaseFile, releaseURL)+langspecs :: [String] langspecs =- [ ("andrewthad-spec-786e4ac", "specs", "langspec-pull.tar.gz", "https://codeload.github.com/andrewthad/spec/legacy.tar.gz/add_list_context_check")- , ("spec-1.1.3", "specs", "langspec-off.tar.gz", "https://codeload.github.com/mustache/spec/tar.gz/v1.1.3")+ [ "https://codeload.github.com/andrewthad/spec/legacy.tar.gz/add_list_context_check"+ , "https://codeload.github.com/mustache/spec/tar.gz/v1.1.3" ] @@ -68,56 +67,44 @@ parseJSON _ = mzero -(&) ∷ a → (a → b) → b-(&) = flip ($)---getOfficialSpecRelease ∷ FilePath -> FilePath -> FilePath -> FilePath → IO ()-getOfficialSpecRelease tempdir langspecDir releaseFile releaseURL = do- currentDirectory ← getCurrentDirectory- setCurrentDirectory tempdir- createDirectory langspecDir- callProcess "curl" [releaseURL, "-o", releaseFile]- callProcess "tar" ["-xf", releaseFile]- setCurrentDirectory currentDirectory+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 ∷ FilePath → Spec-testOfficialLangSpec dir = do- allFiles ← runIO $ getDirectoryContents dir- let testfiles = allFiles- & filter ((`elem` [".yml", ".yaml"]) . takeExtension)- -- Filters the lambda tests for now.- & filter (not . ("~" `isPrefixOf`) . takeFileName)- for_ testfiles $ \filename →- runIO (decodeFile (dir </> filename)) >>= \case- Nothing -> describe ("File: " <> takeFileName filename) $- it "loads the data file" $- expectationFailure "Data file could not be parsed"- Just (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+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 $- withSystemTempDirectory- "mustache-test-resources"- $ \tempdir → do- for_ langspecs $ \(langspecDir, _, releaseFile, releaseURL) ->- getOfficialSpecRelease tempdir langspecDir releaseFile releaseURL- hspec $- for_ langspecs $ \(langspecDir, specDir, _, _) ->- testOfficialLangSpec (tempdir </> langspecDir </> specDir)+ void $ do+ specs <- mapM getOfficialSpecRelease langspecs+ hspec $ mapM_ testOfficialLangSpec specs
test/unit/Spec.hs view
@@ -1,23 +1,28 @@+{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE UnicodeSyntax #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-} module Main where -import Control.Applicative ((<$>), (<*>))+import Control.Applicative ((<$>), (<*>)) import Data.Either-import qualified Data.Text as T+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-import Data.Monoid -escaped ∷ Bool+escaped :: Bool escaped = True-unescaped ∷ Bool+unescaped :: Bool unescaped = False @@ -191,9 +196,33 @@ 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