diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,31 @@ +Copyright Johan Tibell 2007 + +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 Johan Tibell 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/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/Text/Template.hs b/Text/Template.hs new file mode 100644 --- /dev/null +++ b/Text/Template.hs @@ -0,0 +1,263 @@ +-- | 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) diff --git a/template.cabal b/template.cabal new file mode 100644 --- /dev/null +++ b/template.cabal @@ -0,0 +1,16 @@ +Name: template +Version: 0.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 +Build-Depends: base, mtl +Exposed-modules: Text.Template +ghc-options: -Wall -O2 -funbox-strict-fields