    {-# 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")]