{-# 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
    == :: Template -> Template -> Bool
(==) = Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Text -> Text -> Bool)
-> (Template -> Text) -> Template -> Template -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Template -> Text
showTemplate

instance Show Template where
    show :: Template -> String
show = Text -> String
T.unpack (Text -> String) -> (Template -> Text) -> Template -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Template -> Text
showTemplate

-- | Show the template string.
showTemplate :: Template -> T.Text
showTemplate :: Template -> Text
showTemplate (Template [Frag]
fs) = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Frag -> Text) -> [Frag] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Frag -> Text
showFrag [Frag]
fs

-- | A template fragment.
data Frag = Lit {-# UNPACK #-} !T.Text | Var {-# UNPACK #-} !T.Text !Bool

instance Show Frag where
    show :: Frag -> String
show = Text -> String
T.unpack (Text -> String) -> (Frag -> Text) -> Frag -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Frag -> Text
showFrag

showFrag :: Frag -> T.Text
showFrag :: Frag -> Text
showFrag (Var Text
s Bool
b)
    | Bool
b          = [Text] -> Text
T.concat [String -> Text
T.pack String
"${", Text
s, String -> Text
T.pack String
"}"]
    | Bool
otherwise  = [Text] -> Text
T.concat [String -> Text
T.pack String
"$", Text
s]
showFrag (Lit Text
s) = (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
escape Text
s
    where escape :: Char -> Text
escape Char
'$' = String -> Text
T.pack String
"$$"
          escape Char
c   = Char -> Text
T.singleton Char
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 :: Text -> Template
template = [Frag] -> Template
templateFromFrags ([Frag] -> Template) -> (Text -> [Frag]) -> Text -> Template
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser [Frag] -> Text -> [Frag]
forall a. Parser a -> Text -> a
runParser Parser [Frag]
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 :: Text -> Either (Int, Int) Template
templateSafe =
    ((Int, Int) -> Either (Int, Int) Template)
-> ([Frag] -> Either (Int, Int) Template)
-> Either (Int, Int) [Frag]
-> Either (Int, Int) Template
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Int, Int) -> Either (Int, Int) Template
forall a b. a -> Either a b
Left (Template -> Either (Int, Int) Template
forall a b. b -> Either a b
Right (Template -> Either (Int, Int) Template)
-> ([Frag] -> Template) -> [Frag] -> Either (Int, Int) Template
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Frag] -> Template
templateFromFrags) (Either (Int, Int) [Frag] -> Either (Int, Int) Template)
-> (Text -> Either (Int, Int) [Frag])
-> Text
-> Either (Int, Int) Template
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (Either (Int, Int) [Frag])
-> Text -> Either (Int, Int) [Frag]
forall a. Parser a -> Text -> a
runParser Parser (Either (Int, Int) [Frag])
pFragsSafe

templateFromFrags :: [Frag] -> Template
templateFromFrags :: [Frag] -> Template
templateFromFrags = [Frag] -> Template
Template ([Frag] -> Template) -> ([Frag] -> [Frag]) -> [Frag] -> Template
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Frag] -> [Frag]
combineLits

combineLits :: [Frag] -> [Frag]
combineLits :: [Frag] -> [Frag]
combineLits [] = []
combineLits [Frag]
xs =
    let ([Frag]
lits,[Frag]
xs') = (Frag -> Bool) -> [Frag] -> ([Frag], [Frag])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Frag -> Bool
isLit [Frag]
xs
    in case [Frag]
lits of
         []    -> [Frag] -> [Frag]
gatherVars [Frag]
xs'
         [Frag
lit] -> Frag
lit Frag -> [Frag] -> [Frag]
forall a. a -> [a] -> [a]
: [Frag] -> [Frag]
gatherVars [Frag]
xs'
         [Frag]
_     -> Text -> Frag
Lit ([Text] -> Text
T.concat ((Frag -> Text) -> [Frag] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Frag -> Text
fromLit [Frag]
lits)) Frag -> [Frag] -> [Frag]
forall a. a -> [a] -> [a]
: [Frag] -> [Frag]
gatherVars [Frag]
xs'
  where
    gatherVars :: [Frag] -> [Frag]
gatherVars [] = []
    gatherVars [Frag]
ys =
      let ([Frag]
vars,[Frag]
ys') = (Frag -> Bool) -> [Frag] -> ([Frag], [Frag])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Frag -> Bool
isVar [Frag]
ys
      in [Frag]
vars [Frag] -> [Frag] -> [Frag]
forall a. [a] -> [a] -> [a]
++ [Frag] -> [Frag]
combineLits [Frag]
ys'

    isLit :: Frag -> Bool
isLit (Lit Text
_) = Bool
True
    isLit Frag
_       = Bool
False

    isVar :: Frag -> Bool
isVar = Bool -> Bool
not (Bool -> Bool) -> (Frag -> Bool) -> Frag -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Frag -> Bool
isLit

    fromLit :: Frag -> Text
fromLit (Lit Text
v) = Text
v
    fromLit Frag
_       = Text
forall a. HasCallStack => a
undefined

-- | Perform the template substitution, returning a new 'LT.Text'.
render :: Template -> Context -> LT.Text
render :: Template -> (Text -> Text) -> Text
render (Template [Frag]
frags) Text -> Text
ctxFunc = [Text] -> Text
LT.fromChunks ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Frag -> Text) -> [Frag] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Frag -> Text
renderFrag [Frag]
frags
  where
    renderFrag :: Frag -> Text
renderFrag (Lit Text
s)   = Text
s
    renderFrag (Var Text
x Bool
_) = Text -> Text
ctxFunc Text
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 :: forall (f :: * -> *).
Applicative f =>
Template -> ContextA f -> f Text
renderA (Template [Frag]
frags) ContextA f
ctxFunc = [Text] -> Text
LT.fromChunks ([Text] -> Text) -> f [Text] -> f Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Frag -> f Text) -> [Frag] -> f [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Frag -> f Text
renderFrag [Frag]
frags
  where
    renderFrag :: Frag -> f Text
renderFrag (Lit Text
s)   = ContextA f
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
s
    renderFrag (Var Text
x Bool
_) = ContextA f
ctxFunc Text
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 :: Text -> (Text -> Text) -> Text
substitute = Template -> (Text -> Text) -> Text
render (Template -> (Text -> Text) -> Text)
-> (Text -> Template) -> Text -> (Text -> Text) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Template
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 :: forall (f :: * -> *). Applicative f => Text -> ContextA f -> f Text
substituteA = Template -> ContextA f -> f Text
forall (f :: * -> *).
Applicative f =>
Template -> ContextA f -> f Text
renderA (Template -> ContextA f -> f Text)
-> (Text -> Template) -> Text -> ContextA f -> f Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Template
template

-- -----------------------------------------------------------------------------
-- Template parser

pFrags :: Parser [Frag]
pFrags :: Parser [Frag]
pFrags = do
    Maybe Char
c <- Parser (Maybe Char)
peek
    case Maybe Char
c of
      Maybe Char
Nothing  -> [Frag] -> Parser [Frag]
forall a. a -> StateT S Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []
      Just Char
'$' -> do Maybe Char
c' <- Parser (Maybe Char)
peekSnd
                     case Maybe Char
c' of
                       Just Char
'$' -> do Int -> Parser ()
discard Int
2
                                      StateT S Identity Frag -> Parser [Frag]
continue (Frag -> StateT S Identity Frag
forall a. a -> StateT S Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Frag -> StateT S Identity Frag) -> Frag -> StateT S Identity Frag
forall a b. (a -> b) -> a -> b
$ Text -> Frag
Lit (Text -> Frag) -> Text -> Frag
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
"$")
                       Maybe Char
_        -> StateT S Identity Frag -> Parser [Frag]
continue StateT S Identity Frag
pVar
      Maybe Char
_        -> StateT S Identity Frag -> Parser [Frag]
continue StateT S Identity Frag
pLit
  where
    continue :: StateT S Identity Frag -> Parser [Frag]
continue StateT S Identity Frag
x = (Frag -> [Frag] -> [Frag])
-> StateT S Identity Frag -> Parser [Frag] -> Parser [Frag]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) StateT S Identity Frag
x Parser [Frag]
pFrags

pFragsSafe :: Parser (Either (Int, Int) [Frag])
pFragsSafe :: Parser (Either (Int, Int) [Frag])
pFragsSafe = [Frag] -> Parser (Either (Int, Int) [Frag])
pFragsSafe' []
  where
    pFragsSafe' :: [Frag] -> Parser (Either (Int, Int) [Frag])
pFragsSafe' [Frag]
frags = do
        Maybe Char
c <- Parser (Maybe Char)
peek
        case Maybe Char
c of
          Maybe Char
Nothing  -> Either (Int, Int) [Frag] -> Parser (Either (Int, Int) [Frag])
forall a. a -> StateT S Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Int, Int) [Frag] -> Parser (Either (Int, Int) [Frag]))
-> ([Frag] -> Either (Int, Int) [Frag])
-> [Frag]
-> Parser (Either (Int, Int) [Frag])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Frag] -> Either (Int, Int) [Frag]
forall a b. b -> Either a b
Right ([Frag] -> Either (Int, Int) [Frag])
-> ([Frag] -> [Frag]) -> [Frag] -> Either (Int, Int) [Frag]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Frag] -> [Frag]
forall a. [a] -> [a]
reverse ([Frag] -> Parser (Either (Int, Int) [Frag]))
-> [Frag] -> Parser (Either (Int, Int) [Frag])
forall a b. (a -> b) -> a -> b
$ [Frag]
frags
          Just Char
'$' -> do Maybe Char
c' <- Parser (Maybe Char)
peekSnd
                         case Maybe Char
c' of
                           Just Char
'$' -> do Int -> Parser ()
discard Int
2
                                          Frag -> Parser (Either (Int, Int) [Frag])
continue (Text -> Frag
Lit (Text -> Frag) -> Text -> Frag
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
"$")
                           Maybe Char
_        -> do Either (Int, Int) Frag
e <- Parser (Either (Int, Int) Frag)
pVarSafe
                                          ((Int, Int) -> Parser (Either (Int, Int) [Frag]))
-> (Frag -> Parser (Either (Int, Int) [Frag]))
-> Either (Int, Int) Frag
-> Parser (Either (Int, Int) [Frag])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Int, Int) -> Parser (Either (Int, Int) [Frag])
forall {a} {b}. a -> StateT S Identity (Either a b)
abort Frag -> Parser (Either (Int, Int) [Frag])
continue Either (Int, Int) Frag
e
          Maybe Char
_        -> do Frag
l <- StateT S Identity Frag
pLit
                         Frag -> Parser (Either (Int, Int) [Frag])
continue Frag
l
      where
        continue :: Frag -> Parser (Either (Int, Int) [Frag])
continue Frag
x = [Frag] -> Parser (Either (Int, Int) [Frag])
pFragsSafe' (Frag
x Frag -> [Frag] -> [Frag]
forall a. a -> [a] -> [a]
: [Frag]
frags)
        abort :: a -> StateT S Identity (Either a b)
abort      = Either a b -> StateT S Identity (Either a b)
forall a. a -> StateT S Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a b -> StateT S Identity (Either a b))
-> (a -> Either a b) -> a -> StateT S Identity (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a b
forall a b. a -> Either a b
Left

pVar :: Parser Frag
pVar :: StateT S Identity Frag
pVar = do
    Int -> Parser ()
discard Int
1
    Maybe Char
c <- Parser (Maybe Char)
peek
    case Maybe Char
c of
      Just Char
'{' -> do Int -> Parser ()
discard Int
1
                     Text
v <- Parser Text
pIdentifier
                     Maybe Char
c' <- Parser (Maybe Char)
peek
                     case Maybe Char
c' of
                       Just Char
'}' -> do Int -> Parser ()
discard Int
1
                                      Frag -> StateT S Identity Frag
forall a. a -> StateT S Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Frag -> StateT S Identity Frag) -> Frag -> StateT S Identity Frag
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> Frag
Var Text
v Bool
True
                       Maybe Char
_        -> ((Int, Int) -> Frag)
-> StateT S Identity (Int, Int) -> StateT S Identity Frag
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int, Int) -> Frag
forall a. (Int, Int) -> a
parseError StateT S Identity (Int, Int)
pos
      Maybe Char
_        -> do Text
v <- Parser Text
pIdentifier
                     Frag -> StateT S Identity Frag
forall a. a -> StateT S Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Frag -> StateT S Identity Frag) -> Frag -> StateT S Identity Frag
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> Frag
Var Text
v Bool
False

pVarSafe :: Parser (Either (Int, Int) Frag)
pVarSafe :: Parser (Either (Int, Int) Frag)
pVarSafe = do
    Int -> Parser ()
discard Int
1
    Maybe Char
c <- Parser (Maybe Char)
peek
    case Maybe Char
c of
      Just Char
'{' -> do Int -> Parser ()
discard Int
1
                     Either (Int, Int) Text
e <- Parser (Either (Int, Int) Text)
pIdentifierSafe
                     case Either (Int, Int) Text
e of
                       Right Text
v -> do Maybe Char
c' <- Parser (Maybe Char)
peek
                                     case Maybe Char
c' of
                                       Just Char
'}' -> do Int -> Parser ()
discard Int
1
                                                      Either (Int, Int) Frag -> Parser (Either (Int, Int) Frag)
forall a. a -> StateT S Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Int, Int) Frag -> Parser (Either (Int, Int) Frag))
-> Either (Int, Int) Frag -> Parser (Either (Int, Int) Frag)
forall a b. (a -> b) -> a -> b
$ Frag -> Either (Int, Int) Frag
forall a b. b -> Either a b
Right (Text -> Bool -> Frag
Var Text
v Bool
True)
                                       Maybe Char
_        -> ((Int, Int) -> Either (Int, Int) Frag)
-> StateT S Identity (Int, Int) -> Parser (Either (Int, Int) Frag)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int, Int) -> Either (Int, Int) Frag
forall a. (Int, Int) -> Either (Int, Int) a
parseErrorSafe StateT S Identity (Int, Int)
pos
                       Left (Int, Int)
m  -> Either (Int, Int) Frag -> Parser (Either (Int, Int) Frag)
forall a. a -> StateT S Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Int, Int) Frag -> Parser (Either (Int, Int) Frag))
-> Either (Int, Int) Frag -> Parser (Either (Int, Int) Frag)
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Either (Int, Int) Frag
forall a b. a -> Either a b
Left (Int, Int)
m
      Maybe Char
_        -> do Either (Int, Int) Text
e <- Parser (Either (Int, Int) Text)
pIdentifierSafe
                     Either (Int, Int) Frag -> Parser (Either (Int, Int) Frag)
forall a. a -> StateT S Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Int, Int) Frag -> Parser (Either (Int, Int) Frag))
-> Either (Int, Int) Frag -> Parser (Either (Int, Int) Frag)
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> Either (Int, Int) Frag)
-> (Text -> Either (Int, Int) Frag)
-> Either (Int, Int) Text
-> Either (Int, Int) Frag
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Int, Int) -> Either (Int, Int) Frag
forall a b. a -> Either a b
Left (\Text
v -> Frag -> Either (Int, Int) Frag
forall a b. b -> Either a b
Right (Frag -> Either (Int, Int) Frag) -> Frag -> Either (Int, Int) Frag
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> Frag
Var Text
v Bool
False) Either (Int, Int) Text
e

pIdentifier :: Parser T.Text
pIdentifier :: Parser Text
pIdentifier = do
    Maybe Char
m <- Parser (Maybe Char)
peek
    if Maybe Char -> Bool
forall a. Maybe a -> Bool
isJust Maybe Char
m Bool -> Bool -> Bool
&& Char -> Bool
isIdentifier0 (Maybe Char -> Char
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Char
m)
      then (Char -> Bool) -> Parser Text
takeWhile Char -> Bool
isIdentifier1
      else ((Int, Int) -> Text) -> StateT S Identity (Int, Int) -> Parser Text
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int, Int) -> Text
forall a. (Int, Int) -> a
parseError StateT S Identity (Int, Int)
pos

pIdentifierSafe :: Parser (Either (Int, Int) T.Text)
pIdentifierSafe :: Parser (Either (Int, Int) Text)
pIdentifierSafe = do
    Maybe Char
m <- Parser (Maybe Char)
peek
    if Maybe Char -> Bool
forall a. Maybe a -> Bool
isJust Maybe Char
m Bool -> Bool -> Bool
&& Char -> Bool
isIdentifier0 (Maybe Char -> Char
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Char
m)
      then (Text -> Either (Int, Int) Text)
-> Parser Text -> Parser (Either (Int, Int) Text)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Text -> Either (Int, Int) Text
forall a b. b -> Either a b
Right ((Char -> Bool) -> Parser Text
takeWhile Char -> Bool
isIdentifier1)
      else ((Int, Int) -> Either (Int, Int) Text)
-> StateT S Identity (Int, Int) -> Parser (Either (Int, Int) Text)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int, Int) -> Either (Int, Int) Text
forall a. (Int, Int) -> Either (Int, Int) a
parseErrorSafe StateT S Identity (Int, Int)
pos

pLit :: Parser Frag
pLit :: StateT S Identity Frag
pLit = do
    Text
s <- (Char -> Bool) -> Parser Text
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'$')
    Frag -> StateT S Identity Frag
forall a. a -> StateT S Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Frag -> StateT S Identity Frag) -> Frag -> StateT S Identity Frag
forall a b. (a -> b) -> a -> b
$ Text -> Frag
Lit Text
s

isIdentifier0 :: Char -> Bool
isIdentifier0 :: Char -> Bool
isIdentifier0 Char
c = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Char -> Bool
isLower Char
c, Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_']

isIdentifier1 :: Char -> Bool
isIdentifier1 :: Char -> Bool
isIdentifier1 Char
c = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Char -> Bool
isAlphaNum Char
c, Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"_'"]

parseError :: (Int, Int) -> a
parseError :: forall a. (Int, Int) -> a
parseError = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> ((Int, Int) -> String) -> (Int, Int) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> String
makeParseErrorMessage

parseErrorSafe :: (Int, Int) -> Either (Int, Int) a
parseErrorSafe :: forall a. (Int, Int) -> Either (Int, Int) a
parseErrorSafe = (Int, Int) -> Either (Int, Int) a
forall a b. a -> Either a b
Left

makeParseErrorMessage :: (Int, Int) -> String
makeParseErrorMessage :: (Int, Int) -> String
makeParseErrorMessage (Int
row, Int
col) =
    String
"Invalid placeholder at " String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
"row " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
row String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", col " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
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 :: Parser (Maybe Char)
char = do
    S Text
s Int
row Int
col <- StateT S Identity S
forall s (m :: * -> *). MonadState s m => m s
get
    if Text -> Bool
T.null Text
s
      then Maybe Char -> Parser (Maybe Char)
forall a. a -> StateT S Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Char
forall a. Maybe a
Nothing
      else do Char
c <- Char -> StateT S Identity Char
forall a. a -> StateT S Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> StateT S Identity Char) -> Char -> StateT S Identity Char
forall a b. (a -> b) -> a -> b
$! HasCallStack => Text -> Char
Text -> Char
T.head Text
s
              case Char
c of
                Char
'\n' -> S -> Parser ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (S -> Parser ()) -> S -> Parser ()
forall a b. (a -> b) -> a -> b
$! Text -> Int -> Int -> S
S (HasCallStack => Text -> Text
Text -> Text
T.tail Text
s) (Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
1
                Char
_    -> S -> Parser ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (S -> Parser ()) -> S -> Parser ()
forall a b. (a -> b) -> a -> b
$! Text -> Int -> Int -> S
S (HasCallStack => Text -> Text
Text -> Text
T.tail Text
s) Int
row (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
              Maybe Char -> Parser (Maybe Char)
forall a. a -> StateT S Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Char -> Parser (Maybe Char))
-> Maybe Char -> Parser (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c

peek :: Parser (Maybe Char)
peek :: Parser (Maybe Char)
peek = do
    S
s <- StateT S Identity S
forall s (m :: * -> *). MonadState s m => m s
get
    Maybe Char
c <- Parser (Maybe Char)
char
    S -> Parser ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put S
s
    Maybe Char -> Parser (Maybe Char)
forall a. a -> StateT S Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Char
c

peekSnd :: Parser (Maybe Char)
peekSnd :: Parser (Maybe Char)
peekSnd = do
    S
s <- StateT S Identity S
forall s (m :: * -> *). MonadState s m => m s
get
    Maybe Char
_ <- Parser (Maybe Char)
char
    Maybe Char
c <- Parser (Maybe Char)
char
    S -> Parser ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put S
s
    Maybe Char -> Parser (Maybe Char)
forall a. a -> StateT S Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Char
c

takeWhile :: (Char -> Bool) -> Parser T.Text
takeWhile :: (Char -> Bool) -> Parser Text
takeWhile Char -> Bool
p = do
    S Text
s Int
row Int
col <- StateT S Identity S
forall s (m :: * -> *). MonadState s m => m s
get
#if MIN_VERSION_text(0,11,0)
    case (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
p Text
s of
#else
    case T.spanBy p s of
#endif
      (Text
x, Text
s') -> do
                  let xlines :: [Text]
xlines = Text -> [Text]
T.lines Text
x
                      row' :: Int
row' = Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
xlines Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                      col' :: Int
col' = case [Text]
xlines of
                               [] -> Int
col -- Empty selection
                               [Text
sameLine] -> Text -> Int
T.length Text
sameLine
                                             -- Taken from this line
                               [Text]
_  -> Text -> Int
T.length ([Text] -> Text
forall a. HasCallStack => [a] -> a
last [Text]
xlines)
                                     -- Selection extends
                                     -- to next line at least
                  S -> Parser ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (S -> Parser ()) -> S -> Parser ()
forall a b. (a -> b) -> a -> b
$! Text -> Int -> Int -> S
S Text
s' Int
row' Int
col'
                  Text -> Parser Text
forall a. a -> StateT S Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
x

discard :: Int -> Parser ()
discard :: Int -> Parser ()
discard Int
n = Int -> Parser (Maybe Char) -> Parser ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
n Parser (Maybe Char)
char

pos :: Parser (Int, Int)
pos :: StateT S Identity (Int, Int)
pos = do
    S Text
_ Int
row Int
col <- StateT S Identity S
forall s (m :: * -> *). MonadState s m => m s
get
    (Int, Int) -> StateT S Identity (Int, Int)
forall a. a -> StateT S Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
row, Int
col)

runParser :: Parser a -> T.Text -> a
runParser :: forall a. Parser a -> Text -> a
runParser Parser a
p Text
s = Parser a -> S -> a
forall s a. State s a -> s -> a
evalState Parser a
p (S -> a) -> S -> a
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Int -> S
S Text
s Int
1 Int
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")]