module Text.XML.HXT.Arrow.WriteDocument
( writeDocument
, writeDocument'
, writeDocumentToString
, prepareContents
)
where
import Control.Arrow
import Control.Arrow.ArrowList
import Control.Arrow.ArrowIf
import Control.Arrow.ArrowTree
import Text.XML.HXT.DOM.Interface
import Text.XML.HXT.Arrow.XmlArrow
import Text.XML.HXT.Arrow.XmlState
import Text.XML.HXT.Arrow.XmlState.TypeDefs
import Text.XML.HXT.Arrow.XmlState.RunIOStateArrow
( initialSysState
)
import Text.XML.HXT.Arrow.Edit ( haskellRepOfXmlDoc
, indentDoc
, addDefaultDTDecl
, preventEmptyElements
, removeDocWhiteSpace
, treeRepOfXmlDoc
)
import Text.XML.HXT.Arrow.DocumentOutput ( putXmlDocument
, encodeDocument
, encodeDocument'
)
writeDocument :: SysConfigList -> String -> IOStateArrow s XmlTree XmlTree
writeDocument :: forall s. SysConfigList -> String -> IOStateArrow s XmlTree XmlTree
writeDocument SysConfigList
config String
dst
= forall s a b. IOStateArrow s a b -> IOStateArrow s a b
localSysEnv
forall a b. (a -> b) -> a -> b
$
forall s c. SysConfigList -> IOStateArrow s c c
configSysVars SysConfigList
config
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. ArrowList a => a b c -> a b b
perform ( (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s. Bool -> String -> IOStateArrow s XmlTree XmlTree
writeDocument') String
dst forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< forall c s b. Selector XIOSysState c -> IOStateArrow s b c
getSysVar Selector XIOSysState Bool
theTextMode )
writeDocument' :: Bool -> String -> IOStateArrow s XmlTree XmlTree
writeDocument' :: forall s. Bool -> String -> IOStateArrow s XmlTree XmlTree
writeDocument' Bool
textMode String
dst
= ( forall s b. Int -> String -> IOStateArrow s b b
traceMsg Int
1 (String
"writeDocument: destination is " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
dst)
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. (a -> b -> c) -> b -> a -> c
flip forall (a :: * -> * -> *).
ArrowXml a =>
XIOSysState
-> (Bool -> Bool -> String -> a XmlTree XmlTree)
-> a XmlTree XmlTree
prepareContents) forall s. Bool -> Bool -> String -> IOStateArrow s XmlTree XmlTree
encodeDocument forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< forall c s b. Selector XIOSysState c -> IOStateArrow s b c
getSysVar forall s. Selector s s
idS )
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
forall s. String -> IOStateArrow s XmlTree XmlTree
traceDoc String
"document after encoding"
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
forall s. Bool -> String -> IOStateArrow s XmlTree XmlTree
putXmlDocument Bool
textMode String
dst
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
forall s b. Int -> String -> IOStateArrow s b b
traceMsg Int
1 String
"writeDocument: finished"
)
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
documentStatusOk
writeDocumentToString :: ArrowXml a => SysConfigList -> a XmlTree String
writeDocumentToString :: forall (a :: * -> * -> *).
ArrowXml a =>
SysConfigList -> a XmlTree String
writeDocumentToString SysConfigList
config
= forall (a :: * -> * -> *).
ArrowXml a =>
XIOSysState
-> (Bool -> Bool -> String -> a XmlTree XmlTree)
-> a XmlTree XmlTree
prepareContents ( forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
(>>>) forall a. a -> a
id (String -> SysConfig
withOutputEncoding String
unicodeString forall a. a -> [a] -> [a]
:
Bool -> SysConfig
withXmlPi Bool
no forall a. a -> [a] -> [a]
:
SysConfigList
config
)
forall a b. (a -> b) -> a -> b
$ XIOSysState
initialSysState
) forall (a :: * -> * -> *).
ArrowXml a =>
Bool -> Bool -> String -> a XmlTree XmlTree
encodeDocument'
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n String
xshow forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
prepareContents :: ArrowXml a => XIOSysState -> (Bool -> Bool -> String -> a XmlTree XmlTree) -> a XmlTree XmlTree
prepareContents :: forall (a :: * -> * -> *).
ArrowXml a =>
XIOSysState
-> (Bool -> Bool -> String -> a XmlTree XmlTree)
-> a XmlTree XmlTree
prepareContents XIOSysState
config Bool -> Bool -> String -> a XmlTree XmlTree
encodeDoc
= a XmlTree XmlTree
indent
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
a XmlTree XmlTree
addDtd
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
a XmlTree XmlTree
format
where
indent' :: Bool
indent' = forall s a. Selector s a -> s -> a
getS Selector XIOSysState Bool
theIndent XIOSysState
config
removeWS' :: Bool
removeWS' = forall s a. Selector s a -> s -> a
getS Selector XIOSysState Bool
theRemoveWS XIOSysState
config
showTree' :: Bool
showTree' = forall s a. Selector s a -> s -> a
getS Selector XIOSysState Bool
theShowTree XIOSysState
config
showHaskell' :: Bool
showHaskell' = forall s a. Selector s a -> s -> a
getS Selector XIOSysState Bool
theShowHaskell XIOSysState
config
outHtml' :: Bool
outHtml' = forall s a. Selector s a -> s -> a
getS Selector XIOSysState XIOXoutConfig
theOutputFmt XIOSysState
config forall a. Eq a => a -> a -> Bool
== XIOXoutConfig
HTMLoutput
outXhtml' :: Bool
outXhtml' = forall s a. Selector s a -> s -> a
getS Selector XIOSysState XIOXoutConfig
theOutputFmt XIOSysState
config forall a. Eq a => a -> a -> Bool
== XIOXoutConfig
XHTMLoutput
outXml' :: Bool
outXml' = forall s a. Selector s a -> s -> a
getS Selector XIOSysState XIOXoutConfig
theOutputFmt XIOSysState
config forall a. Eq a => a -> a -> Bool
== XIOXoutConfig
XMLoutput
noPi' :: Bool
noPi' = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall s a. Selector s a -> s -> a
getS Selector XIOSysState Bool
theXmlPi XIOSysState
config
noEEsFor' :: [String]
noEEsFor' = forall s a. Selector s a -> s -> a
getS Selector XIOSysState [String]
theNoEmptyElemFor XIOSysState
config
addDDTD' :: Bool
addDDTD' = forall s a. Selector s a -> s -> a
getS Selector XIOSysState Bool
theAddDefaultDTD XIOSysState
config
outEnc' :: String
outEnc' = forall s a. Selector s a -> s -> a
getS Selector XIOSysState String
theOutputEncoding XIOSysState
config
addDtd :: a XmlTree XmlTree
addDtd
| Bool
addDDTD' = forall (a :: * -> * -> *). ArrowList a => a XmlTree XmlTree
addDefaultDTDecl
| Bool
otherwise = forall (a :: * -> * -> *) b. ArrowList a => a b b
this
indent :: a XmlTree XmlTree
indent
| Bool
indent' = forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
indentDoc
| Bool
removeWS' = forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
removeDocWhiteSpace
| Bool
otherwise = forall (a :: * -> * -> *) b. ArrowList a => a b b
this
format :: a XmlTree XmlTree
format
| Bool
showTree' = forall (a :: * -> * -> *). ArrowList a => a XmlTree XmlTree
treeRepOfXmlDoc
| Bool
showHaskell' = forall (a :: * -> * -> *). ArrowList a => a XmlTree XmlTree
haskellRepOfXmlDoc
| Bool
outHtml' = forall (a :: * -> * -> *).
ArrowList a =>
[String] -> Bool -> a XmlTree XmlTree
preventEmptyElements [String]
noEEsFor' Bool
True
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
Bool -> Bool -> String -> a XmlTree XmlTree
encodeDoc
Bool
False Bool
noPi' ( if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
outEnc' then String
usAscii else String
outEnc' )
| Bool
outXhtml' = forall (a :: * -> * -> *).
ArrowList a =>
[String] -> Bool -> a XmlTree XmlTree
preventEmptyElements [String]
noEEsFor' Bool
True
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
Bool -> Bool -> String -> a XmlTree XmlTree
encodeDoc
Bool
True Bool
noPi' String
outEnc'
| Bool
outXml' = ( if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
noEEsFor'
then forall (a :: * -> * -> *) b. ArrowList a => a b b
this
else forall (a :: * -> * -> *).
ArrowList a =>
[String] -> Bool -> a XmlTree XmlTree
preventEmptyElements [String]
noEEsFor' Bool
False
)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
Bool -> Bool -> String -> a XmlTree XmlTree
encodeDoc
Bool
True Bool
noPi' String
outEnc'
| Bool
otherwise = forall (a :: * -> * -> *) b. ArrowList a => a b b
this