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

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

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

       the trace arrows

    -}

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

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

    import Control.Arrow                            -- arrow classes
    import Control.Arrow.ArrowList
    import Control.Arrow.ArrowIf
    import Control.Arrow.ArrowTree
    import Control.Arrow.ArrowIO

    import System.IO                        ( hPutStrLn
                                            , hFlush
                                            , stderr
                                            )

    import Text.XML.HXT.DOM.Interface

    import Text.XML.HXT.Arrow.XmlArrow
    import Text.XML.HXT.Arrow.XmlState.TypeDefs
    import Text.XML.HXT.Arrow.XmlState.SystemConfig

    import Text.XML.HXT.Arrow.Edit          ( addHeadlineToXmlDoc
                                            , treeRepOfXmlDoc
                                            , indentDoc
                                            )

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

    -- | set the global trace level

    setTraceLevel           :: Int -> IOStateArrow s b b
    setTraceLevel :: Int -> IOStateArrow s b b
    setTraceLevel l :: Int
    l         = SysConfig -> IOStateArrow s b b
    forall s c. SysConfig -> IOStateArrow s c c
    configSysVar (SysConfig -> IOStateArrow s b b)
    -> SysConfig -> IOStateArrow s b b
    forall a b. (a -> b) -> a -> b
    $ Int -> SysConfig
    withTrace Int
    l

    -- | read the global trace level

    getTraceLevel           :: IOStateArrow s b Int
    getTraceLevel :: IOStateArrow s b Int
    getTraceLevel           = Selector XIOSysState Int -> IOStateArrow s b Int
    forall c s b. Selector XIOSysState c -> IOStateArrow s b c
    getSysVar Selector XIOSysState Int
    theTraceLevel

    -- | set the global trace command. This command does the trace output

    setTraceCmd             :: (Int -> String -> IO ()) -> IOStateArrow s b b
    setTraceCmd :: (Int -> String -> IO ()) -> IOStateArrow s b b
    setTraceCmd c :: Int -> String -> IO ()
    c           = SysConfig -> IOStateArrow s b b
    forall s c. SysConfig -> IOStateArrow s c c
    configSysVar (SysConfig -> IOStateArrow s b b)
    -> SysConfig -> IOStateArrow s b b
    forall a b. (a -> b) -> a -> b
    $ Selector XIOSysState (Int -> String -> IO ())
    -> (Int -> String -> IO ()) -> SysConfig
    forall s a. Selector s a -> a -> s -> s
    setS Selector XIOSysState (Int -> String -> IO ())
    theTraceCmd Int -> String -> IO ()
    c

    -- | acces the command for trace output

    getTraceCmd             :: IOStateArrow a b (Int -> String -> IO ())
    getTraceCmd :: IOStateArrow a b (Int -> String -> IO ())
    getTraceCmd             = Selector XIOSysState (Int -> String -> IO ())
    -> IOStateArrow a b (Int -> String -> IO ())
    forall c s b. Selector XIOSysState c -> IOStateArrow s b c
    getSysVar Selector XIOSysState (Int -> String -> IO ())
    theTraceCmd

    -- | run an arrow with a given trace level, the old trace level is restored after the arrow execution

    withTraceLevel          :: Int -> IOStateArrow s b c -> IOStateArrow s b c
    withTraceLevel :: Int -> IOStateArrow s b c -> IOStateArrow s b c
    withTraceLevel level :: Int
    level f :: IOStateArrow s b c
    f  = IOStateArrow s b c -> IOStateArrow s b c
    forall s a b. IOStateArrow s a b -> IOStateArrow s a b
    localSysEnv (IOStateArrow s b c -> IOStateArrow s b c)
    -> IOStateArrow s b c -> IOStateArrow s b c
    forall a b. (a -> b) -> a -> b
    $ Int -> IOStateArrow s b b
    forall s b. Int -> IOStateArrow s b b
    setTraceLevel Int
    level IOStateArrow s b b -> IOStateArrow s b c -> IOStateArrow s b c
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> IOStateArrow s b c
    f

    -- | apply a trace arrow and issue message to stderr

    trace                   :: Int -> IOStateArrow s b String -> IOStateArrow s b b
    trace :: Int -> IOStateArrow s b String -> IOStateArrow s b b
    trace level :: Int
    level trc :: IOStateArrow s b String
    trc         = IOSLA (XIOState s) b () -> IOStateArrow s b b
    forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b b
    perform ( IOStateArrow s b String
    trc
                                        IOStateArrow s b String
    -> IOSLA (XIOState s) String () -> IOSLA (XIOState s) b ()
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                                        ( IOStateArrow s String (Int -> String -> IO ())
    forall a b. IOStateArrow a b (Int -> String -> IO ())
    getTraceCmd IOStateArrow s String (Int -> String -> IO ())
    -> IOSLA (XIOState s) String String
    -> IOSLA (XIOState s) String (Int -> String -> IO (), String)
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& IOSLA (XIOState s) String String
    forall (a :: * -> * -> *) b. ArrowList a => a b b
    this )
                                        IOSLA (XIOState s) String (Int -> String -> IO (), String)
    -> IOSLA (XIOState s) (Int -> String -> IO (), String) ()
    -> IOSLA (XIOState s) String ()
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                                        ((Int -> String -> IO (), String) -> IO ())
    -> IOSLA (XIOState s) (Int -> String -> IO (), String) ()
    forall (a :: * -> * -> *) b c. ArrowIO a => (b -> IO c) -> a b c
    arrIO (\ (cmd :: Int -> String -> IO ()
    cmd, msg :: String
    msg) -> Int -> String -> IO ()
    cmd Int
    level String
    msg)
                                      )
                              IOStateArrow s b b
    -> IOSLA (XIOState s) b Int -> IOStateArrow s b b
    forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
    `when` ( IOSLA (XIOState s) b Int
    forall s b. IOStateArrow s b Int
    getTraceLevel
                                       IOSLA (XIOState s) b Int
    -> IOSLA (XIOState s) Int Int -> IOSLA (XIOState s) b Int
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                                       (Int -> Bool) -> IOSLA (XIOState s) Int Int
    forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
    isA (Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    level)
                                     )

    -- | trace the current value transfered in a sequence of arrows.
    --
    -- The value is formated by a string conversion function. This is a substitute for
    -- the old and less general traceString function

    traceValue              :: Int -> (b -> String) -> IOStateArrow s b b
    traceValue :: Int -> (b -> String) -> IOStateArrow s b b
    traceValue level :: Int
    level trc :: b -> String
    trc    = Int -> IOStateArrow s b String -> IOStateArrow s b b
    forall s b. Int -> IOStateArrow s b String -> IOStateArrow s b b
    trace Int
    level ((b -> String) -> IOStateArrow s b String
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr ((b -> String) -> IOStateArrow s b String)
    -> (b -> String) -> IOStateArrow s b String
    forall a b. (a -> b) -> a -> b
    $ (('-' Char -> String -> String
    forall a. a -> [a] -> [a]
    : "- (" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    level String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ") ") String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++) (String -> String) -> (b -> String) -> b -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . b -> String
    trc)

    -- | an old alias for 'traceValue'

    traceString             :: Int -> (b -> String) -> IOStateArrow s b b
    traceString :: Int -> (b -> String) -> IOStateArrow s b b
    traceString             = Int -> (b -> String) -> IOStateArrow s b b
    forall b s. Int -> (b -> String) -> IOStateArrow s b b
    traceValue

    -- | issue a string message as trace

    traceMsg                :: Int -> String -> IOStateArrow s b b
    traceMsg :: Int -> String -> IOStateArrow s b b
    traceMsg level :: Int
    level msg :: String
    msg      = Int -> (b -> String) -> IOStateArrow s b b
    forall b s. Int -> (b -> String) -> IOStateArrow s b b
    traceValue Int
    level (String -> b -> String
    forall a b. a -> b -> a
    const String
    msg)

    -- | issue the source representation of a document if trace level >= 3
    --
    -- for better readability the source is formated with indentDoc

    traceSource             :: IOStateArrow s XmlTree XmlTree
    traceSource :: IOStateArrow s XmlTree XmlTree
    traceSource             = Int
    -> IOStateArrow s XmlTree String -> IOStateArrow s XmlTree XmlTree
    forall s b. Int -> IOStateArrow s b String -> IOStateArrow s b b
    trace 3 (IOStateArrow s XmlTree String -> IOStateArrow s XmlTree XmlTree)
    -> IOStateArrow s XmlTree String -> IOStateArrow s XmlTree XmlTree
    forall a b. (a -> b) -> a -> b
    $
                              IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree String
    forall (a :: * -> * -> *) n.
    ArrowXml a =>
    a n XmlTree -> a n String
    xshow (IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree String)
    -> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree String
    forall a b. (a -> b) -> a -> b
    $
                              [IfThen
       (IOStateArrow s XmlTree XmlTree) (IOStateArrow s XmlTree XmlTree)]
    -> IOStateArrow s XmlTree XmlTree
    forall (a :: * -> * -> *) b c d.
    ArrowIf a =>
    [IfThen (a b c) (a b d)] -> a b d
    choiceA [ IOStateArrow s XmlTree XmlTree
    forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
    isRoot IOStateArrow s XmlTree XmlTree
    -> IOStateArrow s XmlTree XmlTree
    -> IfThen
         (IOStateArrow s XmlTree XmlTree) (IOStateArrow s XmlTree XmlTree)
    forall a b. a -> b -> IfThen a b
    :-> ( IOStateArrow s XmlTree XmlTree
    forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
    indentDoc
                                                     IOStateArrow s XmlTree XmlTree
    -> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                                                     IOStateArrow s XmlTree XmlTree
    forall (a :: * -> * -> *) (t :: * -> *) b.
    (ArrowTree a, Tree t) =>
    a (t b) (t b)
    getChildren
                                                   )
                                      , IOStateArrow s XmlTree XmlTree
    forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
    isElem IOStateArrow s XmlTree XmlTree
    -> IOStateArrow s XmlTree XmlTree
    -> IfThen
         (IOStateArrow s XmlTree XmlTree) (IOStateArrow s XmlTree XmlTree)
    forall a b. a -> b -> IfThen a b
    :-> ( [IOStateArrow s XmlTree XmlTree]
    -> [IOStateArrow s XmlTree XmlTree]
    -> IOStateArrow s XmlTree XmlTree
    forall (a :: * -> * -> *) n.
    ArrowXml a =>
    [a n XmlTree] -> [a n XmlTree] -> a n XmlTree
    root [] [IOStateArrow s XmlTree XmlTree
    forall (a :: * -> * -> *) b. ArrowList a => a b b
    this]
                                                     IOStateArrow s XmlTree XmlTree
    -> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> IOStateArrow s XmlTree XmlTree
    forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
    indentDoc
                                                     IOStateArrow s XmlTree XmlTree
    -> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> IOStateArrow s XmlTree XmlTree
    forall (a :: * -> * -> *) (t :: * -> *) b.
    (ArrowTree a, Tree t) =>
    a (t b) (t b)
    getChildren
                                                     IOStateArrow s XmlTree XmlTree
    -> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> IOStateArrow s XmlTree XmlTree
    forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
    isElem
                                                   )
                                      , IOStateArrow s XmlTree XmlTree
    forall (a :: * -> * -> *) b. ArrowList a => a b b
    this   IOStateArrow s XmlTree XmlTree
    -> IOStateArrow s XmlTree XmlTree
    -> IfThen
         (IOStateArrow s XmlTree XmlTree) (IOStateArrow s XmlTree XmlTree)
    forall a b. a -> b -> IfThen a b
    :-> IOStateArrow s XmlTree XmlTree
    forall (a :: * -> * -> *) b. ArrowList a => a b b
    this
                                      ]

    -- | issue the tree representation of a document if trace level >= 4
    traceTree               :: IOStateArrow s XmlTree XmlTree
    traceTree :: IOStateArrow s XmlTree XmlTree
    traceTree               = Int
    -> IOStateArrow s XmlTree String -> IOStateArrow s XmlTree XmlTree
    forall s b. Int -> IOStateArrow s b String -> IOStateArrow s b b
    trace 4 (IOStateArrow s XmlTree String -> IOStateArrow s XmlTree XmlTree)
    -> IOStateArrow s XmlTree String -> IOStateArrow s XmlTree XmlTree
    forall a b. (a -> b) -> a -> b
    $
                              IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree String
    forall (a :: * -> * -> *) n.
    ArrowXml a =>
    a n XmlTree -> a n String
    xshow (IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree String)
    -> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree String
    forall a b. (a -> b) -> a -> b
    $
                              IOStateArrow s XmlTree XmlTree
    forall (a :: * -> * -> *). ArrowList a => a XmlTree XmlTree
    treeRepOfXmlDoc
                              IOStateArrow s XmlTree XmlTree
    -> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                              IOStateArrow s XmlTree XmlTree
    forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
    addHeadlineToXmlDoc
                              IOStateArrow s XmlTree XmlTree
    -> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                              IOStateArrow s XmlTree XmlTree
    forall (a :: * -> * -> *) (t :: * -> *) b.
    (ArrowTree a, Tree t) =>
    a (t b) (t b)
    getChildren

    -- | trace a main computation step
    -- issue a message when trace level >= 1, issue document source if level >= 3, issue tree when level is >= 4

    traceDoc                :: String -> IOStateArrow s XmlTree XmlTree
    traceDoc :: String -> IOStateArrow s XmlTree XmlTree
    traceDoc msg :: String
    msg            = Int -> String -> IOStateArrow s XmlTree XmlTree
    forall s b. Int -> String -> IOStateArrow s b b
    traceMsg 1 String
    msg
                              IOStateArrow s XmlTree XmlTree
    -> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                              IOStateArrow s XmlTree XmlTree
    forall s. IOStateArrow s XmlTree XmlTree
    traceSource
                              IOStateArrow s XmlTree XmlTree
    -> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                              IOStateArrow s XmlTree XmlTree
    forall s. IOStateArrow s XmlTree XmlTree
    traceTree

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

    traceOutputToStderr     :: Int -> String -> IO ()
    traceOutputToStderr :: Int -> String -> IO ()
    traceOutputToStderr _level :: Int
    _level msg :: String
    msg
                            = do
                              Handle -> String -> IO ()
    hPutStrLn Handle
    stderr String
    msg
                              Handle -> IO ()
    hFlush Handle
    stderr

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