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

{- |
   Module     : Text.XML.HXT.Arrow.Pickle
   Copyright  : Copyright (C) 2005 Uwe Schmidt
   License    : MIT

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

Pickler functions for converting between user defined data types
and XmlTree data. Usefull for persistent storage and retreival
of arbitray data as XML documents

This module is an adaptation of the pickler combinators
developed by Andrew Kennedy
( https:\/\/www.microsoft.com\/en-us\/research\/wp-content\/uploads\/2004\/01\/picklercombinators.pdf )

The difference to Kennedys approach is that the target is not
a list of Chars but a list of XmlTrees. The basic picklers will
convert data into XML text nodes. New are the picklers for
creating elements and attributes.

One extension was neccessary: The unpickling may fail.
Therefore the unpickler has a Maybe result type.
Failure is used to unpickle optional elements
(Maybe data) and lists of arbitray length

There is an example program demonstrating the use
of the picklers for a none trivial data structure.
(see \"examples\/arrows\/pickle\" directory)

-}

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

module Text.XML.HXT.Arrow.Pickle
    ( xpickleDocument            -- from this module Text.XML.HXT.Arrow.Pickle
    , xunpickleDocument
    , xpickleWriteDTD
    , xpickleDTD
    , checkPickler
    , xpickleVal
    , xunpickleVal
    , thePicklerDTD
    , a_addDTD

      -- from Text.XML.HXT.Arrow.Pickle.Xml
    , 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

      -- from Text.XML.HXT.Arrow.Pickle.Schema
    , 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

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

-- the arrow interface for pickling and unpickling

-- | store an arbitray value in a persistent XML document
--
-- The pickler converts a value into an XML tree, this is written out with
-- 'Text.XML.HXT.Arrow.writeDocument'. The option list is passed to 'Text.XML.HXT.Arrow.writeDocument'
--
-- An option evaluated by this arrow is 'a_addDTD'.
-- If 'a_addDTD' is set ('v_1'), the pickler DTD is added as an inline DTD into the document.

xpickleDocument         :: PU a -> SysConfigList -> String -> IOStateArrow s a XmlTree
xpickleDocument :: PU a -> SysConfigList -> String -> IOStateArrow s a XmlTree
xpickleDocument PU a
xp SysConfigList
config String
dest
    = IOStateArrow s a XmlTree -> IOStateArrow s a XmlTree
forall s a b. IOStateArrow s a b -> IOStateArrow s a b
localSysEnv
      (IOStateArrow s a XmlTree -> IOStateArrow s a XmlTree)
-> IOStateArrow s a XmlTree -> IOStateArrow s a XmlTree
forall a b. (a -> b) -> a -> b
$
      SysConfigList -> IOStateArrow s a a
forall s c. SysConfigList -> IOStateArrow s c c
configSysVars SysConfigList
config
      IOStateArrow s a a
-> IOStateArrow s a XmlTree -> IOStateArrow s a XmlTree
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      PU a -> IOStateArrow s a XmlTree
forall (a :: * -> * -> *) b. ArrowXml a => PU b -> a b XmlTree
xpickleVal PU a
xp
      IOStateArrow s a XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree -> IOStateArrow s a XmlTree
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      Int -> String -> IOSLA (XIOState s) XmlTree XmlTree
forall s b. Int -> String -> IOStateArrow s b b
traceMsg Int
1 String
"xpickleVal applied"
      IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState 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
>>>
      IOSLA (XIOState s) XmlTree String
-> IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d -> a b d
ifA ( String -> IOSLA (XIOState s) XmlTree String
forall s b. String -> IOStateArrow s b String
getSysAttr String
a_addDTD IOSLA (XIOState s) XmlTree String
-> IOSLA (XIOState s) String String
-> IOSLA (XIOState s) XmlTree String
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (String -> Bool) -> IOSLA (XIOState s) String String
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
v_1) )
          ( IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren ( (a -> IOSLA (XIOState s) XmlTree a
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA a
forall a. HasCallStack => a
undefined IOSLA (XIOState s) XmlTree a
-> IOStateArrow s a XmlTree -> IOSLA (XIOState 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
>>> PU a -> IOStateArrow s a XmlTree
forall b s. PU b -> IOStateArrow s b XmlTree
xpickleDTD PU a
xp IOStateArrow s a XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree -> IOStateArrow s a XmlTree
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren)
                              IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
                              IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
                            )
          )
          IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
      IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState 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
>>>
      SysConfigList -> String -> IOSLA (XIOState s) XmlTree XmlTree
forall s. SysConfigList -> String -> IOStateArrow s XmlTree XmlTree
writeDocument [] String
dest

-- | Option for generating and adding DTD when document is pickled

a_addDTD        :: String
a_addDTD :: String
a_addDTD        = String
"addDTD"

-- | read an arbitray value from an XML document
--
-- The document is read with 'Text.XML.HXT.Arrow.readDocument'. Options are passed
-- to 'Text.XML.HXT.Arrow.readDocument'. The conversion from XmlTree is done with the
-- pickler.
--
-- @ xpickleDocument xp al dest >>> xunpickleDocument xp al' dest @ is the identity arrow
-- when applied with the appropriate options. When during pickling indentation is switched on,
-- the whitespace must be removed during unpickling.

xunpickleDocument       :: PU a -> SysConfigList -> String -> IOStateArrow s b a
xunpickleDocument :: PU a -> SysConfigList -> String -> IOStateArrow s b a
xunpickleDocument PU a
xp SysConfigList
conf String
src
                        = SysConfigList -> String -> IOStateArrow s b XmlTree
forall s b. SysConfigList -> String -> IOStateArrow s b XmlTree
readDocument SysConfigList
conf String
src
                          IOStateArrow s b XmlTree
-> IOSLA (XIOState s) XmlTree a -> IOStateArrow s b a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                          Int -> String -> IOStateArrow s XmlTree XmlTree
forall s b. Int -> String -> IOStateArrow s b b
traceMsg Int
1 (String
"xunpickleVal for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
src String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" started")
                          IOStateArrow s XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree a -> IOSLA (XIOState s) XmlTree a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                          PU a -> IOSLA (XIOState s) XmlTree a
forall b s. PU b -> IOStateArrow s XmlTree b
xunpickleVal PU a
xp
                          IOSLA (XIOState s) XmlTree a
-> IOSLA (XIOState s) a a -> IOSLA (XIOState s) XmlTree a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                          Int -> String -> IOSLA (XIOState s) a a
forall s b. Int -> String -> IOStateArrow s b b
traceMsg Int
1 (String
"xunpickleVal for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
src String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" finished")

-- | Write out the DTD generated out of a pickler. Calls 'xpicklerDTD'

xpickleWriteDTD         :: PU b -> SysConfigList -> String -> IOStateArrow s b XmlTree
xpickleWriteDTD :: PU b -> SysConfigList -> String -> IOStateArrow s b XmlTree
xpickleWriteDTD PU b
xp SysConfigList
config String
dest
                        = PU b -> IOStateArrow s b XmlTree
forall b s. PU b -> IOStateArrow s b XmlTree
xpickleDTD PU b
xp
                          IOStateArrow s b XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree -> IOStateArrow s b XmlTree
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                          SysConfigList -> String -> IOSLA (XIOState s) XmlTree XmlTree
forall s. SysConfigList -> String -> IOStateArrow s XmlTree XmlTree
writeDocument SysConfigList
config String
dest

-- | The arrow for generating the DTD out of a pickler
--
-- A DTD is generated from a pickler and check for consistency.
-- Errors concerning the DTD are issued.

xpickleDTD              :: PU b -> IOStateArrow s b XmlTree
xpickleDTD :: PU b -> IOStateArrow s b XmlTree
xpickleDTD PU b
xp           = [IOStateArrow s b XmlTree]
-> [IOStateArrow s b XmlTree] -> IOStateArrow s b XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
[a n XmlTree] -> [a n XmlTree] -> a n XmlTree
root [] [ [XmlTree] -> IOStateArrow s b XmlTree
forall (a :: * -> * -> *) c b. ArrowList a => [c] -> a b c
constL (PU b -> [XmlTree]
forall b. PU b -> [XmlTree]
thePicklerDTD PU b
xp)
                                    IOStateArrow s b XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree -> IOStateArrow s b XmlTree
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                    IOSLA (XIOState s) XmlTree XmlTree
forall s. IOStateArrow s XmlTree XmlTree
filterErrorMsg
                                  ]

-- | An arrow for checking picklers
--
-- A value is transformed into an XML document by a given pickler,
-- the associated DTD is extracted from the pickler and checked,
-- the document including the DTD is tranlated into a string,
-- this string is read and validated against the included DTD,
-- and unpickled.
-- The last step is the equality with the input.
--
-- If the check succeeds, the arrow works like this, else it fails.

checkPickler            :: Eq a => PU a -> IOStateArrow s a a
checkPickler :: PU a -> IOStateArrow s a a
checkPickler PU a
xp         = ( ( ( ( PU a -> IOSLA (XIOState s) a XmlTree
forall (a :: * -> * -> *) b. ArrowXml a => PU b -> a b XmlTree
xpickleVal PU a
xp
                                  IOSLA (XIOState s) a XmlTree
-> IOSLA (XIOState s) XmlTree a -> IOStateArrow s a a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                  IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren ( (a -> IOSLA (XIOState s) XmlTree a
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA a
forall a. HasCallStack => a
undefined IOSLA (XIOState s) XmlTree a
-> IOSLA (XIOState s) a XmlTree
-> IOSLA (XIOState 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
>>> PU a -> IOSLA (XIOState s) a XmlTree
forall b s. PU b -> IOStateArrow s b XmlTree
xpickleDTD PU a
xp IOSLA (XIOState s) a XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) a XmlTree
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren)
                                                    IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
                                                    IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
                                                  )
                                  IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree a -> IOSLA (XIOState s) XmlTree a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                  SysConfigList -> IOSLA (XIOState s) XmlTree String
forall (a :: * -> * -> *).
ArrowXml a =>
SysConfigList -> a XmlTree String
writeDocumentToString []
                                  IOSLA (XIOState s) XmlTree String
-> IOSLA (XIOState s) String a -> IOSLA (XIOState s) XmlTree a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                  SysConfigList -> IOStateArrow s String XmlTree
forall s. SysConfigList -> IOStateArrow s String XmlTree
readFromString [Bool -> SysConfig
withValidate Bool
True]
                                  IOStateArrow s String XmlTree
-> IOSLA (XIOState s) XmlTree a -> IOSLA (XIOState s) String a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                  PU a -> IOSLA (XIOState s) XmlTree a
forall b s. PU b -> IOStateArrow s XmlTree b
xunpickleVal PU a
xp
                                )
                                IOStateArrow s a a
-> IOStateArrow s a a -> IOSLA (XIOState s) a (a, a)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
                                IOStateArrow s a a
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
                              )
                              IOSLA (XIOState s) a (a, a)
-> IOSLA (XIOState s) (a, a) (a, a) -> IOSLA (XIOState s) 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
>>> ((a, a) -> Bool) -> IOSLA (XIOState s) (a, a) (a, a)
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA ((a -> a -> Bool) -> (a, a) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==))
                            )
                            IOSLA (XIOState s) a (a, a)
-> IOStateArrow s a a -> IOStateArrow s a a
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards` IOStateArrow s a a
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
                          )
                          IOStateArrow s a a -> IOStateArrow s a a -> IOStateArrow s a a
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse` String -> IOStateArrow s a a
forall s b. String -> IOStateArrow s b b
issueErr String
"pickle/unpickle combinators failed"

-- | The arrow version of the pickler function

xpickleVal              :: ArrowXml a => PU b -> a b XmlTree
xpickleVal :: PU b -> a b XmlTree
xpickleVal PU b
xp           = (b -> XmlTree) -> a b XmlTree
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (PU b -> b -> XmlTree
forall a. PU a -> a -> XmlTree
pickleDoc PU b
xp)

-- | The arrow version of the unpickler function

{- old version, runs outside IO
xunpickleVal            :: ArrowXml a => PU b -> a XmlTree b
xunpickleVal xp         = ( processChildren (none `whenNot` isElem)     -- remove all stuff surrounding the root element
                            `when`
                            isRoot
                          )
                          >>>
                          arrL (maybeToList . unpickleDoc xp)
-- -}

xunpickleVal           :: PU b -> IOStateArrow s XmlTree b
xunpickleVal :: PU b -> IOStateArrow s XmlTree b
xunpickleVal PU b
xp        = ( IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren (IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`whenNot` IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isElem)     -- remove all stuff surrounding the root element
                            IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
                            IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRoot
                          )
                          IOSLA (XIOState s) XmlTree XmlTree
-> IOStateArrow s XmlTree b -> IOStateArrow s XmlTree b
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                          (XmlTree -> Either String b)
-> IOSLA (XIOState s) XmlTree (Either String b)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (PU b -> XmlTree -> Either String b
forall a. PU a -> XmlTree -> Either String a
unpickleDoc' PU b
xp)
                          IOSLA (XIOState s) XmlTree (Either String b)
-> IOSLA (XIOState s) (Either String b) b
-> IOStateArrow s XmlTree b
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                          ( ( (String -> IOStateArrow s String String
forall s b. String -> IOStateArrow s b b
issueFatal (String -> IOStateArrow s String String)
-> IOStateArrow s String String -> IOStateArrow s String String
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< (String -> String) -> IOStateArrow s String String
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (String
"document unpickling failed\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++))
                              IOStateArrow s String String
-> IOSLA (XIOState s) String b -> IOSLA (XIOState s) String b
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                              IOSLA (XIOState s) String b
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
                            )
                            IOSLA (XIOState s) String b
-> IOSLA (XIOState s) b b -> IOSLA (XIOState s) (Either String b) b
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
|||
                            IOSLA (XIOState s) b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
                          )

-- | Compute the associated DTD of a pickler

thePicklerDTD           :: PU b -> XmlTrees
thePicklerDTD :: PU b -> [XmlTree]
thePicklerDTD           = DTDdescr -> [XmlTree]
dtdDescrToXml (DTDdescr -> [XmlTree]) -> (PU b -> DTDdescr) -> PU b -> [XmlTree]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> DTDdescr
dtdDescr (Schema -> DTDdescr) -> (PU b -> Schema) -> PU b -> DTDdescr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PU b -> Schema
forall a. PU a -> Schema
theSchema

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