content: {-|
  Module      : $Header$
  Description : Functions for rendering mustache templates.
  Copyright   : (c) Justus Adam, 2015
  License     : BSD3
  Maintainer  : dev@justus.science
  Stability   : experimental
  Portability : POSIX
  -}
  {-# OPTIONS_GHC -fno-warn-orphans #-}
  {-# LANGUAGE CPP                  #-}
  {-# LANGUAGE FlexibleInstances    #-}
  {-# LANGUAGE OverloadedStrings    #-}
  module Text.Mustache.Render
    (
      -- * Substitution
      substitute
    , substituteValue
      -- * Checked substitution
    , checkedSubstitute
    , checkedSubstituteValue
    , SubstitutionError (..)
      -- * Working with Context
    , Context (..)
    , search
    , innerSearch
    , SubM
    , substituteNode
    , substituteAST
    , catchSubstitute
      -- * Util
    , toString
    ) where
  
  
  import           Control.Arrow ( first, second )
  import           Control.Monad ( (>=>) )
  import           Control.Monad.Reader ( MonadReader (..), asks )
  import           Control.Monad.Writer ( MonadWriter (..), censor )
  #if !MIN_VERSION_base(4,11,0)
  import           Data.Monoid ( (<>) )
  #endif
  import           Data.Foldable ( for_ )
  import qualified Data.HashMap.Strict as HM
  import           Data.Maybe ( fromMaybe )
  import           Data.Scientific ( floatingOrInteger )
  import           Data.Text ( Text )
  import qualified Data.Text as T
  import qualified Data.Text.Lazy as LT
  import qualified Data.Vector as V
  import           Text.Mustache.Internal ( escapeXMLText, uncons )
  import           Text.Mustache.Internal.Types
                     ( SubM (..), SubstitutionError (..), innerSearch, runSubM
                     , search, shiftContext, tellError, tellSuccess
                     )
  import           Text.Mustache.Types
                     ( Context (..), DataIdentifier (..), Node (..), STree
                     , Template (..), ToMustache (..), Value (..), askContext
                     )
  
  
  {-|
    Substitutes all mustache defined tokens (or tags) for values found in the
    provided data structure.
  
    Equivalent to @substituteValue . toMustache@.
  -}
  substitute :: ToMustache k => Template -> k -> Text
  substitute t = substituteValue t . toMustache
  
  
  {-|
    Substitutes all mustache defined tokens (or tags) for values found in the
    provided data structure and report any errors and warnings encountered during
    substitution.
  
    This function always produces results, as in a fully substituted/rendered template,
    it never halts on errors. It simply reports them in the first part of the tuple.
    Sites with errors are usually substituted with empty string.
  
    The second value in the tuple is a template rendered with errors ignored.
    Therefore if you must enforce that there were no errors during substitution
    you must check that the error list in the first tuple value is empty.
  
    Equivalent to @checkedSubstituteValue . toMustache@.
  -}
  checkedSubstitute :: ToMustache k => Template -> k -> ([SubstitutionError], Text)
  checkedSubstitute t = checkedSubstituteValue t . toMustache
  
  
  {-|
    Substitutes all mustache defined tokens (or tags) for values found in the
    provided data structure.
  -}
  substituteValue :: Template -> Value -> Text
  substituteValue = (snd .) . checkedSubstituteValue
  
  
  {-|
    Substitutes all mustache defined tokens (or tags) for values found in the
    provided data structure and report any errors and warnings encountered during
    substitution.
  
    This function always produces results, as in a fully substituted/rendered template,
    it never halts on errors. It simply reports them in the first part of the tuple.
    Sites with errors are usually substituted with empty string.
  
    The second value in the tuple is a template rendered with errors ignored.
    Therefore if you must enforce that there were no errors during substitution
    you must check that the error list in the first tuple value is empty.
  -}
  checkedSubstituteValue :: Template -> Value -> ([SubstitutionError], Text)
  checkedSubstituteValue template dataStruct =
    second T.concat $ runSubM
      (substituteAST (ast template))
      (Context mempty dataStruct)
      (partials template)
  
  
  -- | Catch the results of running the inner substitution.
  catchSubstitute :: SubM a -> SubM (a, Text)
  catchSubstitute =
    fmap (second (T.concat . snd)) . SubM . hideResults . listen . runSubM'
    where
      hideResults = censor (\(errs, _) -> (errs, []))
  
  
  -- | Substitute an entire 'STree' rather than just a single 'Node'
  substituteAST :: STree -> SubM ()
  substituteAST = mapM_ substituteNode
  
  
  -- | Main substitution function
  substituteNode :: Node Text -> SubM ()
  
  -- subtituting text
  substituteNode (TextBlock t) = tellSuccess t
  
  -- substituting a whole section (entails a focus shift)
  substituteNode (Section Implicit secSTree) =
    asks fst >>= \case
      Context parents focus@(Array a)
        | V.null a  -> pure ()
        | otherwise -> for_ a $ \focus' ->
          let newContext = Context (focus:parents) focus'
          in shiftContext newContext $ substituteAST secSTree
      Context _ (Object _) -> substituteAST secSTree
      Context _ v -> tellError $ InvalidImplicitSectionContextType $ showValueType v
  
  substituteNode (Section (NamedData secName) secSTree) =
    search secName >>= \case
      Just arr@(Array arrCont) ->
        if V.null arrCont
          then pure ()
          else do
            Context parents focus <- asks fst
            for_ arrCont $ \focus' ->
              let newContext = Context (arr:focus:parents) focus'
              in shiftContext newContext $ substituteAST secSTree
      Just (Bool False) -> pure ()
      Just Null         -> pure ()
      Just (Lambda l)   -> substituteAST =<< l secSTree
      Just focus'       -> do
        Context parents focus <- asks fst
        let newContext = Context (focus:parents) focus'
        shiftContext newContext $ substituteAST secSTree
      Nothing -> tellError $ SectionTargetNotFound secName
  
  -- substituting an inverted section
  substituteNode (InvertedSection  Implicit _) = tellError InvertedImplicitSection
  substituteNode (InvertedSection (NamedData secName) invSecSTree) =
    search secName >>= \case
      Just (Bool False) -> contents
      Just (Array a)    | V.null a -> contents
      Just Null         -> contents
      Nothing           -> contents
      _                 -> pure ()
    where
      contents = mapM_ substituteNode invSecSTree
  
  -- substituting a variable
  substituteNode (Variable _ Implicit) = asks (ctxtFocus . fst) >>= toString >>= tellSuccess
  substituteNode (Variable escaped (NamedData varName)) =
    maybe
      (tellError $ VariableNotFound varName)
      (toString >=> tellSuccess . (if escaped then escapeXMLText else id))
      =<< search varName
  
  -- substituting a partial
  substituteNode (Partial indent pName) = do
    cPartials <- asks snd
    case HM.lookup pName cPartials of
      Nothing -> tellError $ PartialNotFound pName
      Just t ->
        let ast' = handleIndent indent $ ast t
        in local (second (partials t `HM.union`)) $ substituteAST ast'
  
  
  showValueType :: Value -> String
  showValueType Null       = "Null"
  showValueType (Object _) = "Object"
  showValueType (Array _)  = "Array"
  showValueType (String _) = "String"
  showValueType (Lambda _) = "Lambda"
  showValueType (Number _) = "Number"
  showValueType (Bool _)   = "Bool"
  
  
  handleIndent :: Maybe Text -> STree -> STree
  handleIndent Nothing ast' = ast'
  handleIndent (Just indentation) ast' = preface <> content
    where
      preface = [TextBlock indentation | not (T.null indentation)]
      content = if T.null indentation
        then ast'
        else reverse $ maybe [] (uncurry (:) . first dropper) (uncons (reverse fullIndented))
        where
          fullIndented = fmap (indentBy indentation) ast'
          dropper (TextBlock t) = TextBlock $
            if ("\n" <> indentation) `T.isSuffixOf` t
              then fromMaybe t $ T.stripSuffix indentation t
              else t
          dropper a = a
  
  
  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 $ T.replace "\n" ("\n" <> indent) t
  indentBy _ a = a
  
  
  -- | Converts values to Text as required by the mustache standard
  toString :: Value -> SubM Text
  toString (String t) = pure t
  toString (Number n) = pure $ either
    (T.pack . show)
    (T.pack . show)
    (floatingOrInteger n :: Either Double Integer)
  toString (Lambda l) = do
    ((), res) <- catchSubstitute $ substituteAST =<< l []
    pure res
  toString e          = do
    tellError $ DirectlyRenderedValue e
    pure $ T.pack $ show e
  
  
  instance ToMustache (Context Value -> STree -> STree) where
    toMustache f = Lambda $ (<$> askContext) . flip f
  
  instance ToMustache (Context Value -> STree -> Text) where
    toMustache = lambdaHelper id
  
  instance ToMustache (Context Value -> STree -> LT.Text) where
    toMustache = lambdaHelper LT.toStrict
  
  instance ToMustache (Context Value -> STree -> String) where
    toMustache = lambdaHelper T.pack
  
  lambdaHelper :: (r -> Text) -> (Context Value -> STree -> r) -> Value
  lambdaHelper conv f = Lambda $ (<$> askContext) . wrapper
    where
      wrapper ::  STree -> Context Value -> STree
      wrapper lSTree c = [TextBlock $ conv $ f c lSTree]
  
  instance ToMustache (STree -> SubM Text) where
    toMustache f = Lambda (fmap (pure . TextBlock) . f)
  