module Buffet.Document.DocumentInternal
  ( get
  ) where

import qualified Buffet.Document.Configuration as Configuration
import qualified Buffet.Document.TemplateContext as TemplateContext
import qualified Buffet.Ir.Ir as Ir
import qualified Buffet.Toolbox.ExceptionTools as ExceptionTools
import qualified Buffet.Toolbox.TextTools as TextTools
import qualified Control.Exception as Exception
import qualified Data.Aeson as Aeson
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Text as T
import Prelude
  ( FilePath
  , IO
  , Show
  , ($)
  , (.)
  , (<>)
  , fmap
  , maybe
  , pure
  , show
  , unlines
  )
import qualified System.FilePath as FilePath
import qualified Text.Mustache as Mustache
import qualified Text.Mustache.Render as Render
import qualified Text.Mustache.Types as Types
import qualified Text.Parsec as Parsec

data Exception
  = CompileException Parsec.ParseError
  | SubstituteException FilePath (NonEmpty.NonEmpty Render.SubstitutionError)

instance Show Exception where
  show :: Exception -> String
show (CompileException ParseError
error) = ParseError -> String
forall a. Show a => a -> String
show ParseError
error
  show (SubstituteException String
path NonEmpty SubstitutionError
errors) =
    [String] -> String
unlines ([String] -> String)
-> (NonEmpty String -> [String]) -> NonEmpty String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
NonEmpty.toList (NonEmpty String -> [String])
-> (NonEmpty String -> NonEmpty String)
-> NonEmpty String
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> NonEmpty String -> NonEmpty String
forall a. a -> NonEmpty a -> NonEmpty a
NonEmpty.cons (String
path String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":") (NonEmpty String -> String) -> NonEmpty String -> String
forall a b. (a -> b) -> a -> b
$ (SubstitutionError -> String)
-> NonEmpty SubstitutionError -> NonEmpty String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SubstitutionError -> String
show' NonEmpty SubstitutionError
errors
    where
      show' :: SubstitutionError -> String
show' (Render.VariableNotFound [Key]
name) =
        String
"Variable not found: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Key] -> String
showName [Key]
name
      show' (Render.InvalidImplicitSectionContextType String
valueType) =
        String
"Invalid implicit section context type: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
valueType
      show' SubstitutionError
Render.InvertedImplicitSection = String
"Inverted implicit section"
      show' (Render.SectionTargetNotFound [Key]
name) =
        String
"Section target not found: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Key] -> String
showName [Key]
name
      show' (Render.PartialNotFound String
path') = String
"Partial not found: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
path'
      show' (Render.DirectlyRenderedValue Value
value) =
        String
"Directly rendered value: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
value
      showName :: [Key] -> String
showName = Key -> String
T.unpack (Key -> String) -> ([Key] -> Key) -> [Key] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> [Key] -> Key
T.intercalate (String -> Key
T.pack String
".")

instance Exception.Exception Exception

get :: Configuration.Configuration -> Ir.Buffet -> IO T.Text
get :: Configuration -> Buffet -> IO Key
get Configuration
configuration =
  (Value -> IO Key)
-> (String -> Value -> IO Key) -> Maybe String -> Value -> IO Key
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (Key -> IO Key
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Key -> IO Key) -> (Value -> Key) -> Value -> IO Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Key
printTemplateContext)
    String -> Value -> IO Key
renderTemplate
    (Configuration -> Maybe String
Configuration.template Configuration
configuration) (Value -> IO Key) -> (Buffet -> Value) -> Buffet -> IO Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Buffet -> Value
TemplateContext.get

printTemplateContext :: Aeson.Value -> T.Text
printTemplateContext :: Value -> Key
printTemplateContext = Value -> Key
forall a. ToJSON a => a -> Key
TextTools.prettyPrintJson

renderTemplate :: FilePath -> Aeson.Value -> IO T.Text
renderTemplate :: String -> Value -> IO Key
renderTemplate String
templatePath Value
templateContext = do
  Template
template <- String -> IO Template
getTemplate String
templatePath
  let ([SubstitutionError]
errors, Key
result) =
        Template -> Value -> ([SubstitutionError], Key)
forall k.
ToMustache k =>
Template -> k -> ([SubstitutionError], Key)
Mustache.checkedSubstitute Template
template (Value -> ([SubstitutionError], Key))
-> Value -> ([SubstitutionError], Key)
forall a b. (a -> b) -> a -> b
$ Value -> Value
forall ι. ToJSON ι => ι -> Value
Types.mFromJSON Value
templateContext
  IO Key
-> (NonEmpty SubstitutionError -> IO Key)
-> Maybe (NonEmpty SubstitutionError)
-> IO Key
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Key -> IO Key
forall (f :: * -> *) a. Applicative f => a -> f a
pure Key
result) (Exception -> IO Key
forall e a. Exception e => e -> IO a
Exception.throwIO (Exception -> IO Key)
-> (NonEmpty SubstitutionError -> Exception)
-> NonEmpty SubstitutionError
-> IO Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> NonEmpty SubstitutionError -> Exception
SubstituteException String
templatePath) (Maybe (NonEmpty SubstitutionError) -> IO Key)
-> Maybe (NonEmpty SubstitutionError) -> IO Key
forall a b. (a -> b) -> a -> b
$
    [SubstitutionError] -> Maybe (NonEmpty SubstitutionError)
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [SubstitutionError]
errors

getTemplate :: FilePath -> IO Mustache.Template
getTemplate :: String -> IO Template
getTemplate String
templatePath =
  (ParseError -> Exception)
-> IO (Either ParseError Template) -> IO Template
forall e a b. Exception e => (a -> e) -> IO (Either a b) -> IO b
ExceptionTools.eitherThrow ParseError -> Exception
CompileException (IO (Either ParseError Template) -> IO Template)
-> IO (Either ParseError Template) -> IO Template
forall a b. (a -> b) -> a -> b
$
  [String] -> String -> IO (Either ParseError Template)
Mustache.automaticCompile [String]
searchSpace String
templatePath
  where
    searchSpace :: [String]
searchSpace = [String
".", ShowS
FilePath.takeDirectory String
templatePath]