{- |
Module      : Text.Pandoc.Class.CommonState
Copyright   : Copyright (C) 2016-2020 Jesse Rosenthal, John MacFarlane
License     : GNU GPL, version 2 or above

Maintainer  : Jesse Rosenthal <jrosenthal@jhu.edu>
Stability   : alpha
Portability : portable

Common state shared by all pandoc-specific operations, including
those in readers, writers, and Lua filters.
-}

module Text.Pandoc.Class.CommonState
  ( CommonState(..)
  , defaultCommonState
  )
where

import Data.Default (Default (def))
import Data.Text (Text)
import Text.Pandoc.BCP47 (Lang)
import Text.Pandoc.MediaBag (MediaBag)
import Text.Pandoc.Logging (LogMessage, Verbosity (WARNING))
import Text.Pandoc.Translations (Translations)

-- | 'CommonState' represents state that is used by all
-- instances of 'PandocMonad'.  Normally users should not
-- need to interact with it directly; instead, auxiliary
-- functions like 'setVerbosity' and 'withMediaBag' should be used.
data CommonState = CommonState
  { CommonState -> [LogMessage]
stLog          :: [LogMessage]
    -- ^ A list of log messages in reverse order
  , CommonState -> Maybe FilePath
stUserDataDir  :: Maybe FilePath
    -- ^ Directory to search for data files
  , CommonState -> Maybe Text
stSourceURL    :: Maybe Text
    -- ^ Absolute URL + dir of 1st source file
  , CommonState -> [(Text, Text)]
stRequestHeaders :: [(Text, Text)]
    -- ^ Headers to add for HTTP requests
  , CommonState -> Bool
stNoCheckCertificate :: Bool
    -- ^ Controls whether certificate validation is disabled
  , CommonState -> MediaBag
stMediaBag     :: MediaBag
    -- ^ Media parsed from binary containers
  , CommonState -> Maybe (Lang, Maybe Translations)
stTranslations :: Maybe (Lang, Maybe Translations)
    -- ^ Translations for localization
  , CommonState -> [FilePath]
stInputFiles   :: [FilePath]
    -- ^ List of input files from command line
  , CommonState -> Maybe FilePath
stOutputFile   :: Maybe FilePath
    -- ^ Output file from command line
  , CommonState -> [FilePath]
stResourcePath :: [FilePath]
    -- ^ Path to search for resources like
    -- included images
  , CommonState -> Verbosity
stVerbosity    :: Verbosity
    -- ^ Verbosity level
  , CommonState -> Bool
stTrace        :: Bool
    -- ^ Controls whether tracing messages are
    -- issued.
  }

-- | The default @'CommonState'@. All fields are initialized as the
-- monoid identity of their resprective type, except for:
--
--   * @'stResourcePath'@, which is set to @["."]@,
--   * @'stTrace'@, which is set to @'False'@, and
--   * @'stVerbosity'@, which is set to @WARNING@.
defaultCommonState :: CommonState
defaultCommonState :: CommonState
defaultCommonState = CommonState :: [LogMessage]
-> Maybe FilePath
-> Maybe Text
-> [(Text, Text)]
-> Bool
-> MediaBag
-> Maybe (Lang, Maybe Translations)
-> [FilePath]
-> Maybe FilePath
-> [FilePath]
-> Verbosity
-> Bool
-> CommonState
CommonState
  { stLog :: [LogMessage]
stLog = []
  , stUserDataDir :: Maybe FilePath
stUserDataDir = Maybe FilePath
forall a. Maybe a
Nothing
  , stSourceURL :: Maybe Text
stSourceURL = Maybe Text
forall a. Maybe a
Nothing
  , stRequestHeaders :: [(Text, Text)]
stRequestHeaders = []
  , stNoCheckCertificate :: Bool
stNoCheckCertificate = Bool
False
  , stMediaBag :: MediaBag
stMediaBag = MediaBag
forall a. Monoid a => a
mempty
  , stTranslations :: Maybe (Lang, Maybe Translations)
stTranslations = Maybe (Lang, Maybe Translations)
forall a. Maybe a
Nothing
  , stInputFiles :: [FilePath]
stInputFiles = []
  , stOutputFile :: Maybe FilePath
stOutputFile = Maybe FilePath
forall a. Maybe a
Nothing
  , stResourcePath :: [FilePath]
stResourcePath = [FilePath
"."]
  , stVerbosity :: Verbosity
stVerbosity = Verbosity
WARNING
  , stTrace :: Bool
stTrace = Bool
False
  }

instance Default CommonState where
  def :: CommonState
def = CommonState
defaultCommonState