module Text.Mustache.Render
(
substitute, substituteValue
, Context(..), search, innerSearch
, toString
) where
import Control.Applicative ((<|>))
import Control.Arrow (first)
import Control.Monad
import Data.Foldable (fold)
import Data.HashMap.Strict as HM hiding (keys, map)
import Data.Maybe (fromMaybe)
import Data.Scientific (floatingOrInteger)
import Data.Text as T (Text, isSuffixOf, null, pack,
replace, stripSuffix)
import qualified Data.Vector as V
import Prelude hiding (length, lines, unlines)
import Data.Monoid ((<>))
import Text.Mustache.Internal
import Text.Mustache.Types
substitute :: ToMustache k => Template -> k -> Text
substitute t = substituteValue t . toMustache
substituteValue :: Template -> Value -> Text
substituteValue (Template { ast = cAst, partials = cPartials }) dataStruct =
joinSubstituted (substitute' (Context mempty dataStruct)) cAst
where
joinSubstituted f = fold . fmap f
substitute' :: Context Value -> Node Text -> Text
substitute' _ (TextBlock t) = t
substitute' (Context parents focus@(Array a)) (Section Implicit secSTree)
| V.null a = mempty
| otherwise = flip joinSubstituted a $ \focus' ->
let
newContext = Context (focus:parents) focus'
in
joinSubstituted (substitute' newContext) secSTree
substitute' context@(Context _ (Object _)) (Section Implicit secSTree) =
joinSubstituted (substitute' context) secSTree
substitute' _ (Section Implicit _) = mempty
substitute' context@(Context parents focus) (Section (NamedData secName) secSTree) =
case search context secName of
Just arr@(Array arrCont) ->
if V.null arrCont
then mempty
else flip joinSubstituted arrCont $ \focus' ->
let
newContext = Context (arr:focus:parents) focus'
in
joinSubstituted (substitute' newContext) secSTree
Just (Bool False) -> mempty
Just (Lambda l) -> joinSubstituted (substitute' context) (l context secSTree)
Just focus' ->
let
newContext = Context (focus:parents) focus'
in
joinSubstituted (substitute' newContext) secSTree
Nothing -> mempty
substitute' _ (InvertedSection Implicit _ ) = mempty
substitute' context (InvertedSection (NamedData secName) invSecSTree) =
case search context secName of
Just (Bool False) -> contents
Just (Array a) | V.null a -> contents
Nothing -> contents
_ -> mempty
where
contents = joinSubstituted (substitute' context) invSecSTree
substitute' (Context _ current) (Variable _ Implicit) = toString current
substitute' context (Variable escaped (NamedData varName)) =
maybe
mempty
(if escaped then escapeXMLText else id)
$ toString <$> search context varName
substitute' context (Partial indent pName) =
maybe
mempty
(joinSubstituted (substitute' context) . handleIndent indent . ast)
$ HM.lookup pName cPartials
handleIndent :: Maybe Text -> STree -> STree
handleIndent Nothing ast' = ast'
handleIndent (Just indentation) ast' = preface <> content
where
preface = if T.null indentation then [] else [TextBlock indentation]
content = if T.null indentation
then ast'
else
let
fullIndented = fmap (indentBy indentation) ast'
dropper (TextBlock t) = TextBlock $
if ("\n" <> indentation) `isSuffixOf` t
then fromMaybe t $ stripSuffix indentation t
else t
dropper a = a
in
reverse $ fromMaybe [] (uncurry (:) . first dropper <$> uncons (reverse fullIndented))
search :: Context Value -> [Key] -> Maybe Value
search _ [] = Nothing
search ctx keys@(_:nextKeys) = go ctx keys >>= innerSearch nextKeys
where
go _ [] = Nothing
go (Context parents focus) val@(x:_) =
( case focus of
(Object o) -> HM.lookup x o
_ -> Nothing
)
<|> ( do
(newFocus, newParents) <- uncons parents
go (Context newParents newFocus) val
)
indentBy :: Text -> Node Text -> Node Text
indentBy indent p@(Partial (Just indent') name')
| T.null indent = p
| otherwise = Partial (Just (indent <> indent')) name'
indentBy indent (Partial Nothing name') = Partial (Just indent) name'
indentBy indent (TextBlock t) = TextBlock $ replace "\n" ("\n" <> indent) t
indentBy _ a = a
innerSearch :: [Key] -> Value -> Maybe Value
innerSearch [] v = Just v
innerSearch (y:ys) (Object o) = HM.lookup y o >>= innerSearch ys
innerSearch _ _ = Nothing
toString :: Value -> Text
toString (String t) = t
toString (Number n) = either (pack . show) (pack . show) (floatingOrInteger n :: Either Double Integer)
toString e = pack $ show e