module Text.XML.HXT.Arrow.Pickle
( xpickleDocument
, xunpickleDocument
, xpickleWriteDTD
, xpickleDTD
, checkPickler
, xpickleVal
, xunpickleVal
, thePicklerDTD
, a_addDTD
, pickleDoc
, unpickleDoc
, unpickleDoc'
, showPickled
, PU(..)
, XmlPickler(..)
, xp4Tuple
, xp5Tuple
, xp6Tuple
, xp7Tuple
, xp8Tuple
, xp9Tuple
, xp10Tuple
, xp11Tuple
, xp12Tuple
, xp13Tuple
, xp14Tuple
, xp15Tuple
, xp16Tuple
, xp17Tuple
, xp18Tuple
, xp19Tuple
, xp20Tuple
, xp21Tuple
, xp22Tuple
, xp23Tuple
, xp24Tuple
, xpAddFixedAttr
, xpAddNSDecl
, xpAlt
, xpAttr
, xpAttrFixed
, xpAttrImplied
, xpAttrNS
, xpCheckEmpty
, xpCheckEmptyAttributes
, xpCheckEmptyContents
, xpTextAttr
, xpChoice
, xpDefault
, xpElem
, xpElemNS
, xpElemWithAttrValue
, xpFilterAttr
, xpFilterCont
, xpInt
, xpLift
, xpLiftEither
, xpLiftMaybe
, xpList
, xpList1
, xpMap
, xpOption
, xpPair
, xpPrim
, xpSeq
, xpSeq'
, xpText
, xpText0
, xpTextDT
, xpText0DT
, xpTree
, xpTrees
, xpTriple
, xpUnit
, xpWrap
, xpWrapEither
, xpWrapMaybe
, xpXmlText
, xpZero
, Schema
, Schemas
, DataTypeDescr
)
where
import Control.Arrow.ListArrows
import Text.XML.HXT.DOM.Interface
import Text.XML.HXT.Arrow.ReadDocument
import Text.XML.HXT.Arrow.WriteDocument
import Text.XML.HXT.Arrow.XmlArrow
import Text.XML.HXT.Arrow.XmlState
import Text.XML.HXT.Arrow.XmlState.TypeDefs
import Text.XML.HXT.Arrow.Pickle.Xml
import Text.XML.HXT.Arrow.Pickle.Schema
import Text.XML.HXT.Arrow.Pickle.DTD
xpickleDocument :: PU a -> SysConfigList -> String -> IOStateArrow s a XmlTree
xpickleDocument :: forall a s.
PU a -> SysConfigList -> String -> IOStateArrow s a XmlTree
xpickleDocument PU a
xp SysConfigList
config String
dest
= 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. ArrowXml a => PU b -> a b XmlTree
xpickleVal PU a
xp
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
"xpickleVal applied"
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 d.
ArrowIf a =>
a b c -> a b d -> a b d -> a b d
ifA ( forall s b. String -> IOStateArrow s b String
getSysAttr String
a_addDTD 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. Eq a => a -> a -> Bool
== String
v_1) )
( forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren ( (forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA forall a. HasCallStack => a
undefined forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall b s. PU b -> IOStateArrow s b XmlTree
xpickleDTD PU a
xp 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 :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
)
)
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 s. SysConfigList -> String -> IOStateArrow s XmlTree XmlTree
writeDocument [] String
dest
a_addDTD :: String
a_addDTD :: String
a_addDTD = String
"addDTD"
xunpickleDocument :: PU a -> SysConfigList -> String -> IOStateArrow s b a
xunpickleDocument :: forall a s b. PU a -> SysConfigList -> String -> IOStateArrow s b a
xunpickleDocument PU a
xp SysConfigList
conf String
src
= forall s b. SysConfigList -> String -> IOStateArrow s b XmlTree
readDocument SysConfigList
conf String
src
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
"xunpickleVal for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
src forall a. [a] -> [a] -> [a]
++ String
" started")
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
forall b s. PU b -> IOStateArrow s XmlTree b
xunpickleVal PU a
xp
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
"xunpickleVal for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
src forall a. [a] -> [a] -> [a]
++ String
" finished")
xpickleWriteDTD :: PU b -> SysConfigList -> String -> IOStateArrow s b XmlTree
xpickleWriteDTD :: forall a s.
PU a -> SysConfigList -> String -> IOStateArrow s a XmlTree
xpickleWriteDTD PU b
xp SysConfigList
config String
dest
= forall b s. PU b -> IOStateArrow s b XmlTree
xpickleDTD PU b
xp
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
forall s. SysConfigList -> String -> IOStateArrow s XmlTree XmlTree
writeDocument SysConfigList
config String
dest
xpickleDTD :: PU b -> IOStateArrow s b XmlTree
xpickleDTD :: forall b s. PU b -> IOStateArrow s b XmlTree
xpickleDTD PU b
xp = forall (a :: * -> * -> *) n.
ArrowXml a =>
[a n XmlTree] -> [a n XmlTree] -> a n XmlTree
root [] [ forall (a :: * -> * -> *) c b. ArrowList a => [c] -> a b c
constL (forall b. PU b -> XmlTrees
thePicklerDTD PU b
xp)
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
filterErrorMsg
]
checkPickler :: Eq a => PU a -> IOStateArrow s a a
checkPickler :: forall a s. Eq a => PU a -> IOStateArrow s a a
checkPickler PU a
xp = ( ( ( ( forall (a :: * -> * -> *) b. ArrowXml a => PU b -> a b XmlTree
xpickleVal PU a
xp
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) -> a (t b) (t b)
replaceChildren ( (forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA forall a. HasCallStack => a
undefined forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall b s. PU b -> IOStateArrow s b XmlTree
xpickleDTD PU a
xp 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 :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b 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 =>
SysConfigList -> a XmlTree String
writeDocumentToString []
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
forall s. SysConfigList -> IOStateArrow s String XmlTree
readFromString [Bool -> SysConfig
withValidate Bool
True]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
forall b s. PU b -> IOStateArrow s XmlTree b
xunpickleVal PU a
xp
)
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. ArrowList a => (b -> Bool) -> a b b
isA (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Eq a => a -> a -> Bool
(==))
)
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards` forall (a :: * -> * -> *) b. ArrowList a => a b b
this
)
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse` forall s b. String -> IOStateArrow s b b
issueErr String
"pickle/unpickle combinators failed"
xpickleVal :: ArrowXml a => PU b -> a b XmlTree
xpickleVal :: forall (a :: * -> * -> *) b. ArrowXml a => PU b -> a b XmlTree
xpickleVal PU b
xp = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall a. PU a -> a -> XmlTree
pickleDoc PU b
xp)
xunpickleVal :: PU b -> IOStateArrow s XmlTree b
xunpickleVal :: forall b s. PU b -> IOStateArrow s XmlTree b
xunpickleVal PU b
xp = ( forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren (forall (a :: * -> * -> *) b c. ArrowList a => a b c
none forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`whenNot` forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isElem)
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRoot
)
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. Arrow a => (b -> c) -> a b c
arr (forall a. PU a -> XmlTree -> Either String a
unpickleDoc' PU b
xp)
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. String -> IOStateArrow s b b
issueFatal forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (String
"document unpickling failed\n" forall a. [a] -> [a] -> [a]
++))
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
none
)
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
|||
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
)
thePicklerDTD :: PU b -> XmlTrees
thePicklerDTD :: forall b. PU b -> XmlTrees
thePicklerDTD = DTDdescr -> XmlTrees
dtdDescrToXml forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> DTDdescr
dtdDescr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PU a -> Schema
theSchema