    {-|
    Module      : $Header$
    Description : Functions for rendering mustache templates.
    Copyright   : (c) Justus Adam, 2015
    License     : BSD3
    Maintainer  : dev@justus.science
    Stability   : experimental
    Portability : POSIX
    -}
    {-# LANGUAGE FlexibleInstances          #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE OverloadedStrings          #-}
    {-# LANGUAGE TypeSynonymInstances       #-}
    {-# OPTIONS_GHC -fno-warn-orphans  #-}
    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           Data.Foldable                (for_)
    import           Data.HashMap.Strict          as HM hiding (keys, map)
    import           Data.Maybe                   (fromMaybe)

    import           Data.Scientific              (floatingOrInteger)
    import           Data.Text                    as T (Text, isSuffixOf, pack,
                                                        replace, stripSuffix)
    import qualified Data.Vector                  as V
    import           Prelude                      hiding (length, lines, unlines)

    import           Control.Monad.Reader
    import           Control.Monad.Writer
    import qualified Data.Text                    as T
    import qualified Data.Text.Lazy               as LT
    import           Text.Mustache.Internal
    import           Text.Mustache.Internal.Types
    import           Text.Mustache.Types

    {-|
      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  -> return ()
          | 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 return ()
            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) -> return ()
        Just Null         -> return ()
        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
        Nothing           -> contents
        _                 -> return ()
      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 = if T.null indentation then [] else [TextBlock indentation]
        content = if T.null indentation
          then ast'
          else reverse $ fromMaybe [] (uncurry (:) . first dropper <$> uncons (reverse fullIndented))
          where
            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

    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

    -- | Converts values to Text as required by the mustache standard
    toString :: Value -> SubM Text
    toString (String t) = return t
    toString (Number n) = return $ either (pack . show) (pack . show) (floatingOrInteger n :: Either Double Integer)
    toString e          = do
      tellError $ DirectlyRenderedValue e
      return $ 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 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 (return . TextBlock) . f)