{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TupleSections     #-}

-- | A minimalistic Mustache-like syntax, truly logic-less,
-- pure 'T.Text' template library
--
--    * Use only the simplest Mustache tag {{name}} called a variable.
--    * HTML agnostic
--

module Text.Glabrous
  (

  -- * 'Template'
    Template (..)

  -- ** Get a 'Template'
  , fromText
  , readTemplateFile

  -- ** 'Template' operations
  , addTag
  , tagsOf
  , tagsRename
  , isFinal
  , toText
  , toFinalText
  , compress
  , writeTemplateFile
  , insertTemplate
  , insertManyTemplates

  -- * 'Context'
  , Context (..)

  -- ** Get a 'Context'
  , initContext
  , fromTagsList
  , fromList
  , fromTemplate

  -- ** 'Context' operations
  , setVariables
  , deleteVariables
  , variablesOf
  , isSet
  , unsetContext
  , join

  -- ** JSON 'Context' file
  , readContextFile
  , writeContextFile
  , initContextFile

  -- * Processing
  , process
  , processWithDefault
  , partialProcess
  , Result (..)
  , partialProcess'

  ) where

import           Control.Monad            (guard)
import           Data.Aeson               hiding (Result)
import           Data.Aeson.Encode.Pretty (encodePretty)
import qualified Data.ByteString.Lazy     as L
import qualified Data.HashMap.Strict      as H
import           Data.List                (intersperse,intersect,uncons)
import qualified Data.Text                as T
import qualified Data.Text.IO             as I

import           Text.Glabrous.Internal
import           Text.Glabrous.Types


-- | Get 'Just' a new 'Template' with new tag(s) inside, or 'Nothing'.
addTag :: Template       -- ^ The template to work on
       -> T.Text         -- ^ Text to be replaced by the new tag
       -> T.Text         -- ^ New tag's name
       -> Maybe Template -- ^ Just a new template or nothing
addTag :: Template -> Text -> Text -> Maybe Template
addTag Template{[Token]
content :: Template -> [Token]
content :: [Token]
..} Text
r Text
n = do
  let nc :: [Token]
nc = (Token -> [Token]) -> [Token] -> [Token]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text -> Text -> Token -> [Token]
insertTag Text
r Text
n) [Token]
content
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ([Token] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Token]
nc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [Token] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Token]
content)
  Template -> Maybe Template
forall (m :: * -> *) a. Monad m => a -> m a
return Template :: [Token] -> Template
Template { content :: [Token]
content = [Token]
nc }
  where
    insertTag :: Text -> Text -> Token -> [Token]
insertTag Text
t Text
t' (Literal Text
l) =
      (Token -> Bool) -> [Token] -> [Token]
forall a. (a -> Bool) -> [a] -> [a]
filter
        (Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
/= Text -> Token
Literal Text
T.empty)
        (Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
intersperse (Text -> Token
Tag Text
t') ([Token] -> [Token]) -> [Token] -> [Token]
forall a b. (a -> b) -> a -> b
$ Text -> Token
Literal (Text -> Token) -> [Text] -> [Token]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> [Text]
T.splitOn Text
t Text
l)
    insertTag Text
_ Text
_ t :: Token
t@(Tag Text
_) = [Token
t]

-- | Optimize a 'Template' content after (many) 'partialProcess'(') rewriting(s).
compress :: Template -> Template
compress :: Template -> Template
compress Template{[Token]
content :: [Token]
content :: Template -> [Token]
..} =
  Template :: [Token] -> Template
Template { content :: [Token]
content = [Token] -> [Token] -> [Token]
go [Token]
content [] }
  where
    go :: [Token] -> [Token] -> [Token]
go [Token]
ts ![Token]
ac = do
      let ([Token]
a,[Token]
b) = (Token -> Bool) -> [Token] -> ([Token], [Token])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Token -> Bool
isLiteral [Token]
ts
          u :: Maybe (Token, [Token])
u = [Token] -> Maybe (Token, [Token])
forall a. [a] -> Maybe (a, [a])
uncons [Token]
b
      if Bool -> Bool
not ([Token] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Token]
a)
        then case Maybe (Token, [Token])
u of
          Just (Token
c,[Token]
d) -> [Token] -> [Token] -> [Token]
go [Token]
d ([Token]
ac [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ [[Token] -> Token
concatLiterals [Token]
a] [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ [Token
c])
          Maybe (Token, [Token])
Nothing    -> [Token]
ac [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ [[Token] -> Token
concatLiterals [Token]
a]
        else case Maybe (Token, [Token])
u of
          Just (Token
e,[Token]
f) -> [Token] -> [Token] -> [Token]
go [Token]
f ([Token]
ac [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ [Token
e])
          Maybe (Token, [Token])
Nothing    -> [Token]
ac
      where
        concatLiterals :: [Token] -> Token
concatLiterals =
          (Token -> Token -> Token) -> Token -> [Token] -> Token
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Token -> Token -> Token
trans (Text -> Token
Literal Text
"")
          where
            trans :: Token -> Token -> Token
trans (Literal Text
a) (Literal Text
b) = Text -> Token
Literal (Text
a Text -> Text -> Text
`T.append` Text
b)
            trans Token
_           Token
_           = Token
forall a. HasCallStack => a
undefined

-- | Build an empty 'Context'.
initContext :: Context
initContext :: Context
initContext = Context :: HashMap Text Text -> Context
Context { variables :: HashMap Text Text
variables = HashMap Text Text
forall k v. HashMap k v
H.empty }

-- | Populate with variables and/or update variables in the given 'Context'.
--
-- >λ>setVariables [("tag","replacement"), ("theme","Haskell")] context
-- >Context {variables = fromList [("etc.","..."),("theme","Haskell"),("tag","replacement"),("name","")]}
setVariables :: [(T.Text,T.Text)] -> Context -> Context
setVariables :: [(Text, Text)] -> Context -> Context
setVariables [(Text, Text)]
ts Context{HashMap Text Text
variables :: HashMap Text Text
variables :: Context -> HashMap Text Text
..} =
  [(Text, Text)] -> HashMap Text Text -> Context
go [(Text, Text)]
ts HashMap Text Text
variables
  where
    go :: [(Text, Text)] -> HashMap Text Text -> Context
go [(Text, Text)]
_ts HashMap Text Text
vs =
      case [(Text, Text)] -> Maybe ((Text, Text), [(Text, Text)])
forall a. [a] -> Maybe (a, [a])
uncons [(Text, Text)]
_ts of
        Just ((Text
k,Text
v),[(Text, Text)]
ts') -> [(Text, Text)] -> HashMap Text Text -> Context
go [(Text, Text)]
ts' (Text -> Text -> HashMap Text Text -> HashMap Text Text
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert Text
k Text
v HashMap Text Text
vs)
        Maybe ((Text, Text), [(Text, Text)])
Nothing          -> Context :: HashMap Text Text -> Context
Context { variables :: HashMap Text Text
variables = HashMap Text Text
vs }

-- | Delete variables from a 'Context' by these names.
--
-- >λ>deleteVariables ["tag"] context
-- >Context {variables = fromList [("etc.","..."),("theme","Haskell"),("name","")]}
deleteVariables :: [T.Text] -> Context -> Context
deleteVariables :: [Text] -> Context -> Context
deleteVariables [Text]
ts Context{HashMap Text Text
variables :: HashMap Text Text
variables :: Context -> HashMap Text Text
..} =
  [Text] -> HashMap Text Text -> Context
go [Text]
ts HashMap Text Text
variables
  where
    go :: [Text] -> HashMap Text Text -> Context
go [Text]
_ts HashMap Text Text
vs =
      case [Text] -> Maybe (Text, [Text])
forall a. [a] -> Maybe (a, [a])
uncons [Text]
_ts of
        Just (Text
k,[Text]
ts') -> [Text] -> HashMap Text Text -> Context
go [Text]
ts' (Text -> HashMap Text Text -> HashMap Text Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
H.delete Text
k HashMap Text Text
vs)
        Maybe (Text, [Text])
Nothing      -> Context :: HashMap Text Text -> Context
Context { variables :: HashMap Text Text
variables = HashMap Text Text
vs }

-- | Build a 'Context' from a list of 'Tag's and replacement 'T.Text's.
--
-- >λ>fromList [("tag","replacement"), ("etc.","...")]
-- >Context {variables = fromList [("etc.","..."),("tag","replacement")]}
--
fromList :: [(T.Text, T.Text)] -> Context
fromList :: [(Text, Text)] -> Context
fromList [(Text, Text)]
ts = Context :: HashMap Text Text -> Context
Context { variables :: HashMap Text Text
variables = [(Text, Text)] -> HashMap Text Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList [(Text, Text)]
ts }

-- | Build an unset 'Context' from a list of 'Tag's.
--
-- >λ>fromTagsList ["tag","etc."]
-- >Context {variables = fromList [("etc.",""),("tag","")]}
fromTagsList :: [T.Text] -> Context
fromTagsList :: [Text] -> Context
fromTagsList [Text]
ts = [(Text, Text)] -> Context
fromList ([(Text, Text)] -> Context) -> [(Text, Text)] -> Context
forall a b. (a -> b) -> a -> b
$ (,Text
T.empty) (Text -> (Text, Text)) -> [Text] -> [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
ts

-- | Build an unset ad hoc 'Context' from the given 'Template'.
fromTemplate :: Template -> Context
fromTemplate :: Template -> Context
fromTemplate Template
t = [(Text, Text)] -> Context -> Context
setVariables ((\(Tag Text
e) -> (Text
e,Text
T.empty)) (Token -> (Text, Text)) -> [Token] -> [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Template -> [Token]
tagsOf Template
t) Context
initContext

-- | Get a 'Context' from a JSON file.
readContextFile :: FilePath -> IO (Maybe Context)
readContextFile :: FilePath -> IO (Maybe Context)
readContextFile FilePath
f = ByteString -> Maybe Context
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe Context)
-> IO ByteString -> IO (Maybe Context)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
L.readFile FilePath
f

-- | Join two 'Context's if they don't share variables
-- name, or get the intersection 'Context' out of them.
join :: Context
     -> Context
     -> Either Context Context
join :: Context -> Context -> Either Context Context
join Context
c Context
c' = do
  let i :: HashMap Text Text
i = HashMap Text Text -> HashMap Text Text -> HashMap Text Text
forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
H.intersection (Context -> HashMap Text Text
variables Context
c) (Context -> HashMap Text Text
variables Context
c')
  if HashMap Text Text
i HashMap Text Text -> HashMap Text Text -> Bool
forall a. Eq a => a -> a -> Bool
== HashMap Text Text
forall k v. HashMap k v
H.empty
    then Context -> Either Context Context
forall a b. b -> Either a b
Right Context :: HashMap Text Text -> Context
Context { variables :: HashMap Text Text
variables = HashMap Text Text -> HashMap Text Text -> HashMap Text Text
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
H.union (Context -> HashMap Text Text
variables Context
c) (Context -> HashMap Text Text
variables Context
c') }
    else Context -> Either Context Context
forall a b. a -> Either a b
Left Context :: HashMap Text Text -> Context
Context { variables :: HashMap Text Text
variables = HashMap Text Text
i }

-- | Write a 'Context' to a file.
--
-- @
-- {
--     "tag": "replacement",
--     "etc.": "..."
-- }
-- @
--
writeContextFile :: FilePath -> Context -> IO ()
writeContextFile :: FilePath -> Context -> IO ()
writeContextFile FilePath
f Context
c = FilePath -> ByteString -> IO ()
L.writeFile FilePath
f (Context -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty Context
c)

-- | Based on the given 'Context', write a JSON
-- 'Context' file with all its variables empty.
--
-- @
-- {
--     "tag": "",
--     "etc.": ""
-- }
-- @
--
initContextFile :: FilePath -> Context -> IO ()
initContextFile :: FilePath -> Context -> IO ()
initContextFile FilePath
f Context{HashMap Text Text
variables :: HashMap Text Text
variables :: Context -> HashMap Text Text
..} = FilePath -> ByteString -> IO ()
L.writeFile FilePath
f (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$
  Context -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty Context :: HashMap Text Text -> Context
Context { variables :: HashMap Text Text
variables = (Text -> Text) -> HashMap Text Text -> HashMap Text Text
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
H.map (Text -> Text -> Text
forall a b. a -> b -> a
const Text
T.empty) HashMap Text Text
variables }

-- | Build 'Just' a (sub)'Context' made of unset variables
-- of the given context, or 'Nothing'.
--
-- >λ>unsetContext context
-- >Just (Context {variables = fromList [("name","")]})
--
unsetContext :: Context -> Maybe Context
unsetContext :: Context -> Maybe Context
unsetContext Context {HashMap Text Text
variables :: HashMap Text Text
variables :: Context -> HashMap Text Text
..} = do
  let vs :: HashMap Text Text
vs = (Text -> Bool) -> HashMap Text Text -> HashMap Text Text
forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
H.filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
T.empty) HashMap Text Text
variables
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (HashMap Text Text
vs HashMap Text Text -> HashMap Text Text -> Bool
forall a. Eq a => a -> a -> Bool
/= HashMap Text Text
forall k v. HashMap k v
H.empty)
  Context -> Maybe Context
forall (m :: * -> *) a. Monad m => a -> m a
return Context :: HashMap Text Text -> Context
Context { variables :: HashMap Text Text
variables = HashMap Text Text
vs }

-- | 'True' if the all variables of
-- the given 'Context' are not empty.
isSet :: Context -> Bool
isSet :: Context -> Bool
isSet Context{HashMap Text Text
variables :: HashMap Text Text
variables :: Context -> HashMap Text Text
..} =
  (Text -> Bool -> Bool) -> Bool -> HashMap Text Text -> Bool
forall v a k. (v -> a -> a) -> a -> HashMap k v -> a
H.foldr (\Text
v Bool
b -> Bool
b Bool -> Bool -> Bool
&& Text
v Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
T.empty) Bool
True HashMap Text Text
variables

-- | Get the list of the given 'Context' variables.
variablesOf :: Context -> [T.Text]
variablesOf :: Context -> [Text]
variablesOf Context{HashMap Text Text
variables :: HashMap Text Text
variables :: Context -> HashMap Text Text
..} = HashMap Text Text -> [Text]
forall k v. HashMap k v -> [k]
H.keys HashMap Text Text
variables

-- | Get a 'Template' from a file.
readTemplateFile :: FilePath -> IO (Either String Template)
readTemplateFile :: FilePath -> IO (Either FilePath Template)
readTemplateFile FilePath
f = Text -> Either FilePath Template
fromText (Text -> Either FilePath Template)
-> IO Text -> IO (Either FilePath Template)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Text
I.readFile FilePath
f

-- | Write a 'Template' to a file.
writeTemplateFile :: FilePath -> Template -> IO ()
writeTemplateFile :: FilePath -> Template -> IO ()
writeTemplateFile FilePath
f Template
t = FilePath -> Text -> IO ()
I.writeFile FilePath
f (Template -> Text
toText Template
t)

-- | get 'Just' a new 'Template' by inserting a 'Template'
-- into another one by replacing the 'Tag', or 'Nothing'.
--
-- >λ>insert t0 (Tag "template1") t1
insertTemplate :: Template       -- ^ The Template to insert in
               -> Token          -- ^ The Tag to be replaced
               -> Template       -- ^ The Template to be inserted
               -> Maybe Template -- ^ Just the new Template, or Nothing
insertTemplate :: Template -> Token -> Template -> Maybe Template
insertTemplate Template
_ (Literal Text
_) Template
_ = Maybe Template
forall a. Maybe a
Nothing
insertTemplate Template
te Token
t Template
te' = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Token
t Token -> [Token] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Template -> [Token]
content Template
te)
  Template -> Maybe Template
forall (m :: * -> *) a. Monad m => a -> m a
return Template :: [Token] -> Template
Template { content :: [Token]
content = ([Token] -> Token -> [Token]) -> [Token] -> [Token] -> [Token]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [Token] -> Token -> [Token]
trans [] (Template -> [Token]
content Template
te) }
  where
    trans :: [Token] -> Token -> [Token]
trans [Token]
o t' :: Token
t'@(Tag Text
_) =
      if Token
t' Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Token
t
        then [Token]
o [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ Template -> [Token]
content Template
te'
        else [Token]
o [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ [Token
t']
    trans [Token]
o Token
l = [Token]
o [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ [Token
l]

-- | get 'Just' a new 'Template' by inserting many 'Template's,
-- if there is at least one tag correspondence, or 'Nothing'.
--
-- >λ>insertMany t0 [(Tag "template1",t1),(Tag "template2",t2)]
insertManyTemplates :: Template -> [(Token,Template)] -> Maybe Template
insertManyTemplates :: Template -> [(Token, Template)] -> Maybe Template
insertManyTemplates Template
te [(Token, Template)]
ttps = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Template -> [Token]
tagsOf Template
te [Token] -> [Token] -> [Token]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` ((Token, Template) -> Token
forall a b. (a, b) -> a
fst ((Token, Template) -> Token) -> [(Token, Template)] -> [Token]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Token, Template)]
ttps) [Token] -> [Token] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Token]
forall a. Monoid a => a
mempty)
  Template -> Maybe Template
forall (m :: * -> *) a. Monad m => a -> m a
return Template :: [Token] -> Template
Template { content :: [Token]
content = ([Token] -> Token -> [Token]) -> [Token] -> [Token] -> [Token]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [Token] -> Token -> [Token]
trans [] (Template -> [Token]
content Template
te) }
  where
    trans :: [Token] -> Token -> [Token]
trans [Token]
o li :: Token
li@(Literal Text
_) = [Token]
o [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ [Token
li]
    trans [Token]
o ta :: Token
ta@(Tag Text
_) =
      case Token -> [(Token, Template)] -> Maybe Template
forall a. Token -> [(Token, a)] -> Maybe a
lookupTemplate Token
ta [(Token, Template)]
ttps of
        Maybe Template
Nothing  -> [Token]
o [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ [Token
ta]
        Just Template
te' -> [Token]
o [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ Template -> [Token]
content Template
te'
    lookupTemplate :: Token -> [(Token, a)] -> Maybe a
lookupTemplate (Literal Text
_) [(Token, a)]
_ = Maybe a
forall a. Maybe a
Nothing
    lookupTemplate Token
_ []          = Maybe a
forall a. Maybe a
Nothing
    lookupTemplate Token
t ((Token, a)
p:[(Token, a)]
ps) =
      if (Token, a) -> Token
forall a b. (a, b) -> a
fst (Token, a)
p Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Token
t
        then a -> Maybe a
forall a. a -> Maybe a
Just ((Token, a) -> a
forall a b. (a, b) -> b
snd (Token, a)
p)
        else Token -> [(Token, a)] -> Maybe a
lookupTemplate Token
t [(Token, a)]
ps

-- | Output the content of the given 'Template'
-- as it is, with its 'Tag's, if they exist.
toText :: Template -> T.Text
toText :: Template -> Text
toText Template{[Token]
content :: [Token]
content :: Template -> [Token]
..} =
  [Text] -> Text
T.concat (Token -> Text
trans (Token -> Text) -> [Token] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token]
content)
  where
    trans :: Token -> Text
trans (Literal Text
c) = Text
c
    trans (Tag Text
k)     = [Text] -> Text
T.concat [Text
"{{",Text
k,Text
"}}"]

-- | Output the content of the given 'Template'
-- with all its 'Tag's removed.
toFinalText :: Template -> T.Text
toFinalText :: Template -> Text
toFinalText Template{[Token]
content :: [Token]
content :: Template -> [Token]
..} =
  (Text -> Token -> Text) -> Text -> [Token] -> Text
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Text -> Token -> Text
trans Text
T.empty [Token]
content
  where
    trans :: Text -> Token -> Text
trans Text
o (Literal Text
l) = Text
o Text -> Text -> Text
`T.append` Text
l
    trans Text
o (Tag Text
_) = Text
o

-- | Get the list of 'Tag's in the given 'Template'.
tagsOf :: Template -> [Token]
tagsOf :: Template -> [Token]
tagsOf Template{[Token]
content :: [Token]
content :: Template -> [Token]
..} = (Token -> Bool) -> [Token] -> [Token]
forall a. (a -> Bool) -> [a] -> [a]
filter Token -> Bool
isTag [Token]
content

tagsRename :: [(T.Text,T.Text)] -> Template -> Template
tagsRename :: [(Text, Text)] -> Template -> Template
tagsRename [(Text, Text)]
ts Template{[Token]
content :: [Token]
content :: Template -> [Token]
..} =
  Template :: [Token] -> Template
Template { content :: [Token]
content = Token -> Token
rename (Token -> Token) -> [Token] -> [Token]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token]
content }
  where
    rename :: Token -> Token
rename t :: Token
t@(Tag Text
n) =
      case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
n [(Text, Text)]
ts of
        Just Text
r  -> Text -> Token
Tag Text
r
        Maybe Text
Nothing -> Token
t
    rename l :: Token
l@(Literal Text
_) = Token
l

-- | 'True' if a 'Template' has no more 'Tag'
-- inside and can be used as a final 'T.Text'.
isFinal :: Template -> Bool
isFinal :: Template -> Bool
isFinal Template{[Token]
content :: [Token]
content :: Template -> [Token]
..} = (Token -> Bool) -> [Token] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Token -> Bool
isLiteral [Token]
content

-- | Process, discard 'Tag's which are not in the 'Context'
-- and replace them with nothing in the final 'T.Text'.
process :: Template -> Context -> T.Text
process :: Template -> Context -> Text
process = Text -> Template -> Context -> Text
processWithDefault Text
T.empty

-- | Process and replace missing variables in 'Context'
-- with the given default replacement 'T.Text'.
processWithDefault
  :: T.Text    -- ^ Default replacement text
  -> Template
  -> Context
  -> T.Text
processWithDefault :: Text -> Template -> Context -> Text
processWithDefault Text
d Template{[Token]
content :: [Token]
content :: Template -> [Token]
..} Context
c = (Text -> Text) -> Context -> [Token] -> Text
toTextWithContext (Text -> Text -> Text
forall a b. a -> b -> a
const Text
d) Context
c [Token]
content

-- | Process a (sub)'Context' present in the given template, leaving
-- untouched, if they exist, other 'Tag's, to obtain a new template.
partialProcess :: Template -> Context -> Template
partialProcess :: Template -> Context -> Template
partialProcess Template{[Token]
content :: [Token]
content :: Template -> [Token]
..} Context
c =
  Template :: [Token] -> Template
Template { content :: [Token]
content = [Token] -> Context -> [Token]
forall (f :: * -> *). Functor f => f Token -> Context -> f Token
transTags [Token]
content Context
c }
  where
    transTags :: f Token -> Context -> f Token
transTags f Token
ts Context{HashMap Text Text
variables :: HashMap Text Text
variables :: Context -> HashMap Text Text
..} =
      Token -> Token
trans (Token -> Token) -> f Token -> f Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Token
ts
      where
        trans :: Token -> Token
trans i :: Token
i@(Tag Text
k) =
          case Text -> HashMap Text Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
k HashMap Text Text
variables of
            Just Text
v  -> Text -> Token
Literal Text
v
            Maybe Text
Nothing -> Token
i
        trans Token
t = Token
t

-- | Process a (sub)'Context' present in the given template, and
-- get either a 'Final' 'T.Text' or a new 'Template' with its unset
-- ad hoc 'Context'.
--
-- >λ>partialProcess' template context
-- >Partial {template = Template {content = [Literal "Some ",Tag "tags",Literal " are unused in this ",Tag "text",Literal "."]}, context = Context {variables = fromList [("text",""),("tags","")]}}
partialProcess' :: Template -> Context -> Result
partialProcess' :: Template -> Context -> Result
partialProcess' Template
t c :: Context
c@Context{HashMap Text Text
variables :: HashMap Text Text
variables :: Context -> HashMap Text Text
..} =
  case (([Token], [Text]) -> Token -> ([Token], [Text]))
-> ([Token], [Text]) -> [Token] -> ([Token], [Text])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ([Token], [Text]) -> Token -> ([Token], [Text])
trans ([Token]
forall a. Monoid a => a
mempty,[Text]
forall a. Monoid a => a
mempty) (Template -> [Token]
content Template
t) of
    ([Token]
f,[]) -> Text -> Result
Final ((Text -> Text) -> Context -> [Token] -> Text
toTextWithContext (Text -> Text -> Text
forall a b. a -> b -> a
const Text
T.empty) Context
c [Token]
f)
    ([Token]
p,[Text]
p') -> Template -> Context -> Result
Partial Template :: [Token] -> Template
Template { content :: [Token]
content = [Token]
p } ([Text] -> Context
fromTagsList [Text]
p')
  where
    trans :: ([Token], [Text]) -> Token -> ([Token], [Text])
trans (![Token]
c',![Text]
ts) Token
t' =
      case Token
t' of
        Tag Text
k ->
          case Text -> HashMap Text Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
k HashMap Text Text
variables of
            Just Text
v  -> ([Token]
c' [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ [Text -> Token
Literal Text
v],[Text]
ts)
            Maybe Text
Nothing -> ([Token]
c' [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ [Token
t'],[Text]
ts [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
k])
        Literal Text
_ -> ([Token]
c' [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ [Token
t'],[Text]
ts)