template 0.2.0.4 → 0.2.0.5
raw patch · 2 files changed
+114/−47 lines, 2 filesdep ~base
Dependency ranges changed: base
Files
- Data/Text/Template.hs +112/−45
- template.cabal +2/−2
Data/Text/Template.hs view
@@ -34,6 +34,7 @@ -- * Basic interface template,+ templateSafe, render, substitute, showTemplate,@@ -47,10 +48,11 @@ ) where import Control.Applicative (Applicative(pure), (<$>))-import Control.Monad (liftM, liftM2)+import Control.Monad (liftM, liftM2, replicateM_) import Control.Monad.State.Strict (State, evalState, get, put)-import Data.Char (isAlphaNum)+import Data.Char (isAlphaNum, isLower) import Data.Function (on)+import Data.Maybe (fromJust, isJust) import Data.Traversable (traverse) import Prelude hiding (takeWhile) @@ -69,7 +71,7 @@ instance Show Template where show = T.unpack . showTemplate --- | Shows the template string.+-- | Show the template string. showTemplate :: Template -> T.Text showTemplate (Template fs) = T.concat $ map showFrag fs @@ -96,10 +98,21 @@ -- ----------------------------------------------------------------------------- -- Basic interface --- | Creates a template from a template string.+-- | Create a template from a template string. A malformed template+-- string will raise an 'error'. template :: T.Text -> Template-template = Template . combineLits . runParser pFrags+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 =@@ -122,7 +135,7 @@ fromLit (Lit v) = v fromLit _ = undefined --- | Performs the template substitution, returning a new 'LT.Text'.+-- | Perform the template substitution, returning a new 'LT.Text'. render :: Template -> Context -> LT.Text render (Template frags) ctxFunc = LT.fromChunks $ map renderFrag frags where@@ -135,11 +148,11 @@ -- -- 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@:+-- and a 'Template' @tmpl@: -- -- > renderA tmpl (flip lookup ctx) ----- will return @Nothing@ if any of the placeholders in the template+-- 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@@ -147,14 +160,14 @@ renderFrag (Lit s) = pure s renderFrag (Var x _) = ctxFunc x --- | Performs the template substitution, returning a new--- 'LT.Text'. Note that+-- | 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 --- | Performs the template substitution in the given @Applicative@,+-- | Perform the template substitution in the given 'Applicative', -- returning a new 'LT.Text'. Note that -- -- > substituteA tmpl ctx == renderA (template tmpl) ctx@@ -168,52 +181,103 @@ 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 $ T.pack "$")- _ -> continue pVar- _ -> continue pLit+ 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 -pLit :: Parser Frag-pLit = do- s <- takeWhile (/= '$')- return $ Lit s+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- Just '$' <- char+ discard 1 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+ 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 -pIdentifier :: Parser T.Text-pIdentifier = do+pVarSafe :: Parser (Either (Int, Int) Frag)+pVarSafe = do+ discard 1 c <- peek case c of- Just c'- | isAlphaNum c' -> takeWhile isIdentifier- | otherwise -> liftM parseError pos- Nothing -> liftM parseError pos- where- isIdentifier c = or [isAlphaNum c, c `elem` "_'"]+ 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 (row, col) = error $ "Invalid placeholder in string: line " ++- show row ++ ", col " ++ show col+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 @@ -253,7 +317,7 @@ takeWhile :: (Char -> Bool) -> Parser T.Text takeWhile p = do S s row col <- get-#if MIN_VERSION_text(0,10,0)+#if MIN_VERSION_text(0,11,0) case T.span p s of #else case T.spanBy p s of@@ -271,13 +335,16 @@ 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 1+runParser p s = evalState p $ S s 1 0 -- ----------------------------------------------------------------------------- -- Example
template.cabal view
@@ -1,5 +1,5 @@ name: template-version: 0.2.0.4+version: 0.2.0.5 description: Simple string substitution library that supports \"$\"-based substitution. Meant to be used when Text.Printf or string@@ -19,7 +19,7 @@ exposed-modules: Data.Text.Template build-depends:- base >= 3.0 && < 4.4,+ base >= 3.0 && < 4.5, mtl >= 1.1 && < 2.0.2, text >= 0.7.2 && < 0.12