-- ------------------------------------------------------------

{- |
   Module     : Text.XML.HXT.Arrow.XmlState.SystemConfig
   Copyright  : Copyright (C) 2010 Uwe Schmidt
   License    : MIT

   Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
   Stability  : stable
   Portability: portable

   system configuration and common options options

-}

-- ------------------------------------------------------------

module Text.XML.HXT.Arrow.XmlState.SystemConfig
where

import Control.Arrow

import Data.Map                         ( insert )

import Text.XML.HXT.DOM.Interface

import Text.XML.HXT.Arrow.XmlState.ErrorHandling
import Text.XML.HXT.Arrow.XmlState.TypeDefs

-- ------------------------------

-- config options

-- | @withTrace level@ : system option, set the trace level, (0..4)

withTrace                       :: Int -> SysConfig
withTrace :: Int -> SysConfig
withTrace                       = Selector XIOSysState Int -> Int -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState Int
theTraceLevel

-- | @withSysAttr key value@ : store an arbitrary key value pair in system state

withSysAttr                     :: String -> String -> SysConfig
withSysAttr :: String -> String -> SysConfig
withSysAttr String
n String
v                 = Selector XIOSysState Attributes
-> (Attributes -> Attributes) -> SysConfig
forall s a. Selector s a -> (a -> a) -> s -> s
chgS Selector XIOSysState Attributes
theAttrList (String -> String -> Attributes -> Attributes
forall k v. Eq k => k -> v -> AssocList k v -> AssocList k v
addEntry String
n String
v)

-- | Specify the set of accepted mime types.
--
-- All contents of documents for which the mime type is not found in this list
-- are discarded.

withAcceptedMimeTypes           :: [String] -> SysConfig
withAcceptedMimeTypes :: [String] -> SysConfig
withAcceptedMimeTypes           = Selector XIOSysState [String] -> [String] -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState [String]
theAcceptedMimeTypes

-- | Specify a content handler for documents of a given mime type

withMimeTypeHandler             :: String -> IOSArrow XmlTree XmlTree -> SysConfig
withMimeTypeHandler :: String -> IOSArrow XmlTree XmlTree -> SysConfig
withMimeTypeHandler String
mt IOSArrow XmlTree XmlTree
pa       = Selector XIOSysState MimeTypeHandlers
-> (MimeTypeHandlers -> MimeTypeHandlers) -> SysConfig
forall s a. Selector s a -> (a -> a) -> s -> s
chgS Selector XIOSysState MimeTypeHandlers
theMimeTypeHandlers ((MimeTypeHandlers -> MimeTypeHandlers) -> SysConfig)
-> (MimeTypeHandlers -> MimeTypeHandlers) -> SysConfig
forall a b. (a -> b) -> a -> b
$ String
-> IOSArrow XmlTree XmlTree -> MimeTypeHandlers -> MimeTypeHandlers
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert String
mt IOSArrow XmlTree XmlTree
pa

-- | @withMimeTypeFile filename@ : input option,
-- set the mime type table for @file:@ documents by given file.
-- The format of this config file must be in the syntax of a debian linux \"mime.types\" config file

withMimeTypeFile                :: String -> SysConfig
withMimeTypeFile :: String -> SysConfig
withMimeTypeFile                = Selector XIOSysState String -> String -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState String
theMimeTypeFile

-- | Force a given mime type for all file contents.
--
-- The mime type for file access will then not be computed by looking into a mime.types file

withFileMimeType                :: String -> SysConfig
withFileMimeType :: String -> SysConfig
withFileMimeType                = Selector XIOSysState String -> String -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState String
theFileMimeType

-- | @withWarnings yes/no@ : system option, issue warnings during reading, HTML parsing and processing,
-- default is 'yes'

withWarnings                    :: Bool -> SysConfig
withWarnings :: Bool -> SysConfig
withWarnings                    = Selector XIOSysState Bool -> Bool -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState Bool
theWarnings

-- | @withErrors yes/no@ : system option for suppressing error messages, default is 'no'

withErrors                      :: Bool -> SysConfig
withErrors :: Bool -> SysConfig
withErrors Bool
b                    = Selector XIOSysState (String -> IO ())
-> (String -> IO ()) -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState (String -> IO ())
theErrorMsgHandler String -> IO ()
h
    where
    h :: String -> IO ()
h | Bool
b                       = String -> IO ()
errorOutputToStderr
      | Bool
otherwise               = IO () -> String -> IO ()
forall a b. a -> b -> a
const (IO () -> String -> IO ()) -> IO () -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | @withRemoveWS yes/no@ : read and write option, remove all whitespace, used for document indentation, default is 'no'

withRemoveWS                    :: Bool -> SysConfig
withRemoveWS :: Bool -> SysConfig
withRemoveWS                    = Selector XIOSysState Bool -> Bool -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState Bool
theRemoveWS

-- | @withPreserveComment yes/no@ : read option, preserve comments during canonicalization, default is 'no'

withPreserveComment             :: Bool -> SysConfig
withPreserveComment :: Bool -> SysConfig
withPreserveComment             = Selector XIOSysState Bool -> Bool -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState Bool
thePreserveComment

-- | @withParseByMimeType yes/no@  : read option, select the parser by the mime type of the document
-- (pulled out of the HTTP header).
--
-- When the mime type is set to \"text\/html\"
-- the configured HTML parser is taken, when it\'s set to
-- \"text\/xml\" or \"text\/xhtml\" the configured XML parser is taken.
-- If the mime type is something else, no further processing is performed,
-- the contents is given back to the application in form of a single text node.
-- If the default document encoding is set to isoLatin1, this even enables processing
-- of arbitray binary data.

withParseByMimeType             :: Bool -> SysConfig
withParseByMimeType :: Bool -> SysConfig
withParseByMimeType             = Selector XIOSysState Bool -> Bool -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState Bool
theParseByMimeType

-- | @withParseHTML yes/no@: read option, use HTML parser, default is 'no' (use XML parser)

withParseHTML                   :: Bool -> SysConfig
withParseHTML :: Bool -> SysConfig
withParseHTML                   = Selector XIOSysState Bool -> Bool -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState Bool
theParseHTML

-- | @withValidate yes/no@: read option, validate document against DTD, default is 'yes'

withValidate                    :: Bool -> SysConfig
withValidate :: Bool -> SysConfig
withValidate                    = Selector XIOSysState Bool -> Bool -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState Bool
theValidate

-- | @withSubstDTDEntities yes/no@: read option, substitute general entities defined in DTD, default is 'yes'.
-- switching this option and the validate option off can lead to faster parsing, because then
-- there is no need to access the DTD

withSubstDTDEntities            :: Bool -> SysConfig
withSubstDTDEntities :: Bool -> SysConfig
withSubstDTDEntities            = Selector XIOSysState Bool -> Bool -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState Bool
theSubstDTDEntities

-- | @withSubstHTMLEntities yes/no@: read option, substitute general entities defined in HTML DTD, default is 'no'.
-- switching this option on and the substDTDEntities and validate options off can lead to faster parsing
-- because there is no need to access a DTD, but still the HTML general entities are substituted

withSubstHTMLEntities            :: Bool -> SysConfig
withSubstHTMLEntities :: Bool -> SysConfig
withSubstHTMLEntities            = Selector XIOSysState Bool -> Bool -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState Bool
theSubstHTMLEntities

-- | @withCheckNamespaces yes/no@: read option, check namespaces, default is 'no'

withCheckNamespaces             :: Bool -> SysConfig
withCheckNamespaces :: Bool -> SysConfig
withCheckNamespaces             = Selector XIOSysState Bool -> Bool -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState Bool
theCheckNamespaces

-- | @withCanonicalize yes/no@ : read option, canonicalize document, default is 'yes'

withCanonicalize                :: Bool -> SysConfig
withCanonicalize :: Bool -> SysConfig
withCanonicalize                = Selector XIOSysState Bool -> Bool -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState Bool
theCanonicalize

-- | @withIgnoreNoneXmlContents yes\/no@ : input option, ignore document contents of none XML\/HTML documents.
--
-- This option can be useful for implementing crawler like applications, e.g. an URL checker.
-- In those cases net traffic can be reduced.

withIgnoreNoneXmlContents       :: Bool -> SysConfig
withIgnoreNoneXmlContents :: Bool -> SysConfig
withIgnoreNoneXmlContents       = Selector XIOSysState Bool -> Bool -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState Bool
theIgnoreNoneXmlContents

-- ------------------------------------------------------------

-- | @withStrictInput yes/no@ : input option, input of file and HTTP contents is read eagerly, default is 'no'

withStrictInput                 :: Bool -> SysConfig
withStrictInput :: Bool -> SysConfig
withStrictInput                 = Selector XIOSysState Bool -> Bool -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState Bool
theStrictInput

-- | @withEncodingErrors yes/no@ : input option, ignore all encoding errors, default is 'no'

withEncodingErrors              :: Bool -> SysConfig
withEncodingErrors :: Bool -> SysConfig
withEncodingErrors              = Selector XIOSysState Bool -> Bool -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState Bool
theEncodingErrors

-- | @withInputEncoding encodingName@ : input option
--
-- Set default document encoding ('utf8', 'isoLatin1', 'usAscii', 'iso8859_2', ... , 'iso8859_16', ...).
-- Only XML, HTML and text documents are decoded,
-- default decoding for XML\/HTML is utf8, for text iso latin1 (no decoding).

withInputEncoding               :: String -> SysConfig
withInputEncoding :: String -> SysConfig
withInputEncoding               = Selector XIOSysState String -> String -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState String
theInputEncoding

-- | @withDefaultBaseURI URI@ , input option, set the default base URI
--
-- This option can be useful when parsing documents from stdin or contained in a string, and interpreting
-- relative URIs within the document

withDefaultBaseURI              :: String -> SysConfig
withDefaultBaseURI :: String -> SysConfig
withDefaultBaseURI              = Selector XIOSysState String -> String -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState String
theDefaultBaseURI

withInputOption                 :: String -> String -> SysConfig
withInputOption :: String -> String -> SysConfig
withInputOption String
n String
v             = Selector XIOSysState Attributes
-> (Attributes -> Attributes) -> SysConfig
forall s a. Selector s a -> (a -> a) -> s -> s
chgS Selector XIOSysState Attributes
theInputOptions (String -> String -> Attributes -> Attributes
forall k v. Eq k => k -> v -> AssocList k v -> AssocList k v
addEntry String
n String
v)

withInputOptions                :: Attributes -> SysConfig
withInputOptions :: Attributes -> SysConfig
withInputOptions                = (SysConfig -> SysConfig -> SysConfig)
-> SysConfig -> [SysConfig] -> SysConfig
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr SysConfig -> SysConfig -> SysConfig
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
(>>>) SysConfig
forall a. a -> a
id ([SysConfig] -> SysConfig)
-> (Attributes -> [SysConfig]) -> Attributes -> SysConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> SysConfig) -> Attributes -> [SysConfig]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String -> SysConfig) -> (String, String) -> SysConfig
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> SysConfig
withInputOption)

-- | @withRedirect yes/no@ : input option, automatically follow redirected URIs, default is 'yes'

withRedirect                    :: Bool -> SysConfig
withRedirect :: Bool -> SysConfig
withRedirect                    = Selector XIOSysState Bool -> Bool -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState Bool
theRedirect

-- | @withProxy \"host:port\"@ : input option, configure a proxy for HTTP access, e.g. www-cache:3128

withProxy                       :: String -> SysConfig
withProxy :: String -> SysConfig
withProxy                       = Selector XIOSysState String -> String -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState String
theProxy

-- ------------------------------------------------------------

-- | @withIndent yes/no@ : output option, indent document before output, default is 'no'

withIndent                      :: Bool -> SysConfig
withIndent :: Bool -> SysConfig
withIndent                      = Selector XIOSysState Bool -> Bool -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState Bool
theIndent

-- | @withOutputEncoding encoding@ , output option,
-- default is the default input encoding or utf8, if input encoding is not set

withOutputEncoding              :: String -> SysConfig
withOutputEncoding :: String -> SysConfig
withOutputEncoding              = Selector XIOSysState String -> String -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState String
theOutputEncoding

-- | @withOutputXML@ : output option, default writing
--
-- Default is writing XML: quote special XML chars \>,\<,\",\',& where neccessary,
-- add XML processing instruction
-- and encode document with respect to 'withOutputEncoding'

withOutputXML                   :: SysConfig
withOutputXML :: SysConfig
withOutputXML                   = Selector XIOSysState XIOXoutConfig -> XIOXoutConfig -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState XIOXoutConfig
theOutputFmt XIOXoutConfig
XMLoutput

-- | Write XHTML: quote all special XML chars, use HTML entity refs or char refs for none ASCII chars

withOutputHTML                  :: SysConfig
withOutputHTML :: SysConfig
withOutputHTML                  = Selector XIOSysState XIOXoutConfig -> XIOXoutConfig -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState XIOXoutConfig
theOutputFmt XIOXoutConfig
HTMLoutput

-- | Write XML: quote only special XML chars, don't substitute chars by HTML entities,
-- and don\'t generate empty elements for HTML elements,
-- which may contain any contents, e.g. @<script src=...></script>@ instead of @<script src=... />@

withOutputXHTML                 :: SysConfig
withOutputXHTML :: SysConfig
withOutputXHTML                 = Selector XIOSysState XIOXoutConfig -> XIOXoutConfig -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState XIOXoutConfig
theOutputFmt XIOXoutConfig
XHTMLoutput

-- | suppreses all char and entitiy substitution

withOutputPLAIN                 :: SysConfig
withOutputPLAIN :: SysConfig
withOutputPLAIN                 = Selector XIOSysState XIOXoutConfig -> XIOXoutConfig -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState XIOXoutConfig
theOutputFmt XIOXoutConfig
PLAINoutput

withXmlPi                       :: Bool -> SysConfig
withXmlPi :: Bool -> SysConfig
withXmlPi                       = Selector XIOSysState Bool -> Bool -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState Bool
theXmlPi

withNoEmptyElemFor              :: [String] -> SysConfig
withNoEmptyElemFor :: [String] -> SysConfig
withNoEmptyElemFor              = Selector XIOSysState [String] -> [String] -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState [String]
theNoEmptyElemFor

withAddDefaultDTD               :: Bool -> SysConfig
withAddDefaultDTD :: Bool -> SysConfig
withAddDefaultDTD               = Selector XIOSysState Bool -> Bool -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState Bool
theAddDefaultDTD

withTextMode                    :: Bool -> SysConfig
withTextMode :: Bool -> SysConfig
withTextMode                    = Selector XIOSysState Bool -> Bool -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState Bool
theTextMode

withShowTree                    :: Bool -> SysConfig
withShowTree :: Bool -> SysConfig
withShowTree                    = Selector XIOSysState Bool -> Bool -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState Bool
theShowTree

withShowHaskell                 :: Bool -> SysConfig
withShowHaskell :: Bool -> SysConfig
withShowHaskell                 = Selector XIOSysState Bool -> Bool -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState Bool
theShowHaskell

-- | Configure compression and decompression for binary serialization/deserialization.
-- First component is the compression function applied after serialization,
-- second the decompression applied before deserialization.

withCompression                 :: (CompressionFct, DeCompressionFct) -> SysConfig
withCompression :: (CompressionFct, CompressionFct) -> SysConfig
withCompression                 = Selector XIOSysState (CompressionFct, CompressionFct)
-> (CompressionFct, CompressionFct) -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS (Selector XIOSysState CompressionFct
theBinaryCompression Selector XIOSysState CompressionFct
-> Selector XIOSysState CompressionFct
-> Selector XIOSysState (CompressionFct, CompressionFct)
forall s a b. Selector s a -> Selector s b -> Selector s (a, b)
.&&&. Selector XIOSysState CompressionFct
theBinaryDeCompression)

-- | Strict input for deserialization of binary data

withStrictDeserialize           :: Bool -> SysConfig
withStrictDeserialize :: Bool -> SysConfig
withStrictDeserialize           = Selector XIOSysState Bool -> Bool -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState Bool
theStrictDeserialize

-- ------------------------------------------------------------

yes                             :: Bool
yes :: Bool
yes                             = Bool
True

no                              :: Bool
no :: Bool
no                              = Bool
False

-- ------------------------------------------------------------