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

    {- |
       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 xp :: PU a
    xp config :: SysConfigList
    config dest :: 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 1 "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        = "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 xp :: PU a
    xp conf :: SysConfigList
    conf src :: 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 1 ("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]
    ++ " 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 1 ("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]
    ++ " 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 xp :: PU b
    xp config :: SysConfigList
    config dest :: 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 xp :: 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 xp :: 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 "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 xp :: 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 xp :: 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 ("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

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