module Text.XML.HXT.Arrow.XmlState.TraceHandling
where
import Control.Arrow
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
)
setTraceLevel :: Int -> IOStateArrow s b b
setTraceLevel :: forall s b. Int -> IOStateArrow s b b
setTraceLevel Int
l = forall s c. SysConfig -> IOStateArrow s c c
configSysVar forall a b. (a -> b) -> a -> b
$ Int -> SysConfig
withTrace Int
l
getTraceLevel :: IOStateArrow s b Int
getTraceLevel :: forall s b. IOStateArrow s b Int
getTraceLevel = forall c s b. Selector XIOSysState c -> IOStateArrow s b c
getSysVar Selector XIOSysState Int
theTraceLevel
setTraceCmd :: (Int -> String -> IO ()) -> IOStateArrow s b b
setTraceCmd :: forall s b. (Int -> String -> IO ()) -> IOStateArrow s b b
setTraceCmd Int -> String -> IO ()
c = forall s c. SysConfig -> IOStateArrow s c c
configSysVar forall a b. (a -> b) -> a -> b
$ forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState (Int -> String -> IO ())
theTraceCmd Int -> String -> IO ()
c
getTraceCmd :: IOStateArrow a b (Int -> String -> IO ())
getTraceCmd :: forall a b. IOStateArrow a b (Int -> String -> IO ())
getTraceCmd = forall c s b. Selector XIOSysState c -> IOStateArrow s b c
getSysVar Selector XIOSysState (Int -> String -> IO ())
theTraceCmd
withTraceLevel :: Int -> IOStateArrow s b c -> IOStateArrow s b c
withTraceLevel :: forall s b c. Int -> IOStateArrow s b c -> IOStateArrow s b c
withTraceLevel Int
level IOStateArrow s b c
f = forall s a b. IOStateArrow s a b -> IOStateArrow s a b
localSysEnv forall a b. (a -> b) -> a -> b
$ forall s b. Int -> IOStateArrow s b b
setTraceLevel Int
level 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
trace :: Int -> IOStateArrow s b String -> IOStateArrow s b b
trace :: forall s b. Int -> IOStateArrow s b String -> IOStateArrow s b b
trace Int
level IOStateArrow s b String
trc = forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b b
perform ( IOStateArrow s b String
trc
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
( forall a b. IOStateArrow a b (Int -> String -> IO ())
getTraceCmd forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall (a :: * -> * -> *) b. ArrowList a => a b b
this )
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
forall (a :: * -> * -> *) b c. ArrowIO a => (b -> IO c) -> a b c
arrIO (\ (Int -> String -> IO ()
cmd, String
msg) -> Int -> String -> IO ()
cmd Int
level String
msg)
)
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` ( forall s b. IOStateArrow s b Int
getTraceLevel
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (forall a. Ord a => a -> a -> Bool
>= Int
level)
)
traceValue :: Int -> (b -> String) -> IOStateArrow s b b
traceValue :: forall b s. Int -> (b -> String) -> IOStateArrow s b b
traceValue Int
level b -> String
trc = forall s b. Int -> IOStateArrow s b String -> IOStateArrow s b b
trace Int
level (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a b. (a -> b) -> a -> b
$ ((Char
'-' forall a. a -> [a] -> [a]
: String
"- (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
level forall a. [a] -> [a] -> [a]
++ String
") ") forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> String
trc)
traceString :: Int -> (b -> String) -> IOStateArrow s b b
traceString :: forall b s. Int -> (b -> String) -> IOStateArrow s b b
traceString = forall b s. Int -> (b -> String) -> IOStateArrow s b b
traceValue
traceMsg :: Int -> String -> IOStateArrow s b b
traceMsg :: forall s b. Int -> String -> IOStateArrow s b b
traceMsg Int
level String
msg = forall b s. Int -> (b -> String) -> IOStateArrow s b b
traceValue Int
level (forall a b. a -> b -> a
const String
msg)
traceSource :: IOStateArrow s XmlTree XmlTree
traceSource :: forall s. IOStateArrow s XmlTree XmlTree
traceSource = forall s b. Int -> IOStateArrow s b String -> IOStateArrow s b b
trace Int
3 forall a b. (a -> b) -> a -> b
$
forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n String
xshow forall a b. (a -> b) -> a -> b
$
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA [ forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRoot forall a b. a -> b -> IfThen a b
:-> ( forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
indentDoc
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
)
, forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isElem forall a b. a -> b -> IfThen a b
:-> ( forall (a :: * -> * -> *) n.
ArrowXml a =>
[a n XmlTree] -> [a n XmlTree] -> a n XmlTree
root [] [forall (a :: * -> * -> *) b. ArrowList a => a b b
this]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
indentDoc
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isElem
)
, forall (a :: * -> * -> *) b. ArrowList a => a b b
this forall a b. a -> b -> IfThen a b
:-> forall (a :: * -> * -> *) b. ArrowList a => a b b
this
]
traceTree :: IOStateArrow s XmlTree XmlTree
traceTree :: forall s. IOStateArrow s XmlTree XmlTree
traceTree = forall s b. Int -> IOStateArrow s b String -> IOStateArrow s b b
trace Int
4 forall a b. (a -> b) -> a -> b
$
forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n String
xshow forall a b. (a -> b) -> a -> b
$
forall (a :: * -> * -> *). ArrowList a => a XmlTree XmlTree
treeRepOfXmlDoc
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
addHeadlineToXmlDoc
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
traceDoc :: String -> IOStateArrow s XmlTree XmlTree
traceDoc :: forall s. String -> IOStateArrow s XmlTree XmlTree
traceDoc String
msg = forall s b. Int -> String -> IOStateArrow s b b
traceMsg Int
1 String
msg
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
forall s. IOStateArrow s XmlTree XmlTree
traceSource
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
forall s. IOStateArrow s XmlTree XmlTree
traceTree
traceOutputToStderr :: Int -> String -> IO ()
traceOutputToStderr :: Int -> String -> IO ()
traceOutputToStderr Int
_level String
msg
= do
Handle -> String -> IO ()
hPutStrLn Handle
stderr String
msg
Handle -> IO ()
hFlush Handle
stderr