module Text.Glabrous
(
Template (..)
, Tag
, fromText
, readTemplateFile
, tagsOf
, tagsRename
, isFinal
, toText
, toFinalText
, compress
, writeTemplateFile
, Context (..)
, initContext
, fromTagsList
, fromList
, fromTemplate
, setVariables
, deleteVariables
, variablesOf
, isSet
, unsetContext
, readContextFile
, writeContextFile
, initContextFile
, process
, processWithDefault
, partialProcess
, G.Result (..)
, partialProcess'
) where
import Control.Monad
import Data.Aeson
import Data.Aeson.Encode.Pretty (encodePretty)
import qualified Data.ByteString.Lazy as L
import qualified Data.HashMap.Strict as H
import Data.List (uncons)
import qualified Data.Text as T
import qualified Data.Text.IO as I
import Text.Glabrous.Internal
import Text.Glabrous.Types as G
compress :: Template -> Template
compress Template{..} =
Template { content = go content [] }
where
go ts !ac = do
let (a,b) = span isLiteral ts
u = uncons b
if not (null a)
then case u of
Just (c,d) -> go d (ac ++ [concatLiterals a] ++ [c])
Nothing -> ac ++ [concatLiterals a]
else case u of
Just (e,f) -> go f (ac ++ [e])
Nothing -> ac
where
concatLiterals =
foldr trans (Literal "")
where
trans (Literal a) (Literal b) = Literal (a `T.append` b)
trans _ _ = undefined
initContext :: Context
initContext = Context { variables = H.empty }
setVariables :: [(T.Text,T.Text)] -> Context -> Context
setVariables ts Context{..} =
go ts variables
where
go _ts vs =
case uncons _ts of
Just ((k,v),ts') -> go ts' $ H.insert k v vs
Nothing -> Context { variables = vs }
deleteVariables :: [T.Text] -> Context -> Context
deleteVariables ts Context{..} =
go ts variables
where
go _ts vs =
case uncons _ts of
Just (k,ts') -> go ts' $ H.delete k vs
Nothing -> Context { variables = vs }
fromList :: [(T.Text, T.Text)] -> Context
fromList ts = Context { variables = H.fromList ts }
fromTagsList :: [T.Text] -> Context
fromTagsList ts = fromList $ (\t -> (t,T.empty)) <$> ts
fromTemplate :: Template -> Context
fromTemplate t = setVariables ((\e -> (e,T.empty)) <$> tagsOf t) initContext
readContextFile :: FilePath -> IO (Maybe Context)
readContextFile f = decode <$> L.readFile f
writeContextFile :: FilePath -> Context -> IO ()
writeContextFile f c = L.writeFile f $ encodePretty c
initContextFile :: FilePath -> Context -> IO ()
initContextFile f Context {..} = L.writeFile f $
encodePretty Context { variables = H.map (const T.empty) variables }
unsetContext :: Context -> Maybe Context
unsetContext Context {..} = do
let vs = H.filter (== T.empty) variables
guard (vs /= H.empty)
return Context { variables = vs }
isSet :: Context -> Bool
isSet Context{..} =
H.foldr (\v b -> b && v /= T.empty) True variables
variablesOf :: Context -> [T.Text]
variablesOf Context{..} = H.keys variables
readTemplateFile :: FilePath -> IO (Either String Template)
readTemplateFile f = fromText <$> I.readFile f
writeTemplateFile :: FilePath -> Template -> IO ()
writeTemplateFile f t = I.writeFile f $ toText t
toText :: Template -> T.Text
toText Template{..} =
T.concat $ trans <$> content
where
trans (Literal c) = c
trans (Tag k) = T.concat ["{{",k,"}}"]
toFinalText :: Template -> T.Text
toFinalText Template{..} =
foldl trans T.empty content
where
trans o (Literal l) = o `T.append` l
trans o (Tag _) = o
tagsOf :: Template -> [Tag]
tagsOf Template{..} =
(\(Tag k) -> k) <$> filter isTag content
where
isTag (Tag _) = True
isTag _ = False
tagsRename :: [(T.Text,T.Text)] -> Template -> Template
tagsRename ts Template{..} =
Template { content = rename <$> content }
where
rename t@(Tag n) =
case lookup n ts of
Just r -> Tag r
Nothing -> t
rename l@(Literal _) = l
isFinal :: Template -> Bool
isFinal Template{..} = all isLiteral content
process :: Template -> Context -> T.Text
process = processWithDefault T.empty
processWithDefault
:: T.Text
-> Template
-> Context
-> T.Text
processWithDefault d Template{..} c = toTextWithContext (const d) c content
partialProcess :: Template -> Context -> Template
partialProcess Template{..} c =
Template { content = transTags content c }
where
transTags ts Context{..} =
trans <$> ts
where
trans i@(Tag k) =
case H.lookup k variables of
Just v -> Literal v
Nothing -> i
trans t = t
partialProcess' :: Template -> Context -> G.Result
partialProcess' t c@Context{..} =
case foldl trans ([],[]) (content t) of
(f,[]) -> Final $ toTextWithContext (const T.empty) c f
(p,p') -> G.Partial Template { content = p } (fromTagsList p')
where
trans (!c',!ts) t' =
case t' of
Tag k ->
case H.lookup k variables of
Just v -> (c' ++ [Literal v],ts)
Nothing -> (c' ++ [t'],ts ++ [k])
Literal _ -> (c' ++ [t'],ts)