module Text.Template
(
Template,
Context,
template,
render,
substitute,
showTemplate,
readTemplate,
renderToFile,
hRender
) 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
newtype Template = Template [Frag]
instance Eq Template where
t1 == t2 = showTemplate t1 == showTemplate t2
instance Show Template where
show = B.unpack . showTemplate
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'
type Context = Map ByteString ByteString
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
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)
substitute :: ByteString -> Context -> ByteString
substitute tmpl = render (template tmpl)
readTemplate :: FilePath -> IO Template
readTemplate f = (return . template) =<< B.readFile f
renderToFile :: FilePath -> Template -> Context -> IO ()
renderToFile f tmpl = B.writeFile f . render tmpl
hRender :: Handle -> Template -> Context -> IO ()
hRender h (Template frags) ctx = mapM_ (B.hPut h . renderFrag ctx) frags
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)