module Data.Text.Template (
Template(),
lit,
placeholder,
parseTemplate,
applyTemplate,
printTemplate
) where
import Data.Monoid
import Data.Foldable (fold)
import Data.Traversable (traverse)
import qualified Data.Text as T
import Control.Applicative
data TemplatePart = Lit T.Text | Placeholder T.Text deriving (Show, Eq, Ord)
newtype Template = Template { runTemplate :: [TemplatePart] } deriving (Show, Eq, Ord)
instance Monoid Template where
mempty = Template mempty
mappend t1 t2 = Template (runTemplate t1 `mappend` runTemplate t2)
lit :: T.Text -> Template
lit = Template . pure . Lit
placeholder :: T.Text -> Template
placeholder = Template . pure . Placeholder
parseTemplate :: T.Text -> Template
parseTemplate = Template . go
where
go :: T.Text -> [TemplatePart]
go t | T.null t = []
| "{{" `T.isPrefixOf` t = let (name, rest) = T.breakOn "}}" (T.drop 2 t)
in Placeholder (T.strip name) : go (T.drop 2 rest)
| otherwise = let (text, rest) = T.breakOn "{{" t
in Lit text : go rest
applyTemplate :: forall f. (Applicative f) => (T.Text -> f T.Text) -> Template -> f T.Text
applyTemplate f = fmap fold . traverse apply . runTemplate
where
apply :: TemplatePart -> f T.Text
apply (Lit t) = pure t
apply (Placeholder p) = f p
newtype Id a = Id { runId :: a }
instance Functor Id where
fmap f = Id . f . runId
instance Applicative Id where
pure = Id
(<*>) f x = Id $ runId f (runId x)
printTemplate :: Template -> T.Text
printTemplate = runId . applyTemplate (Id . ("{{" <>) . (<> "}}"))