{-# language OverloadedStrings #-}
{-# language CPP #-}
module SitePipe.Types
  ( TemplatePath
  , GlobPattern
  , Settings(..)
  , SiteM
  , SitePipeError(..)
  ) where

import Control.Monad.Catch
import Text.Pandoc
import qualified Text.Megaparsec as MP
import qualified Text.Parsec as P
import Text.Mustache.Render (SubstitutionError)
import Control.Monad.Reader
import Control.Monad.Writer
import qualified Text.Mustache.Types as MT

#if MIN_VERSION_megaparsec(6,0,0)
import Data.Void (Void)
type MPErr = Void
#else
type MPErr = MP.Dec
#endif

-- | String alias; Path to a template
type TemplatePath = String

-- | String alias; Valid globbing pattern. Follows shell globbing, allows recursive @/**/*@ globs.
type GlobPattern = String

-- | A monad collecting site instructions. Use liftIO to perform arbitrary IO.
type SiteM a = ReaderT Settings (WriterT [String] IO) a

-- | Global Settings
data Settings = Settings
  { Settings -> FilePath
srcDir :: FilePath
  , Settings -> FilePath
outputDir :: FilePath
  , Settings -> Value
globalContext :: MT.Value
  } deriving Int -> Settings -> ShowS
[Settings] -> ShowS
Settings -> FilePath
(Int -> Settings -> ShowS)
-> (Settings -> FilePath) -> ([Settings] -> ShowS) -> Show Settings
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Settings] -> ShowS
$cshowList :: [Settings] -> ShowS
show :: Settings -> FilePath
$cshow :: Settings -> FilePath
showsPrec :: Int -> Settings -> ShowS
$cshowsPrec :: Int -> Settings -> ShowS
Show

-- | Collection of possible errors.
data SitePipeError =
  YamlErr String String
    | PParseErr P.ParseError
    | MParseErr (MP.ParseErrorBundle String Void)
    | PandocErr PandocError
    | JSONErr String String
    | TemplateParseErr P.ParseError
    | TemplateInterpolateErr String [SubstitutionError]
    | SitePipeError String

instance Show SitePipeError where
  show :: SitePipeError -> FilePath
show (YamlErr FilePath
path FilePath
err) = FilePath
"YAML Parse Error in " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
path FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
":\n" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
err
  show (PandocErr PandocError
err) = FilePath
"Pandoc Error: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ PandocError -> FilePath
forall a. Show a => a -> FilePath
show PandocError
err
  show (PParseErr ParseError
err) = FilePath
"Template Error: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ParseError -> FilePath
forall a. Show a => a -> FilePath
show ParseError
err
  show (MParseErr ParseErrorBundle FilePath Void
err) = FilePath
"Meta-data Error: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ParseErrorBundle FilePath Void -> FilePath
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> FilePath
MP.errorBundlePretty ParseErrorBundle FilePath Void
err
  show (JSONErr FilePath
path FilePath
err) = FilePath
"JSON Parse Error in " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
path FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
":\n" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
err
  show (TemplateParseErr ParseError
err) = FilePath
"Template Parse Error: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ParseError -> FilePath
forall a. Show a => a -> FilePath
show ParseError
err
  show (TemplateInterpolateErr FilePath
path [SubstitutionError]
errs) =
    FilePath
"Template Interpolation Errors in " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
path FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++  FilePath
":\n" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ [SubstitutionError] -> FilePath
forall a. Show a => a -> FilePath
show [SubstitutionError]
errs
  show (SitePipeError FilePath
err) = FilePath
err

instance Exception SitePipeError