template 0.1.1.1 → 0.2.0.10
raw patch · 7 files changed
Files
- Data/Text/Template.hs +397/−0
- LICENSE +1/−1
- Setup.lhs +0/−0
- Text/Template.hs +0/−263
- examples/Hello.hs +18/−0
- examples/OverloadedHello.hs +20/−0
- template.cabal +28/−24
+ Data/Text/Template.hs view
@@ -0,0 +1,397 @@+{-# LANGUAGE CPP #-}++-- | A simple string substitution library that supports \"$\"-based+-- substitution. Substitution uses the following rules:+--+-- * \"$$\" is an escape; it is replaced with a single \"$\".+--+-- * \"$identifier\" names a substitution placeholder matching a+-- mapping key of \"identifier\". \"identifier\" must spell a+-- Haskell identifier. The first non-identifier character after the+-- \"$\" character terminates this placeholder specification.+--+-- * \"${identifier}\" is equivalent to \"$identifier\". It is+-- required when valid identifier characters follow the placeholder+-- but are not part of the placeholder, such as+-- \"${noun}ification\".+--+-- Any other appearance of \"$\" in the string will result in an+-- 'Prelude.error' being raised.+--+-- If you render the same template multiple times it's faster to first+-- convert it to a more efficient representation using 'template' and+-- then render it using 'render'. In fact, all that 'substitute' does+-- is to combine these two steps.++module Data.Text.Template+ (+ -- * The @Template@ type+ Template,++ -- * The @Context@ type+ Context,+ ContextA,++ -- * Basic interface+ template,+ templateSafe,+ render,+ substitute,+ showTemplate,++ -- * Applicative interface+ renderA,+ substituteA,++ -- * Example+ -- $example+ ) where++import Control.Applicative (Applicative(pure), (<$>))+import Control.Monad (liftM, liftM2, replicateM_)+import Control.Monad.State.Strict (State, evalState, get, put)+import Data.Char (isAlphaNum, isLower)+import Data.Function (on)+import Data.Maybe (fromJust, isJust)+import Data.Traversable (traverse)+import Prelude hiding (takeWhile)++import qualified Data.Text as T+import qualified Data.Text.Lazy as LT++-- -----------------------------------------------------------------------------++-- | A representation of a 'Data.Text' template, supporting efficient+-- rendering.+newtype Template = Template [Frag]++instance Eq Template where+ (==) = (==) `on` showTemplate++instance Show Template where+ show = T.unpack . showTemplate++-- | Show the template string.+showTemplate :: Template -> T.Text+showTemplate (Template fs) = T.concat $ map showFrag fs++-- | A template fragment.+data Frag = Lit {-# UNPACK #-} !T.Text | Var {-# UNPACK #-} !T.Text !Bool++instance Show Frag where+ show = T.unpack . showFrag++showFrag :: Frag -> T.Text+showFrag (Var s b)+ | b = T.concat [T.pack "${", s, T.pack "}"]+ | otherwise = T.concat [T.pack "$", s]+showFrag (Lit s) = T.concatMap escape s+ where escape '$' = T.pack "$$"+ escape c = T.singleton c++-- | A mapping from placeholders in the template to values.+type Context = T.Text -> T.Text++-- | Like 'Context', but with an applicative lookup function.+type ContextA f = T.Text -> f T.Text++-- -----------------------------------------------------------------------------+-- Basic interface++-- | Create a template from a template string. A malformed template+-- string will raise an 'error'.+template :: T.Text -> Template+template = templateFromFrags . runParser pFrags++-- | Create a template from a template string. A malformed template+-- string will cause 'templateSafe' to return @Left (row, col)@, where+-- @row@ starts at 1 and @col@ at 0.+templateSafe :: T.Text -> Either (Int, Int) Template+templateSafe =+ either Left (Right . templateFromFrags) . runParser pFragsSafe++templateFromFrags :: [Frag] -> Template+templateFromFrags = Template . combineLits++combineLits :: [Frag] -> [Frag]+combineLits [] = []+combineLits xs =+ let (lits,xs') = span isLit xs+ in case lits of+ [] -> gatherVars xs'+ [lit] -> lit : gatherVars xs'+ _ -> Lit (T.concat (map fromLit lits)) : gatherVars xs'+ where+ gatherVars [] = []+ gatherVars ys =+ let (vars,ys') = span isVar ys+ in vars ++ combineLits ys'++ isLit (Lit _) = True+ isLit _ = False++ isVar = not . isLit++ fromLit (Lit v) = v+ fromLit _ = undefined++-- | Perform the template substitution, returning a new 'LT.Text'.+render :: Template -> Context -> LT.Text+render (Template frags) ctxFunc = LT.fromChunks $ map renderFrag frags+ where+ renderFrag (Lit s) = s+ renderFrag (Var x _) = ctxFunc x++-- | Like 'render', but allows the lookup to have side effects. The+-- lookups are performed in order that they are needed to generate the+-- resulting text.+--+-- You can use this e.g. to report errors when a lookup cannot be made+-- successfully. For example, given a list @ctx@ of key-value pairs+-- and a 'Template' @tmpl@:+--+-- > renderA tmpl (flip lookup ctx)+--+-- will return 'Nothing' if any of the placeholders in the template+-- don't appear in @ctx@ and @Just text@ otherwise.+renderA :: Applicative f => Template -> ContextA f -> f LT.Text+renderA (Template frags) ctxFunc = LT.fromChunks <$> traverse renderFrag frags+ where+ renderFrag (Lit s) = pure s+ renderFrag (Var x _) = ctxFunc x++-- | Perform the template substitution, returning a new 'LT.Text'. A+-- malformed template string will raise an 'error'. Note that+--+-- > substitute tmpl ctx == render (template tmpl) ctx+substitute :: T.Text -> Context -> LT.Text+substitute = render . template++-- | Perform the template substitution in the given 'Applicative',+-- returning a new 'LT.Text'. Note that+--+-- > substituteA tmpl ctx == renderA (template tmpl) ctx+substituteA :: Applicative f => T.Text -> ContextA f -> f LT.Text+substituteA = renderA . template++-- -----------------------------------------------------------------------------+-- Template parser++pFrags :: Parser [Frag]+pFrags = do+ c <- peek+ case c of+ Nothing -> return []+ Just '$' -> do c' <- peekSnd+ case c' of+ Just '$' -> do discard 2+ continue (return $ Lit $ T.pack "$")+ _ -> continue pVar+ _ -> continue pLit+ where+ continue x = liftM2 (:) x pFrags++pFragsSafe :: Parser (Either (Int, Int) [Frag])+pFragsSafe = pFragsSafe' []+ where+ pFragsSafe' frags = do+ c <- peek+ case c of+ Nothing -> return . Right . reverse $ frags+ Just '$' -> do c' <- peekSnd+ case c' of+ Just '$' -> do discard 2+ continue (Lit $ T.pack "$")+ _ -> do e <- pVarSafe+ either abort continue e+ _ -> do l <- pLit+ continue l+ where+ continue x = pFragsSafe' (x : frags)+ abort = return . Left++pVar :: Parser Frag+pVar = do+ discard 1+ c <- peek+ case c of+ Just '{' -> do discard 1+ v <- pIdentifier+ c' <- peek+ case c' of+ Just '}' -> do discard 1+ return $ Var v True+ _ -> liftM parseError pos+ _ -> do v <- pIdentifier+ return $ Var v False++pVarSafe :: Parser (Either (Int, Int) Frag)+pVarSafe = do+ discard 1+ c <- peek+ case c of+ Just '{' -> do discard 1+ e <- pIdentifierSafe+ case e of+ Right v -> do c' <- peek+ case c' of+ Just '}' -> do discard 1+ return $ Right (Var v True)+ _ -> liftM parseErrorSafe pos+ Left m -> return $ Left m+ _ -> do e <- pIdentifierSafe+ return $ either Left (\v -> Right $ Var v False) e++pIdentifier :: Parser T.Text+pIdentifier = do+ m <- peek+ if isJust m && isIdentifier0 (fromJust m)+ then takeWhile isIdentifier1+ else liftM parseError pos++pIdentifierSafe :: Parser (Either (Int, Int) T.Text)+pIdentifierSafe = do+ m <- peek+ if isJust m && isIdentifier0 (fromJust m)+ then liftM Right (takeWhile isIdentifier1)+ else liftM parseErrorSafe pos++pLit :: Parser Frag+pLit = do+ s <- takeWhile (/= '$')+ return $ Lit s++isIdentifier0 :: Char -> Bool+isIdentifier0 c = or [isLower c, c == '_']++isIdentifier1 :: Char -> Bool+isIdentifier1 c = or [isAlphaNum c, c `elem` "_'"]++parseError :: (Int, Int) -> a+parseError = error . makeParseErrorMessage++parseErrorSafe :: (Int, Int) -> Either (Int, Int) a+parseErrorSafe = Left++makeParseErrorMessage :: (Int, Int) -> String+makeParseErrorMessage (row, col) =+ "Invalid placeholder at " +++ "row " ++ show row ++ ", col " ++ show col++-- -----------------------------------------------------------------------------+-- Text parser++-- | The parser state.+data S = S {-# UNPACK #-} !T.Text -- Remaining input+ {-# UNPACK #-} !Int -- Row+ {-# UNPACK #-} !Int -- Col++type Parser = State S++char :: Parser (Maybe Char)+char = do+ S s row col <- get+ if T.null s+ then return Nothing+ else do c <- return $! T.head s+ case c of+ '\n' -> put $! S (T.tail s) (row + 1) 1+ _ -> put $! S (T.tail s) row (col + 1)+ return $ Just c++peek :: Parser (Maybe Char)+peek = do+ s <- get+ c <- char+ put s+ return c++peekSnd :: Parser (Maybe Char)+peekSnd = do+ s <- get+ _ <- char+ c <- char+ put s+ return c++takeWhile :: (Char -> Bool) -> Parser T.Text+takeWhile p = do+ S s row col <- get+#if MIN_VERSION_text(0,11,0)+ case T.span p s of+#else+ case T.spanBy p s of+#endif+ (x, s') -> do+ let xlines = T.lines x+ row' = row + fromIntegral (length xlines - 1)+ col' = case xlines of+ [] -> col -- Empty selection+ [sameLine] -> T.length sameLine+ -- Taken from this line+ _ -> T.length (last xlines)+ -- Selection extends+ -- to next line at least+ put $! S s' row' col'+ return x++discard :: Int -> Parser ()+discard n = replicateM_ n char++pos :: Parser (Int, Int)+pos = do+ S _ row col <- get+ return (row, col)++runParser :: Parser a -> T.Text -> a+runParser p s = evalState p $ S s 1 0++-- -----------------------------------------------------------------------------+-- Example++-- $example+--+-- Here is an example of a simple substitution:+--+-- > module Main where+-- >+-- > import qualified Data.ByteString.Lazy as S+-- > import qualified Data.Text as T+-- > import qualified Data.Text.Lazy.Encoding as E+-- >+-- > import Data.Text.Template+-- >+-- > -- | Create 'Context' from association list.+-- > context :: [(T.Text, T.Text)] -> Context+-- > context assocs x = maybe err id . lookup x $ assocs+-- > where err = error $ "Could not find key: " ++ T.unpack x+-- >+-- > main :: IO ()+-- > main = S.putStr $ E.encodeUtf8 $ substitute helloTemplate helloContext+-- > where+-- > helloTemplate = T.pack "Hello, $name!\n"+-- > helloContext = context [(T.pack "name", T.pack "Joe")]+--+-- The example can be simplified slightly by using the+-- @OverloadedStrings@ language extension:+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- >+-- > module Main where+-- >+-- > import qualified Data.ByteString.Lazy as S+-- > import qualified Data.Text as T+-- > import qualified Data.Text.Lazy.Encoding as E+-- >+-- > import Data.Text.Template+-- >+-- > -- | Create 'Context' from association list.+-- > context :: [(T.Text, T.Text)] -> Context+-- > context assocs x = maybe err id . lookup x $ assocs+-- > where err = error $ "Could not find key: " ++ T.unpack x+-- >+-- > main :: IO ()+-- > main = S.putStr $ E.encodeUtf8 $ substitute helloTemplate helloContext+-- > where+-- > helloTemplate = "Hello, $name!\n"+-- > helloContext = context [("name", "Joe")]
LICENSE view
@@ -1,4 +1,4 @@-Copyright Johan Tibell 2007+Copyright (c) 2007-2010, Johan Tibell All rights reserved.
Setup.lhs view
− Text/Template.hs
@@ -1,263 +0,0 @@--- | A simple string substitution library that supports \"$\"-based--- substitution. Substitution uses the following rules:------ * \"$$\" is an escape; it is replaced with a single \"$\".------ * \"$identifier\" names a substitution placeholder matching a--- mapping key of \"identifier\". \"identifier\" must spell a--- Haskell identifier. The first non-identifier character after the--- \"$\" character terminates this placeholder specification.------ * \"${identifier}\" is equivalent to \"$identifier\". It is--- required when valid identifier characters follow the placeholder--- but are not part of the placeholder, such as--- \"${noun}ification\".------ Any other apperance of \"$\" in the string will result in an--- 'Prelude.error' being raised.------ Here is an example of a simple substitution:------ > import qualified Data.ByteString.Lazy.Char8 as B--- > import Text.Template--- >--- > context = Map.fromList . map packPair--- > where packPair (x, y) = (B.pack x, B.pack y)--- >--- > helloTemplate = B.pack "Hello, $name! Want some ${fruit}s?"--- > helloContext = context [("name", "Johan"), ("fruit", "banana")]--- >--- > main = B.putStrLn $ substitute helloTemplate helloContext------ If you render the same template multiple times it's faster to first--- convert it to a more efficient representation using 'template' and--- then rendering it using 'render'. In fact, all that 'substitute' does--- is to combine these two steps.--module Text.Template- (- -- * The @Template@ type.- Template, -- abstract-- -- * The @Context@ type.- Context,- - -- * Basic interface- template, -- :: ByteString -> Template- render, -- :: Template -> Context -> ByteString- substitute, -- :: ByteString -> Context -> ByteString- showTemplate, -- :: Template -> ByteString-- -- * I\/O with 'Template's-- -- ** Files- readTemplate, -- :: FilePath -> IO Template- renderToFile, -- :: FilePath -> Template -> Context -> IO ()-- -- ** I\/O with Handles- hRender -- :: Handle -> Template -> Context -> IO ()- ) where--import Data.ByteString.Lazy.Char8 (ByteString)-import qualified Data.ByteString.Lazy.Char8 as B-import Data.Int-import Control.Monad.State-import qualified Control.Monad.State as State-import Data.Char-import Data.Map (Map)-import qualified Data.Map as Map-import Prelude hiding (takeWhile)-import System.IO---- --------------------------------------------------------------------------------- | A repesentation of a 'Data.ByteString.Lazy.Char8.ByteString'--- template, supporting efficient rendering.-newtype Template = Template [Frag]--instance Eq Template where- t1 == t2 = showTemplate t1 == showTemplate t2--instance Show Template where- show = B.unpack . showTemplate---- | Shows the template string.-showTemplate :: Template -> ByteString-showTemplate (Template fs) = B.concat $ map showFrag fs--data Frag = Lit !ByteString | Var !ByteString !Bool--instance Show Frag where- show = B.unpack . showFrag--showFrag :: Frag -> ByteString-showFrag (Var s b) | b = B.concat [B.pack "${", s, B.pack "}"]- | otherwise = B.concat [B.pack "$", s]-showFrag (Lit s) = B.concatMap escape s- where escape c = case c of- '$' -> B.pack "$$"- c' -> B.singleton c'---- | A mapping with keys that match the placeholders in the template.-type Context = Map ByteString ByteString---- -------------------------------------------------------------------------------- Basic interface---- | Creates a template from a template string.-template :: ByteString -> Template-template = runParser pTemplate--pTemplate :: Parser Template-pTemplate = pFrags >>= return . Template--pFrags :: Parser [Frag]-pFrags = do- c <- peek- case c of- Nothing -> return []- Just '$' -> do c' <- peekSnd- case c' of- Just '$' -> do Just '$' <- char- Just '$' <- char- continue (return $ Lit $ B.pack "$")- _ -> continue pVar- _ -> continue pLit- where- continue x = liftM2 (:) x pFrags--pLit :: Parser Frag-pLit = do- s <- takeWhile (/= '$')- return $ Lit s--pVar :: Parser Frag-pVar = do- Just '$' <- char- c <- peek- case c of- Just '{' -> do Just '{' <- char- v <- pIdentifier- c' <- peek- case c' of- Just '}' -> do Just '}' <- char- return $ Var v True- _ -> liftM parseError pos- _ -> do v <- pIdentifier- return $ Var v False--pIdentifier :: Parser ByteString-pIdentifier = do- c <- peek- case c of- Just c' -> if isAlphaNum c'- then takeWhile isIdentifier- else liftM parseError pos- Nothing -> liftM parseError pos- where- isIdentifier c = or [isAlphaNum c, c `elem` "_'"]--parseError :: (Int64, Int64) -> a-parseError (row, col) = error $ "Invalid placeholder in string: line " ++- show row ++ ", col " ++ show col---- | Performs the template substitution, returning a new--- 'Data.ByteString.Lazy.Char8.ByteString'.------ If a key is not found in the context an 'Prelude.error' is raised.-render :: Template -> Context -> ByteString-render (Template frags) ctx = B.concat $ map (renderFrag ctx) frags--renderFrag :: Context -> Frag -> ByteString-renderFrag _ (Lit s) = s-renderFrag ctx (Var x _) =- case Map.lookup x ctx of- Just s -> s- Nothing -> error $ "Key not found: " ++ (show $ B.unpack x)---- | Performs the template substitution, returning a new--- 'Data.ByteString.Lazy.Char8.ByteString'. Note that------ > substitute tmpl ctx == render (template tmpl) ctx------ If a key is not found in the context an 'Prelude.error' is raised.-substitute :: ByteString -> Context -> ByteString-substitute tmpl = render (template tmpl)---- -------------------------------------------------------------------------------- Files---- | Reads a template from a file lazily. Use 'text mode' on Windows to--- interpret newlines-readTemplate :: FilePath -> IO Template-readTemplate f = (return . template) =<< B.readFile f---- | Renders and writes a template to a file. This is more efficient--- than first 'render'ing the template to a--- 'Data.ByteString.Lazy.Char8.ByteString' and then writing it to a file--- using 'Data.ByteString.Lazy.Char8.writeFile'.-renderToFile :: FilePath -> Template -> Context -> IO ()-renderToFile f tmpl = B.writeFile f . render tmpl---- -------------------------------------------------------------------------------- I/O with Handles---- | Renders and writes a template to a 'System.IO.Handle'. This is more--- efficient than first 'render'ing the template to a--- 'Data.ByteString.Lazy.Char8.ByteString' and then writing it to a--- 'System.IO.Handle' using 'Data.ByteString.Lazy.Char8.hPutStr'.-hRender :: Handle -> Template -> Context -> IO ()-hRender h (Template frags) ctx = mapM_ (B.hPut h . renderFrag ctx) frags---- -------------------------------------------------------------------------------- ByteString parser--type Parser = State (ByteString, Int64, Int64)- -char :: Parser (Maybe Char)-char = do- (s, row, col) <- get- if B.null s- then return Nothing- else do c <- return $! B.head s- case c of- '\n' -> put (B.tail s, row + 1 :: Int64, 1 :: Int64)- _ -> put (B.tail s, row, col + 1 :: Int64)- return $ Just c--peek :: Parser (Maybe Char)-peek = do- s <- get- c <- char- put s- return c--peekSnd :: Parser (Maybe Char)-peekSnd = do- s <- get- char- c <- char- put s- return c--takeWhile :: (Char -> Bool) -> Parser ByteString-takeWhile p = do- (s, row, col) <- get- case B.span p s of- (x, s') -> do - let newlines = B.elemIndices '\n' x- n = B.length x- row' = row + fromIntegral (length newlines)- col' = case newlines of- [] -> col + n- _ -> n - last newlines- put (s', row', col')- return x--pos :: Parser (Int64, Int64)-pos = do- (_, row, col) <- get- return (row, col)--runParser :: Parser a -> ByteString -> a-runParser p s = evalState p (s, 1 :: Int64, 1 :: Int64)
+ examples/Hello.hs view
@@ -0,0 +1,18 @@+module Main where++import qualified Data.ByteString.Lazy as S+import qualified Data.Text as T+import qualified Data.Text.Lazy.Encoding as E++import Data.Text.Template++-- | Create 'Context' from association list.+context :: [(T.Text, T.Text)] -> Context+context assocs x = maybe err id . lookup x $ assocs+ where err = error $ "Could not find key: " ++ T.unpack x++main :: IO ()+main = S.putStr $ E.encodeUtf8 $ substitute helloTemplate helloContext+ where+ helloTemplate = T.pack "Hello, $name!\n"+ helloContext = context [(T.pack "name", T.pack "Joe")]
+ examples/OverloadedHello.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import qualified Data.ByteString.Lazy as S+import qualified Data.Text as T+import qualified Data.Text.Lazy.Encoding as E++import Data.Text.Template++-- | Create 'Context' from association list.+context :: [(T.Text, T.Text)] -> Context+context assocs x = maybe err id . lookup x $ assocs+ where err = error $ "Could not find key: " ++ T.unpack x++main :: IO ()+main = S.putStr $ E.encodeUtf8 $ substitute helloTemplate helloContext+ where+ helloTemplate = "Hello, $name!\n"+ helloContext = context [("name", "Joe")]
template.cabal view
@@ -1,29 +1,33 @@-name: template-version: 0.1.1.1-description: Simple string substitution library that supports- \"$\"-based substitution. Meant to be used when- Text.Printf or string concatenation would lead to- code that is hard to read but when a full blown- templating system might be overkill.-synopsis: Simple string substitution-category: Text-license: BSD3-license-file: LICENSE-author: Johan Tibell-maintainer: johan.tibell@gmail.com+name: template+version: 0.2.0.10+description:+ Simple string substitution library that supports \"$\"-based+ substitution. Meant to be used when Text.Printf or string+ concatenation would lead to code that is hard to read but when a+ full blown templating system is overkill.+synopsis: Simple string substitution+category: Text+license: BSD3+license-file: LICENSE+author: Johan Tibell <johan.tibell@gmail.com>+maintainer: Johan Tibell <johan.tibell@gmail.com> build-type: Simple-cabal-version: >= 1.2--flag split-base- description: Chooce the new smaller, split-up base package.+cabal-version: >= 1.6+extra-source-files: examples/*.hs library- exposed-modules: Text.Template+ exposed-modules: Data.Text.Template - if flag(split-base)- build-depends: base >= 3, bytestring, containers- else- build-depends: base < 3- build-depends: mtl+ build-depends:+ base >= 3.0 && < 5,+ mtl >= 1.1 && < 2.3,+ text >= 0.7.2 && < 1.3 - ghc-options: -funbox-strict-fields -Wall+ extensions: CPP+ ghc-options: -funbox-strict-fields -Wall+ if impl(ghc >= 6.8)+ ghc-options: -fwarn-tabs++source-repository head+ type: git+ location: https://github.com/tibbe/template