{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Text.Glabrous.Internal where
import Control.Applicative ((<|>))
import Data.Attoparsec.Text
import qualified Data.HashMap.Strict as H
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import Text.Glabrous.Types
toTextWithContext :: (T.Text -> T.Text) -> Context -> [Token] -> T.Text
toTextWithContext :: (Text -> Text) -> Context -> [Token] -> Text
toTextWithContext Text -> Text
tagDefault Context{HashMap Text Text
variables :: Context -> HashMap Text Text
variables :: HashMap Text Text
..} [Token]
ts =
[Text] -> Text
T.concat (Token -> Text
trans forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token]
ts)
where
trans :: Token -> Text
trans (Tag Text
k) = forall a. a -> Maybe a -> a
fromMaybe (Text -> Text
tagDefault Text
k) (forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
k HashMap Text Text
variables)
trans (Literal Text
c) = Text
c
fromText :: T.Text -> Either String Template
fromText :: Text -> Either String Template
fromText Text
t =
case forall a. Parser a -> Text -> Either String a
parseOnly Parser [Token]
tokens Text
t of
Right [Token]
ts -> forall a b. b -> Either a b
Right Template { content :: [Token]
content = [Token]
ts }
Left String
e -> forall a b. a -> Either a b
Left String
e
isLiteral :: Token -> Bool
isLiteral :: Token -> Bool
isLiteral (Literal Text
_) = Bool
True
isLiteral Token
_ = Bool
False
isTag :: Token -> Bool
isTag :: Token -> Bool
isTag (Tag Text
_) = Bool
True
isTag Token
_ = Bool
False
tokens :: Parser [Token]
tokens :: Parser [Token]
tokens =
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser Text Token
token
where
token :: Parser Text Token
token = Parser Text Token
literal forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Token
tag forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Token
leftover
leftover :: Parser Text Token
leftover = do
Text
c <- (Char -> Bool) -> Parser Text
takeWhile1 (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
content)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Token
Literal Text
c)
literal :: Parser Text Token
literal = do
Text
c <- (Char -> Bool) -> Parser Text
takeWhile1 Char -> Bool
content
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Token
Literal Text
c)
tag :: Parser Text Token
tag = do
Text
_ <- Text -> Parser Text
string Text
"{{"
Literal Text
t <- Parser Text Token
literal
Text
_ <- Text -> Parser Text
string Text
"}}"
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Token
Tag Text
t)
content :: Char -> Bool
content Char
'}' = Bool
False
content Char
'{' = Bool
False
content Char
_ = Bool
True