{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
module Text.Haiji.Types
       ( Template(..)
       , render
       , Environment
       , autoEscape
       , Escape
       , escapeBy
       , rawEscape
       , htmlEscape
       , ToLT
       , toLT
       ) where

import Control.Monad.Trans.Reader
import Data.Default
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT

data Escape = Escape { Escape -> Text -> Text
unEscape :: LT.Text -> LT.Text }

escapeBy :: LT.Text -> Escape -> LT.Text
escapeBy :: Text -> Escape -> Text
escapeBy = forall a b c. (a -> b -> c) -> b -> a -> c
flip Escape -> Text -> Text
unEscape

rawEscape :: Escape
rawEscape :: Escape
rawEscape = (Text -> Text) -> Escape
Escape forall a. a -> a
id

htmlEscape :: Escape
htmlEscape :: Escape
htmlEscape = (Text -> Text) -> Escape
Escape ((Char -> Text) -> Text -> Text
LT.concatMap Char -> Text
replace) where
  replace :: Char -> Text
replace Char
'&'  = Text
"&"
  replace Char
'"'  = Text
"""
  replace Char
'\'' = Text
"'"
  replace Char
'<'  = Text
"&lt;"
  replace Char
'>'  = Text
"&gt;"
  replace Char
h    = Char -> Text
LT.singleton Char
h

-- | A template environment
data Environment =
  Environment
  { Environment -> Bool
autoEscape :: Bool -- ^ XML/HTML autoescaping
  } deriving (Environment -> Environment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Environment -> Environment -> Bool
$c/= :: Environment -> Environment -> Bool
== :: Environment -> Environment -> Bool
$c== :: Environment -> Environment -> Bool
Eq, Int -> Environment -> ShowS
[Environment] -> ShowS
Environment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Environment] -> ShowS
$cshowList :: [Environment] -> ShowS
show :: Environment -> String
$cshow :: Environment -> String
showsPrec :: Int -> Environment -> ShowS
$cshowsPrec :: Int -> Environment -> ShowS
Show)

instance Default Environment where
  def :: Environment
def = Environment { autoEscape :: Bool
autoEscape = Bool
True
                    }

-- | Haiji template
newtype Template dict = Template { forall dict. Template dict -> Reader dict Text
unTmpl :: Reader dict LT.Text }

-- | Render Haiji template with given dictionary
render :: Template dict -> dict -> LT.Text
render :: forall dict. Template dict -> dict -> Text
render = forall r a. Reader r a -> r -> a
runReader forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall dict. Template dict -> Reader dict Text
unTmpl

class ToLT a where toLT :: a -> LT.Text
instance ToLT T.Text  where toLT :: Text -> Text
toLT = Text -> Text
LT.fromStrict
instance ToLT Integer where toLT :: Integer -> Text
toLT = String -> Text
LT.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
instance ToLT Bool    where toLT :: Bool -> Text
toLT = String -> Text
LT.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show