doctemplates-0.1.0.2/src/0000755000000000000000000000000012774023427013321 5ustar0000000000000000doctemplates-0.1.0.2/src/Text/0000755000000000000000000000000012774152370014245 5ustar0000000000000000doctemplates-0.1.0.2/test/0000755000000000000000000000000012774017271013511 5ustar0000000000000000doctemplates-0.1.0.2/src/Text/DocTemplates.hs0000644000000000000000000002427512774152370017177 0ustar0000000000000000{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, OverloadedStrings, GeneralizedNewtypeDeriving, ScopedTypeVariables #-} {- | Module : Text.Pandoc.Templates Copyright : Copyright (C) 2009-2016 John MacFarlane License : BSD3 Maintainer : John MacFarlane Stability : alpha Portability : portable A simple templating system with variable substitution and conditionals. This module was formerly part of pandoc and is used for pandoc's templates. The following program illustrates its use: > {-# LANGUAGE OverloadedStrings #-} > import Data.Text > import Data.Aeson > import Text.DocTemplates > > data Employee = Employee { firstName :: String > , lastName :: String > , salary :: Maybe Int } > instance ToJSON Employee where > toJSON e = object [ "name" .= object [ "first" .= firstName e > , "last" .= lastName e ] > , "salary" .= salary e ] > > template :: Text > template = "$for(employee)$Hi, $employee.name.first$. $if(employee.salary)$You make $employee.salary$.$else$No salary data.$endif$$sep$\n$endfor$" > > main = case compileTemplate template of > Left e -> error e > Right t -> putStrLn $ renderTemplate t $ object > ["employee" .= > [ Employee "John" "Doe" Nothing > , Employee "Omar" "Smith" (Just 30000) > , Employee "Sara" "Chen" (Just 60000) ] > ] A slot for an interpolated variable is a variable name surrounded by dollar signs. To include a literal @$@ in your template, use @$$@. Variable names must begin with a letter and can contain letters, numbers, @_@, @-@, and @.@. The values of variables are determined by a JSON object that is passed as a parameter to @renderTemplate@. So, for example, @title@ will return the value of the @title@ field, and @employee.salary@ will return the value of the @salary@ field of the object that is the value of the @employee@ field. The value of a variable will be indented to the same level as the variable. A conditional begins with @$if(variable_name)$@ and ends with @$endif$@. It may optionally contain an @$else$@ section. The if section is used if @variable_name@ has a non-null value, otherwise the else section is used. Conditional keywords should not be indented, or unexpected spacing problems may occur. The @$for$@ keyword can be used to iterate over an array. If the value of the associated variable is not an array, a single iteration will be performed on its value. You may optionally specify separators using @$sep$@, as in the example above. -} module Text.DocTemplates ( renderTemplate , applyTemplate , TemplateTarget(..) , varListToJSON , compileTemplate , Template ) where import Data.Char (isAlphaNum) import Control.Monad (guard, when) import Data.Aeson (ToJSON(..), Value(..)) import qualified Text.Parsec as P import Text.Parsec.Text (Parser) import qualified Data.Set as Set import Data.Monoid import Control.Applicative import qualified Data.Text as T import Data.Text (Text) import Data.Text.Encoding (encodeUtf8) import Data.List (intersperse) import qualified Data.Map as M import qualified Data.HashMap.Strict as H import Data.Foldable (toList) import Text.Blaze.Html (Html) import Text.Blaze.Internal (preEscapedText) import Data.ByteString.Lazy (ByteString, fromChunks) import Data.Vector ((!?)) import Data.Scientific (floatingOrInteger) -- | A 'Template' is essentially a function that takes -- a JSON 'Value' and produces 'Text'. newtype Template = Template { unTemplate :: Value -> Text } deriving Monoid type Variable = [Text] class TemplateTarget a where toTarget :: Text -> a instance TemplateTarget Text where toTarget = id instance TemplateTarget String where toTarget = T.unpack instance TemplateTarget ByteString where toTarget = fromChunks . (:[]) . encodeUtf8 instance TemplateTarget Html where toTarget = preEscapedText -- | A convenience function for passing in an association -- list of string values instead of a JSON 'Value'. varListToJSON :: [(String, String)] -> Value varListToJSON assoc = toJSON $ M.fromList assoc' where assoc' = [(T.pack k, toVal [T.pack z | (y,z) <- assoc, not (null z), y == k]) | k <- ordNub $ map fst assoc ] toVal [x] = toJSON x toVal [] = Null toVal xs = toJSON xs -- An efficient specialization of nub. ordNub :: (Ord a) => [a] -> [a] ordNub l = go Set.empty l where go _ [] = [] go s (x:xs) = if x `Set.member` s then go s xs else x : go (Set.insert x s) xs -- | Compile a template. compileTemplate :: Text -> Either String Template compileTemplate template = case P.parse (pTemplate <* P.eof) "template" template of Left e -> Left (show e) Right x -> Right x -- | Render a compiled template using @context@ to resolve variables. renderTemplate :: (ToJSON a, TemplateTarget b) => Template -> a -> b renderTemplate (Template f) context = toTarget $ f $ toJSON context -- | Combines `renderTemplate` and `compileTemplate`. applyTemplate :: (ToJSON a, TemplateTarget b) => Text -> a -> Either String b applyTemplate t context = case compileTemplate t of Left e -> Left e Right f -> Right $ renderTemplate f context var :: Variable -> Template var = Template . resolveVar resolveVar :: Variable -> Value -> Text resolveVar var' val = case multiLookup var' val of Just (Array vec) -> maybe mempty (resolveVar []) $ vec !? 0 Just (String t) -> T.stripEnd t Just (Number n) -> case floatingOrInteger n of Left (r :: Double) -> T.pack $ show r Right (i :: Integer) -> T.pack $ show i Just (Bool True) -> "true" Just (Object _) -> "true" Just _ -> mempty Nothing -> mempty multiLookup :: [Text] -> Value -> Maybe Value multiLookup [] x = Just x multiLookup (v:vs) (Object o) = H.lookup v o >>= multiLookup vs multiLookup _ _ = Nothing lit :: Text -> Template lit = Template . const cond :: Variable -> Template -> Template -> Template cond var' (Template ifyes) (Template ifno) = Template $ \val -> case resolveVar var' val of "" -> ifno val _ -> ifyes val iter :: Variable -> Template -> Template -> Template iter var' template sep = Template $ \val -> unTemplate (case multiLookup var' val of Just (Array vec) -> mconcat $ intersperse sep $ map (setVar template var') $ toList vec Just x -> cond var' (setVar template var' x) mempty Nothing -> mempty) val setVar :: Template -> Variable -> Value -> Template setVar (Template f) var' val = Template $ f . replaceVar var' val replaceVar :: Variable -> Value -> Value -> Value replaceVar [] new _ = new replaceVar (v:vs) new (Object o) = Object $ H.adjust (\x -> replaceVar vs new x) v o replaceVar _ _ old = old --- parsing pTemplate :: Parser Template pTemplate = do sp <- P.option mempty pInitialSpace rest <- mconcat <$> many (pConditional <|> pFor <|> pNewline <|> pVar <|> pLit <|> pEscapedDollar) return $ sp <> rest takeWhile1 :: (Char -> Bool) -> Parser Text takeWhile1 f = T.pack <$> P.many1 (P.satisfy f) pLit :: Parser Template pLit = lit <$> takeWhile1 (\x -> x /='$' && x /= '\n') pNewline :: Parser Template pNewline = do P.char '\n' sp <- P.option mempty pInitialSpace return $ lit "\n" <> sp pInitialSpace :: Parser Template pInitialSpace = do sps <- takeWhile1 (==' ') let indentVar = if T.null sps then id else indent (T.length sps) v <- P.option mempty $ indentVar <$> pVar return $ lit sps <> v pEscapedDollar :: Parser Template pEscapedDollar = lit "$" <$ P.try (P.string "$$") pVar :: Parser Template pVar = var <$> (P.try $ P.char '$' *> pIdent <* P.char '$') pIdent :: Parser [Text] pIdent = do first <- pIdentPart rest <- many (P.char '.' *> pIdentPart) return (first:rest) pIdentPart :: Parser Text pIdentPart = P.try $ do first <- P.letter rest <- T.pack <$> P.many (P.satisfy (\c -> isAlphaNum c || c == '_' || c == '-')) let id' = T.singleton first <> rest guard $ id' `notElem` reservedWords return id' reservedWords :: [Text] reservedWords = ["else","endif","for","endfor","sep"] skipEndline :: Parser () skipEndline = P.try $ P.skipMany (P.satisfy (`elem` (" \t" :: String))) >> P.char '\n' >> return () pConditional :: Parser Template pConditional = do P.try $ P.string "$if(" id' <- pIdent P.string ")$" -- if newline after the "if", then a newline after "endif" will be swallowed multiline <- P.option False (True <$ skipEndline) ifContents <- pTemplate elseContents <- P.option mempty $ P.try $ do P.string "$else$" when multiline $ P.option () skipEndline pTemplate P.string "$endif$" when multiline $ P.option () skipEndline return $ cond id' ifContents elseContents pFor :: Parser Template pFor = do P.try $ P.string "$for(" id' <- pIdent P.string ")$" -- if newline after the "for", then a newline after "endfor" will be swallowed multiline <- P.option False $ skipEndline >> return True contents <- pTemplate sep <- P.option mempty $ do P.try $ P.string "$sep$" when multiline $ P.option () skipEndline pTemplate P.string "$endfor$" when multiline $ P.option () skipEndline return $ iter id' contents sep indent :: Int -> Template -> Template indent 0 x = x indent ind (Template f) = Template $ \val -> indent' (f val) where indent' t = T.concat $ intersperse ("\n" <> T.replicate ind " ") $ T.lines t doctemplates-0.1.0.2/test/Spec.hs0000644000000000000000000000304312774017270014736 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} import Text.DocTemplates import Test.Hspec import Data.Text import Data.Aeson data Employee = Employee { firstName :: String , lastName :: String , salary :: Maybe Integer } instance ToJSON Employee where toJSON e = object [ "name" .= object [ "first" .= firstName e , "last" .= lastName e ] , "salary" .= salary e ] employees :: [Employee] employees = [ Employee "John" "Doe" Nothing , Employee "Omar" "Smith" (Just 30000) , Employee "Sara" "Chen" (Just 60000) ] template :: Text template = "$for(employee)$Hi, $employee.name.first$. $if(employee.salary)$You make $$$employee.salary$.$else$No salary data.$endif$$sep$\n$endfor$" main :: IO () main = hspec $ do describe "applyTemplate" $ do it "works" $ do applyTemplate template (object ["employee" .= employees]) `shouldBe` (Right "Hi, John. No salary data.\nHi, Omar. You make $30000.\nHi, Sara. You make $60000." :: Either String Text) it "renders numbers appropriately as integer or floating" $ do applyTemplate "$m$ and $n$" (object ["m" .= (5 :: Integer), "n" .= (7.3 :: Double)]) `shouldBe` (Right "5 and 7.3" :: Either String Text) it "fails with an incorrect template" $ do applyTemplate "$if(x$and$endif$" (object []) `shouldBe` (Left "\"template\" (line 1, column 6):\nunexpected \"$\"\nexpecting \".\" or \")$\"" :: Either String Text) doctemplates-0.1.0.2/README.md0000644000000000000000000000446312773740777014035 0ustar0000000000000000# doctemplates This is the templating system used by pandoc. It was formerly be a module in pandoc. It has been split off to make it easier to use independently. Example: ``` haskell {-# LANGUAGE OverloadedStrings #-} import Data.Text import Data.Aeson import Text.DocTemplates data Employee = Employee { firstName :: String , lastName :: String , salary :: Maybe Int } instance ToJSON Employee where toJSON e = object [ "name" .= object [ "first" .= firstName e , "last" .= lastName e ] , "salary" .= salary e ] template :: Text template = "$for(employee)$Hi, $employee.name.first$. $if(employee.salary)$You make $employee.salary$.$else$No salary data.$endif$$sep$\n$endfor$" main = case compileTemplate template of Left e -> error e Right t -> putStrLn $ renderTemplate t $ object ["employee" .= [ Employee "John" "Doe" Nothing , Employee "Omar" "Smith" (Just 30000) , Employee "Sara" "Chen" (Just 60000) ] ] ``` A slot for an interpolated variable is a variable name surrounded by dollar signs. To include a literal `$` in your template, use `$$`. Variable names must begin with a letter and can contain letters, numbers, `_`, `-`, and `.`. The values of variables are determined by a JSON object that is passed as a parameter to `renderTemplate`. So, for example, `title` will return the value of the `title` field, and `employee.salary` will return the value of the `salary` field of the object that is the value of the `employee` field. The value of a variable will be indented to the same level as the variable. A conditional begins with `$if(variable_name)$` and ends with `$endif$`. It may optionally contain an `$else$` section. The if section is used if `variable_name` has a non-null value, otherwise the else section is used. Conditional keywords should not be indented, or unexpected spacing problems may occur. The `$for$` keyword can be used to iterate over an array. If the value of the associated variable is not an array, a single iteration will be performed on its value. You may optionally specify separators using `$sep$`, as in the example above. doctemplates-0.1.0.2/LICENSE0000644000000000000000000000277012773674622013555 0ustar0000000000000000Copyright John MacFarlane (c) 2016 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 Author name here 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. doctemplates-0.1.0.2/Setup.hs0000644000000000000000000000005612773674254014200 0ustar0000000000000000import Distribution.Simple main = defaultMain doctemplates-0.1.0.2/doctemplates.cabal0000644000000000000000000000301412774160502016174 0ustar0000000000000000name: doctemplates version: 0.1.0.2 synopsis: Pandoc-style document templates description: Please see README.md homepage: https://github.com/jgm/doctemplates#readme license: BSD3 license-file: LICENSE author: John MacFarlane maintainer: jgm@berkeley.edu copyright: 2016 John MacFarlane category: Text build-type: Simple -- extra-source-files: data-files: README.md cabal-version: >=1.10 library hs-source-dirs: src exposed-modules: Text.DocTemplates build-depends: base >= 4.7 && < 5, aeson, bytestring, blaze-markup, blaze-html, text, containers, vector, parsec, unordered-containers, scientific default-language: Haskell2010 ghc-options: -Wall -fno-warn-unused-do-bind test-suite doctemplates-test type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs build-depends: base, doctemplates, aeson, hspec, text ghc-options: -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010 source-repository head type: git location: https://github.com/jgm/doctemplates