From 938058aae3514ad93bd1b5f2810b4ef73e743843 Mon Sep 17 00:00:00 2001 From: Packit Date: Sep 25 2020 13:32:18 +0000 Subject: ghc-doctemplates-0.2.1 base --- diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..d269387 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright 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. diff --git a/README.md b/README.md new file mode 100644 index 0000000..5e28a62 --- /dev/null +++ b/README.md @@ -0,0 +1,66 @@ +# 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. + +Anything between the sequence `$--` and the end of the line +will be treated as a comment. diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/doctemplates.cabal b/doctemplates.cabal new file mode 100644 index 0000000..5a639ea --- /dev/null +++ b/doctemplates.cabal @@ -0,0 +1,48 @@ +name: doctemplates +version: 0.2.1 +synopsis: Pandoc-style document templates +description: A simple text templating system used by pandoc. +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 diff --git a/src/Text/DocTemplates.hs b/src/Text/DocTemplates.hs new file mode 100644 index 0000000..83bd459 --- /dev/null +++ b/src/Text/DocTemplates.hs @@ -0,0 +1,316 @@ +{-# 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 <|> + pComment <|> + 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 "$$") + +pComment :: Parser Template +pComment = do + pos <- P.getPosition + P.try (P.string "$--") + P.skipMany (P.satisfy (/='\n')) + -- If the comment begins in the first column, the line ending + -- will be consumed; otherwise not. + when (P.sourceColumn pos == 1) $ () <$ P.char '\n' + return mempty + +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 diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 index 0000000..9605677 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,46 @@ +{-# 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 "handles comments" $ do + applyTemplate "hello $--there and $m$\n$-- comment\nbar" + (object ["m" .= (5 :: Integer)]) + `shouldBe` + (Right "hello \nbar" :: 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) +