{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE CPP                   #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances  #-}

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

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

   Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
   Stability  : stable
   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.

   Old: Therefore the unpickler has a Maybe result type.
   Failure is used to unpickle optional elements
   (Maybe data) and lists of arbitray length.

   Since hxt-9.2.0: The unpicklers are implemented as
   a parser monad with an Either err val result type.
   This enables appropriate error messages , when unpickling
   XML stuff, that is not generated with the picklers and which contains
   some elements and/or attributes that are not handled when unpickling.

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

-}

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

module Text.XML.HXT.Arrow.Pickle.Xml
where

#if MIN_VERSION_base(4,8,0)
#else
import           Control.Applicative              (Applicative (..))
#endif

import           Control.Arrow.ArrowList
import           Control.Arrow.ListArrows
import           Control.Monad                    ()

#if MIN_VERSION_mtl(2,2,0)
import           Control.Monad.Except             (MonadError (..))
#else
import           Control.Monad.Error              (MonadError (..))
#endif

import           Control.Monad.State              (MonadState (..), gets,
                                                   modify)

import           Data.Char                        (isDigit)
import           Data.List                        (foldl')
import           Data.Map                         (Map)
import qualified Data.Map                         as M
import           Data.Maybe                       (fromJust, fromMaybe)

import           Text.XML.HXT.Arrow.Edit          (xshowEscapeXml)
import           Text.XML.HXT.Arrow.Pickle.Schema
import           Text.XML.HXT.Arrow.ReadDocument  (xread)
import           Text.XML.HXT.Arrow.WriteDocument (writeDocumentToString)
import           Text.XML.HXT.Arrow.XmlState
import           Text.XML.HXT.DOM.Interface
import qualified Text.XML.HXT.DOM.ShowXml         as XN
import qualified Text.XML.HXT.DOM.XmlNode         as XN

{- just for embedded test cases, prefix with -- to activate
import           Text.XML.HXT.Arrow.XmlArrow
import qualified Control.Arrow.ListArrows         as X
-- -}

{- debug code
import qualified Debug.Trace                      as T
-- -}

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

data St         = St { St -> [XmlTree]
attributes :: [XmlTree]
                     , St -> [XmlTree]
contents   :: [XmlTree]
                     , St -> Int
nesting    :: Int                -- the remaining 3 fields are used only for unpickling
                     , St -> QName
pname      :: QName              -- to generate appropriate error messages
                     , St -> Bool
pelem      :: Bool
                     } deriving (Int -> St -> ShowS
[St] -> ShowS
St -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [St] -> ShowS
$cshowList :: [St] -> ShowS
show :: St -> String
$cshow :: St -> String
showsPrec :: Int -> St -> ShowS
$cshowsPrec :: Int -> St -> ShowS
Show)

data PU a       = PU { forall a. PU a -> Pickler a
appPickle   :: Pickler a         -- (a, St) -> St
                     , forall a. PU a -> Unpickler a
appUnPickle :: Unpickler a
                     , forall a. PU a -> Schema
theSchema   :: Schema
                     }

-- --------------------
--
-- The pickler

type Pickler a          = a -> St -> St

-- --------------------
--
-- The unpickler monad, a combination of state and error monad

newtype Unpickler a     = UP { forall a. Unpickler a -> St -> (UnpickleVal a, St)
runUP :: St -> (UnpickleVal a, St) }

type UnpickleVal a      = Either UnpickleErr a

type UnpickleErr        = (String, St)

instance Functor Unpickler where
    fmap :: forall a b. (a -> b) -> Unpickler a -> Unpickler b
fmap a -> b
f Unpickler a
u    = forall a. (St -> (UnpickleVal a, St)) -> Unpickler a
UP forall a b. (a -> b) -> a -> b
$ \ St
st ->
                  let (UnpickleVal a
r, St
st') = forall a. Unpickler a -> St -> (UnpickleVal a, St)
runUP Unpickler a
u St
st in (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f UnpickleVal a
r, St
st')

instance Applicative Unpickler where
    pure :: forall a. a -> Unpickler a
pure a
a      = forall a. (St -> (UnpickleVal a, St)) -> Unpickler a
UP forall a b. (a -> b) -> a -> b
$ \ St
st -> (forall a b. b -> Either a b
Right a
a, St
st)
    Unpickler (a -> b)
uf <*> :: forall a b. Unpickler (a -> b) -> Unpickler a -> Unpickler b
<*> Unpickler a
ua   = forall a. (St -> (UnpickleVal a, St)) -> Unpickler a
UP forall a b. (a -> b) -> a -> b
$ \ St
st ->
                  let (UnpickleVal (a -> b)
f, St
st') = forall a. Unpickler a -> St -> (UnpickleVal a, St)
runUP Unpickler (a -> b)
uf St
st in
                  case UnpickleVal (a -> b)
f of
                    Left UnpickleErr
err -> (forall a b. a -> Either a b
Left UnpickleErr
err, St
st')
                    Right a -> b
f' -> forall a. Unpickler a -> St -> (UnpickleVal a, St)
runUP (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f' Unpickler a
ua) St
st'

instance Monad Unpickler where
    return :: forall a. a -> Unpickler a
return      = forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Unpickler a
u >>= :: forall a b. Unpickler a -> (a -> Unpickler b) -> Unpickler b
>>= a -> Unpickler b
f     = forall a. (St -> (UnpickleVal a, St)) -> Unpickler a
UP forall a b. (a -> b) -> a -> b
$ \ St
st ->
                  let (UnpickleVal a
r, St
st') = forall a. Unpickler a -> St -> (UnpickleVal a, St)
runUP Unpickler a
u St
st in
                  case UnpickleVal a
r of
                    Left UnpickleErr
err -> (forall a b. a -> Either a b
Left UnpickleErr
err, St
st')
                    Right a
v  -> forall a. Unpickler a -> St -> (UnpickleVal a, St)
runUP (a -> Unpickler b
f a
v) St
st'

instance MonadState St Unpickler where
    get :: Unpickler St
get         = forall a. (St -> (UnpickleVal a, St)) -> Unpickler a
UP forall a b. (a -> b) -> a -> b
$ \ St
st -> (forall a b. b -> Either a b
Right St
st, St
st)
    put :: St -> Unpickler ()
put St
st      = forall a. (St -> (UnpickleVal a, St)) -> Unpickler a
UP forall a b. (a -> b) -> a -> b
$ \ St
_  -> (forall a b. b -> Either a b
Right (), St
st)

instance MonadError UnpickleErr Unpickler where
    throwError :: forall a. UnpickleErr -> Unpickler a
throwError UnpickleErr
err
                = forall a. (St -> (UnpickleVal a, St)) -> Unpickler a
UP forall a b. (a -> b) -> a -> b
$ \ St
st -> (forall a b. a -> Either a b
Left UnpickleErr
err, St
st)

    -- redundant, not (yet) used
    catchError :: forall a.
Unpickler a -> (UnpickleErr -> Unpickler a) -> Unpickler a
catchError Unpickler a
u UnpickleErr -> Unpickler a
handler
                = forall a. (St -> (UnpickleVal a, St)) -> Unpickler a
UP forall a b. (a -> b) -> a -> b
$ \ St
st ->
                  let (UnpickleVal a
r, St
st') = forall a. Unpickler a -> St -> (UnpickleVal a, St)
runUP Unpickler a
u St
st in
                  case UnpickleVal a
r of
                    Left UnpickleErr
err -> forall a. Unpickler a -> St -> (UnpickleVal a, St)
runUP (UnpickleErr -> Unpickler a
handler UnpickleErr
err) St
st  -- not st', state will be reset in error case
                    UnpickleVal a
_        -> (UnpickleVal a
r, St
st')

throwMsg        :: String -> Unpickler a
throwMsg :: forall a. String -> Unpickler a
throwMsg String
msg    = forall a. (St -> (UnpickleVal a, St)) -> Unpickler a
UP forall a b. (a -> b) -> a -> b
$ \ St
st -> (forall a b. a -> Either a b
Left (String
msg, St
st), St
st)

-- | Choice combinator for unpickling
--
-- first 2 arguments are applied sequentially, but if the 1. one fails the
-- 3. arg is applied

mchoice         :: Unpickler a -> (a -> Unpickler b) -> Unpickler b -> Unpickler b
mchoice :: forall a b.
Unpickler a -> (a -> Unpickler b) -> Unpickler b -> Unpickler b
mchoice Unpickler a
u a -> Unpickler b
f Unpickler b
v   = forall a. (St -> (UnpickleVal a, St)) -> Unpickler a
UP forall a b. (a -> b) -> a -> b
$ \ St
st ->
                  let (UnpickleVal a
r, St
st') = forall a. Unpickler a -> St -> (UnpickleVal a, St)
runUP Unpickler a
u St
st in
                  case UnpickleVal a
r of
                    Right a
x
                        -> forall a. Unpickler a -> St -> (UnpickleVal a, St)
runUP (a -> Unpickler b
f a
x) St
st'                      -- success
                    Left e :: UnpickleErr
e@(String
_msg, St
st'')
                        -> if St -> Int
nesting St
st'' forall a. Eq a => a -> a -> Bool
== St -> Int
nesting St
st        -- true: failure in parsing curr contents
                           then forall a. Unpickler a -> St -> (UnpickleVal a, St)
runUP Unpickler b
v St
st                      -- try the alternative unpickler
                           else (forall a b. a -> Either a b
Left UnpickleErr
e, St
st')                   -- false: failure in unpickling a subtree of
                                                                -- the current contents, so the whole unpickler
                                                                -- must fail

-- | Lift a Maybe value into the Unpickler monad.
--
-- The 1. arg is the attached error message

liftMaybe       :: String -> Maybe a -> Unpickler a
liftMaybe :: forall a. String -> Maybe a -> Unpickler a
liftMaybe String
e Maybe a
v  = case Maybe a
v of
                    Maybe a
Nothing -> forall a. String -> Unpickler a
throwMsg String
e
                    Just a
x  -> forall (m :: * -> *) a. Monad m => a -> m a
return a
x

-- | Lift an Either value into the Unpickler monad

liftUnpickleVal         :: UnpickleVal a -> Unpickler a
liftUnpickleVal :: forall a. UnpickleVal a -> Unpickler a
liftUnpickleVal UnpickleVal a
v       = forall a. (St -> (UnpickleVal a, St)) -> Unpickler a
UP forall a b. (a -> b) -> a -> b
$ \ St
st -> (UnpickleVal a
v, St
st)

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

getCont         :: Unpickler XmlTree
getCont :: Unpickler XmlTree
getCont         = do [XmlTree]
cs <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets St -> [XmlTree]
contents
                     case [XmlTree]
cs of
                       []       -> forall a. String -> Unpickler a
throwMsg String
"no more contents to be read"
                       (XmlTree
x : [XmlTree]
xs) -> do forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\ St
s -> St
s {contents :: [XmlTree]
contents = [XmlTree]
xs})
                                      forall (m :: * -> *) a. Monad m => a -> m a
return XmlTree
x

getAtt          :: QName -> Unpickler XmlTree
getAtt :: QName -> Unpickler XmlTree
getAtt QName
qn       = do [XmlTree]
as <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets St -> [XmlTree]
attributes
                     case [XmlTree] -> Maybe (XmlTree, [XmlTree])
findAtt [XmlTree]
as of
                       Maybe (XmlTree, [XmlTree])
Nothing -> forall a. String -> Unpickler a
throwMsg forall a b. (a -> b) -> a -> b
$ String
"no attribute value found for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show QName
qn
                       Just (XmlTree
a, [XmlTree]
as') -> do forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\ St
s -> St
s {attributes :: [XmlTree]
attributes = [XmlTree]
as'})
                                           forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *} {a}. (XmlNode a, Tree t) => t a -> t a
nonEmptyVal XmlTree
a
    where
      findAtt :: [XmlTree] -> Maybe (XmlTree, [XmlTree])
findAtt     = forall a. (a -> Bool) -> [a] -> Maybe (a, [a])
findElem (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall a. Eq a => a -> a -> Bool
== QName
qn) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. XmlNode a => a -> Maybe QName
XN.getAttrName)
      nonEmptyVal :: t a -> t a
nonEmptyVal t a
a'
          | forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall (t :: * -> *) a. Tree t => t a -> [t a]
XN.getChildren t a
a') = forall (t :: * -> *) a. Tree t => [t a] -> t a -> t a
XN.setChildren [t a
et] t a
a'
          | Bool
otherwise                = t a
a'
          where
            et :: t a
et = forall a. XmlNode a => String -> a
XN.mkText String
""

getNSAtt        :: String -> Unpickler ()
getNSAtt :: String -> Unpickler ()
getNSAtt String
ns     = do [XmlTree]
as <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets St -> [XmlTree]
attributes
                     case [XmlTree] -> Maybe (XmlTree, [XmlTree])
findNS [XmlTree]
as of
                       Maybe (XmlTree, [XmlTree])
Nothing        -> forall a. String -> Unpickler a
throwMsg forall a b. (a -> b) -> a -> b
$
                                         String
"no namespace declaration found for namespace " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
ns
                       Just (XmlTree
_a, [XmlTree]
as') -> do forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\ St
s -> St
s {attributes :: [XmlTree]
attributes = [XmlTree]
as'})
                                            forall (m :: * -> *) a. Monad m => a -> m a
return ()
    where
      isNS :: XmlTree -> Bool
isNS XmlTree
t    = (forall a. a -> Maybe a -> a
fromMaybe Bool
False forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QName -> Bool
isNameSpaceName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. XmlNode a => a -> Maybe QName
XN.getAttrName forall a b. (a -> b) -> a -> b
$ XmlTree
t)
                  Bool -> Bool -> Bool
&&
                  [XmlTree] -> String
XN.xshow (forall (t :: * -> *) a. Tree t => t a -> [t a]
XN.getChildren XmlTree
t) forall a. Eq a => a -> a -> Bool
== String
ns
      findNS :: [XmlTree] -> Maybe (XmlTree, [XmlTree])
findNS    = forall a. (a -> Bool) -> [a] -> Maybe (a, [a])
findElem XmlTree -> Bool
isNS

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

emptySt         :: St
emptySt :: St
emptySt         =  St { attributes :: [XmlTree]
attributes = []
                      , contents :: [XmlTree]
contents   = []
                      , nesting :: Int
nesting    = Int
0
                      , pname :: QName
pname      = String -> QName
mkName String
"/"
                      , pelem :: Bool
pelem      = Bool
True
                      }

putAtt          :: QName -> [XmlTree] -> St -> St
putAtt :: QName -> [XmlTree] -> St -> St
putAtt QName
qn [XmlTree]
v St
s   = St
s {attributes :: [XmlTree]
attributes = XmlTree
x forall a. a -> [a] -> [a]
: St -> [XmlTree]
attributes St
s}
                  where
                    x :: XmlTree
x = QName -> [XmlTree] -> XmlTree
XN.mkAttr QName
qn [XmlTree]
v
{-# INLINE putAtt #-}

putCont         :: XmlTree -> St -> St
putCont :: XmlTree -> St -> St
putCont XmlTree
x St
s     = St
s {contents :: [XmlTree]
contents = XmlTree
x forall a. a -> [a] -> [a]
: St -> [XmlTree]
contents St
s}
{-# INLINE putCont #-}

-- --------------------
--
-- generally useful function for splitting a value from a list

findElem       :: (a -> Bool) -> [a] -> Maybe (a, [a])
findElem :: forall a. (a -> Bool) -> [a] -> Maybe (a, [a])
findElem a -> Bool
p     = forall {c}. ([a] -> c) -> [a] -> Maybe (a, c)
find' forall a. a -> a
id
    where
      find' :: ([a] -> c) -> [a] -> Maybe (a, c)
find' [a] -> c
_ []         = forall a. Maybe a
Nothing
      find' [a] -> c
prefix (a
x : [a]
xs)
          | a -> Bool
p a
x          = forall a. a -> Maybe a
Just (a
x, [a] -> c
prefix [a]
xs)
          | Bool
otherwise    = ([a] -> c) -> [a] -> Maybe (a, c)
find' ([a] -> c
prefix forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
xforall a. a -> [a] -> [a]
:)) [a]
xs

-- ------------------------------------------------------------
--
-- | Format the context of an error message.

formatSt                :: St -> String
formatSt :: St -> String
formatSt St
st             = String
fcx forall a. [a] -> [a] -> [a]
++
                          [XmlTree] -> String
fa (St -> [XmlTree]
attributes St
st) forall a. [a] -> [a] -> [a]
++
                          [XmlTree] -> String
fc (St -> [XmlTree]
contents   St
st)
    where
      fcx :: String
fcx               = String
"\n" forall a. [a] -> [a] -> [a]
++ String
"context:    " forall a. [a] -> [a] -> [a]
++
                          ( if St -> Bool
pelem St
st
                            then String
"element"
                            else String
"attribute"
                          ) forall a. [a] -> [a] -> [a]
++
                          String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (St -> QName
pname St
st)
      fc :: [XmlTree] -> String
fc []             = String
""
      fc [XmlTree]
cs             = String
"\n" forall a. [a] -> [a] -> [a]
++ String
"contents:   " forall a. [a] -> [a] -> [a]
++ [XmlTree] -> String
formatXML [XmlTree]
cs
      fa :: [XmlTree] -> String
fa []             = String
""
      fa [XmlTree]
as             = String
"\n" forall a. [a] -> [a] -> [a]
++ String
"attributes: " forall a. [a] -> [a] -> [a]
++ [XmlTree] -> String
formatXML [XmlTree]
as
      formatXML :: [XmlTree] -> String
formatXML         = Int -> ShowS
format Int
80 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [XmlTree] -> String
showXML
      showXML :: [XmlTree] -> String
showXML           = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. LA a b -> a -> [b]
runLA ( forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n String
xshowEscapeXml forall (a :: * -> * -> *) b. ArrowList a => a [b] b
unlistA )
      format :: Int -> ShowS
format Int
n String
s        = let s' :: String
s' = forall a. Int -> [a] -> [a]
take (Int
n forall a. Num a => a -> a -> a
+ Int
1) String
s in
                          if forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s' forall a. Ord a => a -> a -> Bool
<= Int
n then String
s' else forall a. Int -> [a] -> [a]
take Int
n String
s forall a. [a] -> [a] -> [a]
++ String
"..."

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

-- | conversion of an arbitrary value into an XML document tree.
--
-- The pickler, first parameter, controls the conversion process.
-- Result is a complete document tree including a root node

pickleDoc       :: PU a -> a -> XmlTree
pickleDoc :: forall a. PU a -> a -> XmlTree
pickleDoc PU a
p a
v   = [XmlTree] -> [XmlTree] -> XmlTree
XN.mkRoot (St -> [XmlTree]
attributes St
st) (St -> [XmlTree]
contents St
st)
    where
      st :: St
st        = forall a. PU a -> Pickler a
appPickle PU a
p a
v St
emptySt

-- | Conversion of an XML document tree into an arbitrary data type
--
-- The inverse of 'pickleDoc'.
-- This law should hold for all picklers: @ unpickle px . pickle px $ v == Just v @.
-- Not every possible combination of picklers does make sense.
-- For reconverting a value from an XML tree, is becomes neccessary,
-- to introduce \"enough\" markup for unpickling the value

unpickleDoc     :: PU a -> XmlTree -> Maybe a
unpickleDoc :: forall a. PU a -> XmlTree -> Maybe a
unpickleDoc PU a
p   = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PU a -> XmlTree -> Either String a
unpickleDoc' PU a
p

-- | Like unpickleDoc but with a (sometimes) useful error message, when unpickling failed.

unpickleDoc'    :: PU a -> XmlTree -> Either String a
unpickleDoc' :: forall a. PU a -> XmlTree -> Either String a
unpickleDoc' PU a
p XmlTree
t
    | forall a. XmlNode a => a -> Bool
XN.isRoot XmlTree
t       = forall {b}. Either UnpickleErr b -> Either String b
mapErr forall a b. (a -> b) -> a -> b
$
                          forall a. PU a -> Int -> XmlTree -> UnpickleVal a
unpickleElem' PU a
p Int
0              XmlTree
t
    | Bool
otherwise         = forall a. PU a -> XmlTree -> Either String a
unpickleDoc'  PU a
p ([XmlTree] -> [XmlTree] -> XmlTree
XN.mkRoot [] [XmlTree
t])
    where
      mapErr :: Either UnpickleErr b -> Either String b
mapErr            = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ( forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                   \ (String
msg, St
st) -> String
msg forall a. [a] -> [a] -> [a]
++ St -> String
formatSt St
st
                                 ) forall a b. b -> Either a b
Right

-- | The main entry for unpickling, called by unpickleDoc

unpickleElem'   :: PU a -> Int -> XmlTree -> UnpickleVal a
unpickleElem' :: forall a. PU a -> Int -> XmlTree -> UnpickleVal a
unpickleElem' PU a
p Int
l XmlTree
t
    = -- T.trace ("unpickleElem': " ++ show t) $
      ( forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Unpickler a -> St -> (UnpickleVal a, St)
runUP (forall a. PU a -> Unpickler a
appUnPickle PU a
p) )
      forall a b. (a -> b) -> a -> b
$ St { attributes :: [XmlTree]
attributes = forall a. a -> Maybe a -> a
fromMaybe [] forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          forall a. XmlNode a => a -> Maybe [XmlTree]
XN.getAttrl forall a b. (a -> b) -> a -> b
$  XmlTree
t
           , contents :: [XmlTree]
contents   = forall (t :: * -> *) a. Tree t => t a -> [t a]
XN.getChildren XmlTree
t
           , nesting :: Int
nesting    = Int
l
           , pname :: QName
pname      = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          forall a. XmlNode a => a -> Maybe QName
XN.getName  forall a b. (a -> b) -> a -> b
$  XmlTree
t
           , pelem :: Bool
pelem      = forall a. XmlNode a => a -> Bool
XN.isElem      XmlTree
t
           }

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

-- | Pickles a value, then writes the document to a string.

showPickled :: (XmlPickler a) => SysConfigList -> a -> String
showPickled :: forall a. XmlPickler a => SysConfigList -> a -> String
showPickled SysConfigList
a = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. PU a -> a -> XmlTree
pickleDoc forall a. XmlPickler a => PU a
xpickle 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. LA a b -> a -> [b]
runLA (forall (a :: * -> * -> *).
ArrowXml a =>
SysConfigList -> a XmlTree String
writeDocumentToString SysConfigList
a))

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

-- | The zero pickler
--
-- Encodes nothing, fails always during unpickling

xpZero                  :: String -> PU a
xpZero :: forall a. String -> PU a
xpZero String
err              =  PU { appPickle :: Pickler a
appPickle   = forall a b. a -> b -> a
const forall a. a -> a
id
                              , appUnPickle :: Unpickler a
appUnPickle = forall a. String -> Unpickler a
throwMsg String
err
                              , theSchema :: Schema
theSchema   = Schema
scNull
                              }

-- | unit pickler

xpUnit                  :: PU ()
xpUnit :: PU ()
xpUnit                  = forall a. a -> PU a
xpLift ()

-- | Check EOF pickler.
--
-- When pickling, this behaves like the unit pickler.
-- The unpickler fails, when there is some unprocessed XML contents left.

xpCheckEmptyContents    :: PU a -> PU a
xpCheckEmptyContents :: forall a. PU a -> PU a
xpCheckEmptyContents PU a
pa =  PU { appPickle :: Pickler a
appPickle   = forall a. PU a -> Pickler a
appPickle PU a
pa
                              , appUnPickle :: Unpickler a
appUnPickle = do a
res <- forall a. PU a -> Unpickler a
appUnPickle PU a
pa
                                                 [XmlTree]
cs <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets St -> [XmlTree]
contents
                                                 if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [XmlTree]
cs
                                                    then forall (m :: * -> *) a. Monad m => a -> m a
return a
res
                                                    else forall {a}. Unpickler a
contentsLeft
                              , theSchema :: Schema
theSchema   = Schema
scNull
                              }
    where
      contentsLeft :: Unpickler a
contentsLeft      = forall a. String -> Unpickler a
throwMsg
                          String
"xpCheckEmptyContents: unprocessed XML content detected"

-- | Like xpCheckEmptyContents, but checks the attribute list

xpCheckEmptyAttributes  :: PU a -> PU a
xpCheckEmptyAttributes :: forall a. PU a -> PU a
xpCheckEmptyAttributes PU a
pa
                        =  PU { appPickle :: Pickler a
appPickle   = forall a. PU a -> Pickler a
appPickle PU a
pa
                              , appUnPickle :: Unpickler a
appUnPickle = do a
res <- forall a. PU a -> Unpickler a
appUnPickle PU a
pa
                                                 [XmlTree]
as <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets St -> [XmlTree]
attributes
                                                 if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [XmlTree]
as
                                                    then forall (m :: * -> *) a. Monad m => a -> m a
return a
res
                                                    else forall {a}. Unpickler a
attributesLeft
                              , theSchema :: Schema
theSchema   = Schema
scNull
                              }
    where
      attributesLeft :: Unpickler a
attributesLeft    = forall a. String -> Unpickler a
throwMsg
                          String
"xpCheckEmptyAttributes: unprocessed XML attribute(s) detected"

-- | Composition of xpCheckEmptyContents and xpCheckAttributes

xpCheckEmpty            :: PU a -> PU a
xpCheckEmpty :: forall a. PU a -> PU a
xpCheckEmpty            = forall a. PU a -> PU a
xpCheckEmptyAttributes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PU a -> PU a
xpCheckEmptyContents

xpLift                  :: a -> PU a
xpLift :: forall a. a -> PU a
xpLift a
x                =  PU { appPickle :: Pickler a
appPickle   = forall a b. a -> b -> a
const forall a. a -> a
id
                              , appUnPickle :: Unpickler a
appUnPickle = forall (m :: * -> *) a. Monad m => a -> m a
return a
x
                              , theSchema :: Schema
theSchema   = Schema
scEmpty
                              }

-- | Lift a Maybe value to a pickler.
--
-- @Nothing@ is mapped to the zero pickler, @Just x@ is pickled with @xpLift x@.

xpLiftMaybe                     :: Maybe a -> PU a
xpLiftMaybe :: forall a. Maybe a -> PU a
xpLiftMaybe Maybe a
v                   = (forall a. Maybe a -> PU a
xpLiftMaybe'' Maybe a
v) { theSchema :: Schema
theSchema = Schema -> Schema
scOption Schema
scEmpty }
    where
    xpLiftMaybe'' :: Maybe a -> PU a
xpLiftMaybe'' Maybe a
Nothing       = forall a. String -> PU a
xpZero String
"xpLiftMaybe: got Nothing"
    xpLiftMaybe'' (Just a
x)      = forall a. a -> PU a
xpLift a
x

xpLiftEither                    :: Either String a -> PU a
xpLiftEither :: forall a. Either String a -> PU a
xpLiftEither Either String a
v                  = (forall a. Either String a -> PU a
xpLiftEither'' Either String a
v) { theSchema :: Schema
theSchema = Schema -> Schema
scOption Schema
scEmpty }
    where
    xpLiftEither'' :: Either String a -> PU a
xpLiftEither'' (Left String
err)   = forall a. String -> PU a
xpZero String
err
    xpLiftEither'' (Right a
x)    = forall a. a -> PU a
xpLift a
x

-- | Combine two picklers sequentially.
--
-- If the first fails during
-- unpickling, the whole unpickler fails

xpSeq           :: (b -> a) -> PU a -> (a -> PU b) -> PU b
xpSeq :: forall b a. (b -> a) -> PU a -> (a -> PU b) -> PU b
xpSeq b -> a
f PU a
pa a -> PU b
k
    = PU { appPickle :: Pickler b
appPickle  = ( \ b
b ->
                          let a :: a
a = b -> a
f b
b in
                          forall a. PU a -> Pickler a
appPickle PU a
pa a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PU a -> Pickler a
appPickle (a -> PU b
k a
a) b
b
                         )
         , appUnPickle :: Unpickler b
appUnPickle = forall a. PU a -> Unpickler a
appUnPickle PU a
pa forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall a. PU a -> Unpickler a
appUnPickle forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PU b
k)
         , theSchema :: Schema
theSchema   = forall a. HasCallStack => a
undefined
         }

-- | First apply a fixed pickler/unpickler, then a 2. one
--
-- If the first fails during unpickling, the whole pickler fails.
-- This can be used to check some properties of the input, e.g. whether
-- a given fixed attribute or a namespace declaration exists
-- ('xpAddFixedAttr', 'xpAddNSDecl')
-- or to filter the input, e.g. to ignore some elements or attributes
-- ('xpFilterCont', 'xpFilterAttr').
--
-- When pickling, this can be used to insert some fixed XML pieces,
-- e.g. namespace declarations,
-- class attributes or other stuff.

xpSeq'          :: PU () -> PU a -> PU a
xpSeq' :: forall a. PU () -> PU a -> PU a
xpSeq' PU ()
pa       = forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap ( forall a b. (a, b) -> b
snd
                         , \ a
y -> ((), a
y)
                         ) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  forall a b. PU a -> PU b -> PU (a, b)
xpPair PU ()
pa

-- | combine two picklers with a choice
--
-- Run two picklers in sequence like with xpSeq.
-- If during unpickling the first one fails,
-- an alternative pickler (first argument) is applied.
-- This pickler is only used as combinator for unpickling.

xpChoice                :: PU b -> PU a -> (a -> PU b) -> Unpickler b
xpChoice :: forall b a. PU b -> PU a -> (a -> PU b) -> Unpickler b
xpChoice PU b
pb PU a
pa a -> PU b
k        = forall a b.
Unpickler a -> (a -> Unpickler b) -> Unpickler b -> Unpickler b
mchoice (forall a. PU a -> Unpickler a
appUnPickle PU a
pa) (forall a. PU a -> Unpickler a
appUnPickle forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PU b
k) (forall a. PU a -> Unpickler a
appUnPickle PU b
pb)


-- | map value into another domain and apply pickler there
--
-- One of the most often used picklers.

xpWrap                  :: (a -> b, b -> a) -> PU a -> PU b
xpWrap :: forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap (a -> b
i, b -> a
j) PU a
pa        = (forall b a. (b -> a) -> PU a -> (a -> PU b) -> PU b
xpSeq b -> a
j PU a
pa (forall a. a -> PU a
xpLift forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
i)) { theSchema :: Schema
theSchema = forall a. PU a -> Schema
theSchema PU a
pa }

-- | like 'xpWrap', but if the inverse mapping is undefined, the unpickler fails
--
-- Map a value into another domain. If the inverse mapping is
-- undefined (Nothing), the unpickler fails
--
-- Deprecated: Use xpWrapEither, this gives better error messages

xpWrapMaybe             :: (a -> Maybe b, b -> a) -> PU a -> PU b
xpWrapMaybe :: forall a b. (a -> Maybe b, b -> a) -> PU a -> PU b
xpWrapMaybe (a -> Maybe b
i, b -> a
j) PU a
pa   = (forall b a. (b -> a) -> PU a -> (a -> PU b) -> PU b
xpSeq b -> a
j PU a
pa (forall a. Maybe a -> PU a
xpLiftMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe b
i)) { theSchema :: Schema
theSchema = forall a. PU a -> Schema
theSchema PU a
pa }

-- | like 'xpWrap', but if the inverse mapping is undefined, the unpickler fails
--
-- Map a value into another domain. If the inverse mapping is
-- undefined, the unpickler fails with an error message in the Left component

xpWrapEither             :: (a -> Either String b, b -> a) -> PU a -> PU b
xpWrapEither :: forall a b. (a -> Either String b, b -> a) -> PU a -> PU b
xpWrapEither (a -> Either String b
i, b -> a
j) PU a
pa   = (forall b a. (b -> a) -> PU a -> (a -> PU b) -> PU b
xpSeq b -> a
j PU a
pa (forall a. Either String a -> PU a
xpLiftEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either String b
i)) { theSchema :: Schema
theSchema = forall a. PU a -> Schema
theSchema PU a
pa }

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

-- | pickle a pair of values sequentially
--
-- Used for pairs or together with wrap for pickling
-- algebraic data types with two components

xpPair  :: PU a -> PU b -> PU (a, b)
xpPair :: forall a b. PU a -> PU b -> PU (a, b)
xpPair PU a
pa PU b
pb
    = ( forall b a. (b -> a) -> PU a -> (a -> PU b) -> PU b
xpSeq forall a b. (a, b) -> a
fst PU a
pa (\ a
a ->
        forall b a. (b -> a) -> PU a -> (a -> PU b) -> PU b
xpSeq forall a b. (a, b) -> b
snd PU b
pb (\ b
b ->
        forall a. a -> PU a
xpLift (a
a,b
b)))
      ) { theSchema :: Schema
theSchema = Schema -> Schema -> Schema
scSeq (forall a. PU a -> Schema
theSchema PU a
pa) (forall a. PU a -> Schema
theSchema PU b
pb) }

-- | Like 'xpPair' but for triples

xpTriple        :: PU a -> PU b -> PU c -> PU (a, b, c)
xpTriple :: forall a b c. PU a -> PU b -> PU c -> PU (a, b, c)
xpTriple PU a
pa PU b
pb PU c
pc
    = forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap (forall {a} {b} {c}. (a, (b, c)) -> (a, b, c)
toTriple, forall {a} {a} {b}. (a, a, b) -> (a, (a, b))
fromTriple) (forall a b. PU a -> PU b -> PU (a, b)
xpPair PU a
pa (forall a b. PU a -> PU b -> PU (a, b)
xpPair PU b
pb PU c
pc))
    where
    toTriple :: (a, (b, c)) -> (a, b, c)
toTriple   ~(a
a, ~(b
b, c
c)) = (a
a,  b
b, c
c )
    fromTriple :: (a, a, b) -> (a, (a, b))
fromTriple ~(a
a,   a
b, b
c ) = (a
a, (a
b, b
c))

-- | Like 'xpPair' and 'xpTriple' but for 4-tuples

xp4Tuple        :: PU a -> PU b -> PU c -> PU d -> PU (a, b, c, d)
xp4Tuple :: forall a b c d. PU a -> PU b -> PU c -> PU d -> PU (a, b, c, d)
xp4Tuple PU a
pa PU b
pb PU c
pc PU d
pd
    = forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap (forall {a} {b} {c} {d}. (a, (b, (c, d))) -> (a, b, c, d)
toQuad, forall {a} {a} {a} {b}. (a, a, a, b) -> (a, (a, (a, b)))
fromQuad) (forall a b. PU a -> PU b -> PU (a, b)
xpPair PU a
pa (forall a b. PU a -> PU b -> PU (a, b)
xpPair PU b
pb (forall a b. PU a -> PU b -> PU (a, b)
xpPair PU c
pc PU d
pd)))
    where
    toQuad :: (a, (b, (c, d))) -> (a, b, c, d)
toQuad   ~(a
a, ~(b
b, ~(c
c, d
d))) = (a
a,  b
b,  c
c, d
d  )
    fromQuad :: (a, a, a, b) -> (a, (a, (a, b)))
fromQuad ~(a
a,   a
b,   a
c, b
d  ) = (a
a, (a
b, (a
c, b
d)))

-- | Like 'xpPair' and 'xpTriple' but for 5-tuples

xp5Tuple        :: PU a -> PU b -> PU c -> PU d -> PU e -> PU (a, b, c, d, e)
xp5Tuple :: forall a b c d e.
PU a -> PU b -> PU c -> PU d -> PU e -> PU (a, b, c, d, e)
xp5Tuple PU a
pa PU b
pb PU c
pc PU d
pd PU e
pe
    = forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap (forall {a} {b} {c} {d} {e}.
(a, (b, (c, (d, e)))) -> (a, b, c, d, e)
toQuint, forall {a} {a} {a} {a} {b}.
(a, a, a, a, b) -> (a, (a, (a, (a, b))))
fromQuint) (forall a b. PU a -> PU b -> PU (a, b)
xpPair PU a
pa (forall a b. PU a -> PU b -> PU (a, b)
xpPair PU b
pb (forall a b. PU a -> PU b -> PU (a, b)
xpPair PU c
pc (forall a b. PU a -> PU b -> PU (a, b)
xpPair PU d
pd PU e
pe))))
    where
    toQuint :: (a, (b, (c, (d, e)))) -> (a, b, c, d, e)
toQuint   ~(a
a, ~(b
b, ~(c
c, ~(d
d, e
e)))) = (a
a,  b
b,  c
c,  d
d, e
e   )
    fromQuint :: (a, a, a, a, b) -> (a, (a, (a, (a, b))))
fromQuint ~(a
a,   a
b,   a
c,   a
d, b
e   ) = (a
a, (a
b, (a
c, (a
d, b
e))))

-- | Like 'xpPair' and 'xpTriple' but for 6-tuples

xp6Tuple        :: PU a -> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple :: forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU a
pa PU b
pb PU c
pc PU d
pd PU e
pe PU f
pf
    = forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap (forall {a} {b} {c} {d} {e} {f}.
(a, (b, (c, (d, (e, f))))) -> (a, b, c, d, e, f)
toSix, forall {a} {a} {a} {a} {a} {b}.
(a, a, a, a, a, b) -> (a, (a, (a, (a, (a, b)))))
fromSix) (forall a b. PU a -> PU b -> PU (a, b)
xpPair PU a
pa (forall a b. PU a -> PU b -> PU (a, b)
xpPair PU b
pb (forall a b. PU a -> PU b -> PU (a, b)
xpPair PU c
pc (forall a b. PU a -> PU b -> PU (a, b)
xpPair PU d
pd (forall a b. PU a -> PU b -> PU (a, b)
xpPair PU e
pe PU f
pf)))))
    where
    toSix :: (a, (b, (c, (d, (e, f))))) -> (a, b, c, d, e, f)
toSix   ~(a
a, ~(b
b, ~(c
c, ~(d
d, ~(e
e, f
f))))) = (a
a,  b
b,  c
c,  d
d,  e
e, f
f    )
    fromSix :: (a, a, a, a, a, b) -> (a, (a, (a, (a, (a, b)))))
fromSix ~(a
a,   a
b,   a
c,   a
d,   a
e, b
f)     = (a
a, (a
b, (a
c, (a
d, (a
e, b
f)))))

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

-- | Like 'xpPair' and 'xpTriple' but for 7-tuples
--
-- Thanks to Tony Morris for doing xp7Tuple, ..., xp24Tuple.

xp7Tuple :: PU a -> PU b -> PU c -> PU d -> PU e ->
            PU f -> PU g -> PU (a, b, c, d, e, f, g)
xp7Tuple :: forall a b c d e f g.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU (a, b, c, d, e, f, g)
xp7Tuple PU a
a PU b
b PU c
c PU d
d PU e
e PU f
f PU g
g
    = forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap ( \ (a
a, (b
b, c
c, d
d, e
e, f
f, g
g)) -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g)
             , \ (a
a, b
b, c
c, d
d, e
e, f
f, g
g)   -> (a
a, (b
b, c
c, d
d, e
e, f
f, g
g))
             )
      (forall a b. PU a -> PU b -> PU (a, b)
xpPair PU a
a (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU b
b PU c
c PU d
d PU e
e PU f
f PU g
g))

xp8Tuple :: PU a -> PU b -> PU c -> PU d -> PU e ->
            PU f -> PU g -> PU h -> PU (a, b, c, d, e, f, g, h)
xp8Tuple :: forall a b c d e f g h.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU (a, b, c, d, e, f, g, h)
xp8Tuple PU a
a PU b
b PU c
c PU d
d PU e
e PU f
f PU g
g PU h
h
    = forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap ( \ ((a
a, b
b), (c
c, d
d, e
e, f
f, g
g, h
h)) -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h)
             , \ (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h) -> ((a
a, b
b), (c
c, d
d, e
e, f
f, g
g, h
h))
             )
      (forall a b. PU a -> PU b -> PU (a, b)
xpPair (forall a b. PU a -> PU b -> PU (a, b)
xpPair PU a
a PU b
b) (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU c
c PU d
d PU e
e PU f
f PU g
g PU h
h))

xp9Tuple :: PU a -> PU b -> PU c -> PU d -> PU e ->
            PU f -> PU g -> PU h -> PU i -> PU (a, b, c, d, e, f, g, h, i)
xp9Tuple :: forall a b c d e f g h i.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU i
-> PU (a, b, c, d, e, f, g, h, i)
xp9Tuple PU a
a PU b
b PU c
c PU d
d PU e
e PU f
f PU g
g PU h
h PU i
i
    = forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap ( \ ((a
a, b
b, c
c), (d
d, e
e, f
f, g
g, h
h, i
i)) -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i)
             , \ (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i) -> ((a
a, b
b, c
c), (d
d, e
e, f
f, g
g, h
h, i
i))
             )
      (forall a b. PU a -> PU b -> PU (a, b)
xpPair (forall a b c. PU a -> PU b -> PU c -> PU (a, b, c)
xpTriple PU a
a PU b
b PU c
c) (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU d
d PU e
e PU f
f PU g
g PU h
h PU i
i))

xp10Tuple :: PU a -> PU b -> PU c -> PU d -> PU e ->
             PU f -> PU g -> PU h -> PU i -> PU j ->
             PU (a, b, c, d, e, f, g, h, i, j)
xp10Tuple :: forall a b c d e f g h i j.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU i
-> PU j
-> PU (a, b, c, d, e, f, g, h, i, j)
xp10Tuple PU a
a PU b
b PU c
c PU d
d PU e
e PU f
f PU g
g PU h
h PU i
i PU j
j
    = forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap ( \ ((a
a, b
b, c
c, d
d), (e
e, f
f, g
g, h
h, i
i, j
j)) -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j)
             , \ (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j) -> ((a
a, b
b, c
c, d
d), (e
e, f
f, g
g, h
h, i
i, j
j))
             )
      (forall a b. PU a -> PU b -> PU (a, b)
xpPair (forall a b c d. PU a -> PU b -> PU c -> PU d -> PU (a, b, c, d)
xp4Tuple PU a
a PU b
b PU c
c PU d
d) (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU e
e PU f
f PU g
g PU h
h PU i
i PU j
j))

xp11Tuple :: PU a -> PU b -> PU c -> PU d -> PU e ->
             PU f -> PU g -> PU h -> PU i -> PU j ->
             PU k -> PU (a, b, c, d, e, f, g, h, i, j, k)
xp11Tuple :: forall a b c d e f g h i j k.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU i
-> PU j
-> PU k
-> PU (a, b, c, d, e, f, g, h, i, j, k)
xp11Tuple PU a
a PU b
b PU c
c PU d
d PU e
e PU f
f PU g
g PU h
h PU i
i PU j
j PU k
k
    = forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap ( \ ((a
a, b
b, c
c, d
d, e
e), (f
f, g
g, h
h, i
i, j
j, k
k)) -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k)
             , \ (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k) -> ((a
a, b
b, c
c, d
d, e
e), (f
f, g
g, h
h, i
i, j
j, k
k))
             )
      (forall a b. PU a -> PU b -> PU (a, b)
xpPair (forall a b c d e.
PU a -> PU b -> PU c -> PU d -> PU e -> PU (a, b, c, d, e)
xp5Tuple PU a
a PU b
b PU c
c PU d
d PU e
e) (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU f
f PU g
g PU h
h PU i
i PU j
j PU k
k))

xp12Tuple :: PU a -> PU b -> PU c -> PU d -> PU e ->
             PU f -> PU g -> PU h -> PU i -> PU j ->
             PU k -> PU l -> PU (a, b, c, d, e, f, g, h, i, j, k, l)
xp12Tuple :: forall a b c d e f g h i j k l.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU i
-> PU j
-> PU k
-> PU l
-> PU (a, b, c, d, e, f, g, h, i, j, k, l)
xp12Tuple PU a
a PU b
b PU c
c PU d
d PU e
e PU f
f PU g
g PU h
h PU i
i PU j
j PU k
k PU l
l
    = forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap ( \ ((a
a, b
b, c
c, d
d, e
e, f
f), (g
g, h
h, i
i, j
j, k
k, l
l)) -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l)
             , \ (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l) -> ((a
a, b
b, c
c, d
d, e
e, f
f), (g
g, h
h, i
i, j
j, k
k, l
l))
             )
      (forall a b. PU a -> PU b -> PU (a, b)
xpPair (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU a
a PU b
b PU c
c PU d
d PU e
e PU f
f) (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU g
g PU h
h PU i
i PU j
j PU k
k PU l
l))

xp13Tuple :: PU a -> PU b -> PU c -> PU d -> PU e ->
             PU f -> PU g -> PU h -> PU i -> PU j ->
             PU k -> PU l -> PU m -> PU (a, b, c, d, e, f, g, h, i, j, k, l, m)
xp13Tuple :: forall a b c d e f g h i j k l m.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU i
-> PU j
-> PU k
-> PU l
-> PU m
-> PU (a, b, c, d, e, f, g, h, i, j, k, l, m)
xp13Tuple PU a
a PU b
b PU c
c PU d
d PU e
e PU f
f PU g
g PU h
h PU i
i PU j
j PU k
k PU l
l PU m
m
    = forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap ( \ (a
a, (b
b, c
c, d
d, e
e, f
f, g
g), (h
h, i
i, j
j, k
k, l
l, m
m)) -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l, m
m)
             , \ (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l, m
m) -> (a
a, (b
b, c
c, d
d, e
e, f
f, g
g), (h
h, i
i, j
j, k
k, l
l, m
m))
             )
      (forall a b c. PU a -> PU b -> PU c -> PU (a, b, c)
xpTriple PU a
a (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU b
b PU c
c PU d
d PU e
e PU f
f PU g
g) (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU h
h PU i
i PU j
j PU k
k PU l
l PU m
m))

xp14Tuple :: PU a -> PU b -> PU c -> PU d -> PU e ->
             PU f -> PU g -> PU h -> PU i -> PU j ->
             PU k -> PU l -> PU m -> PU n -> PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
xp14Tuple :: forall a b c d e f g h i j k l m n.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU i
-> PU j
-> PU k
-> PU l
-> PU m
-> PU n
-> PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
xp14Tuple PU a
a PU b
b PU c
c PU d
d PU e
e PU f
f PU g
g PU h
h PU i
i PU j
j PU k
k PU l
l PU m
m PU n
n
    = forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap ( \ ((a
a, b
b), (c
c, d
d, e
e, f
f, g
g, h
h), (i
i, j
j, k
k, l
l, m
m, n
n)) -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l, m
m, n
n)
             , \ (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l, m
m, n
n) -> ((a
a, b
b), (c
c, d
d, e
e, f
f, g
g, h
h), (i
i, j
j, k
k, l
l, m
m, n
n))
             )
      (forall a b c. PU a -> PU b -> PU c -> PU (a, b, c)
xpTriple (forall a b. PU a -> PU b -> PU (a, b)
xpPair PU a
a PU b
b) (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU c
c PU d
d PU e
e PU f
f PU g
g PU h
h) (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU i
i PU j
j PU k
k PU l
l PU m
m PU n
n))

xp15Tuple :: PU a -> PU b -> PU c -> PU d -> PU e ->
             PU f -> PU g -> PU h -> PU i -> PU j ->
             PU k -> PU l -> PU m -> PU n -> PU o ->
             PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
xp15Tuple :: forall a b c d e f g h i j k l m n o.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU i
-> PU j
-> PU k
-> PU l
-> PU m
-> PU n
-> PU o
-> PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
xp15Tuple PU a
a PU b
b PU c
c PU d
d PU e
e PU f
f PU g
g PU h
h PU i
i PU j
j PU k
k PU l
l PU m
m PU n
n PU o
o
    = forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap ( \ ((a
a, b
b, c
c), (d
d, e
e, f
f, g
g, h
h, i
i), (j
j, k
k, l
l, m
m, n
n, o
o)) -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l, m
m, n
n, o
o)
             , \ (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l, m
m, n
n, o
o) -> ((a
a, b
b, c
c), (d
d, e
e, f
f, g
g, h
h, i
i), (j
j, k
k, l
l, m
m, n
n, o
o))
             )
      (forall a b c. PU a -> PU b -> PU c -> PU (a, b, c)
xpTriple (forall a b c. PU a -> PU b -> PU c -> PU (a, b, c)
xpTriple PU a
a PU b
b PU c
c) (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU d
d PU e
e PU f
f PU g
g PU h
h PU i
i) (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU j
j PU k
k PU l
l PU m
m PU n
n PU o
o))

xp16Tuple :: PU a -> PU b -> PU c -> PU d -> PU e ->
             PU f -> PU g -> PU h -> PU i -> PU j ->
             PU k -> PU l -> PU m -> PU n -> PU o ->
             PU p -> PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)
xp16Tuple :: forall a b c d e f g h i j k l m n o p.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU i
-> PU j
-> PU k
-> PU l
-> PU m
-> PU n
-> PU o
-> PU p
-> PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)
xp16Tuple PU a
a PU b
b PU c
c PU d
d PU e
e PU f
f PU g
g PU h
h PU i
i PU j
j PU k
k PU l
l PU m
m PU n
n PU o
o PU p
p
    = forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap ( \ ((a
a, b
b, c
c, d
d), (e
e, f
f, g
g, h
h, i
i, j
j), (k
k, l
l, m
m, n
n, o
o, p
p)) -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l, m
m, n
n, o
o, p
p)
             , \ (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l, m
m, n
n, o
o, p
p) -> ((a
a, b
b, c
c, d
d), (e
e, f
f, g
g, h
h, i
i, j
j), (k
k, l
l, m
m, n
n, o
o, p
p))
             )
      (forall a b c. PU a -> PU b -> PU c -> PU (a, b, c)
xpTriple (forall a b c d. PU a -> PU b -> PU c -> PU d -> PU (a, b, c, d)
xp4Tuple PU a
a PU b
b PU c
c PU d
d) (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU e
e PU f
f PU g
g PU h
h PU i
i PU j
j) (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU k
k PU l
l PU m
m PU n
n PU o
o PU p
p))

xp17Tuple :: PU a -> PU b -> PU c -> PU d -> PU e ->
             PU f -> PU g -> PU h -> PU i -> PU j ->
             PU k -> PU l -> PU m -> PU n -> PU o ->
             PU p -> PU q -> PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q)
xp17Tuple :: forall a b c d e f g h i j k l m n o p q.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU i
-> PU j
-> PU k
-> PU l
-> PU m
-> PU n
-> PU o
-> PU p
-> PU q
-> PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q)
xp17Tuple PU a
a PU b
b PU c
c PU d
d PU e
e PU f
f PU g
g PU h
h PU i
i PU j
j PU k
k PU l
l PU m
m PU n
n PU o
o PU p
p PU q
q
    = forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap ( \ ((a
a, b
b, c
c, d
d, e
e), (f
f, g
g, h
h, i
i, j
j, k
k), (l
l, m
m, n
n, o
o, p
p, q
q)) -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l, m
m, n
n, o
o, p
p, q
q)
             , \ (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l, m
m, n
n, o
o, p
p, q
q) -> ((a
a, b
b, c
c, d
d, e
e), (f
f, g
g, h
h, i
i, j
j, k
k), (l
l, m
m, n
n, o
o, p
p, q
q))
             )
      (forall a b c. PU a -> PU b -> PU c -> PU (a, b, c)
xpTriple (forall a b c d e.
PU a -> PU b -> PU c -> PU d -> PU e -> PU (a, b, c, d, e)
xp5Tuple PU a
a PU b
b PU c
c PU d
d PU e
e) (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU f
f PU g
g PU h
h PU i
i PU j
j PU k
k) (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU l
l PU m
m PU n
n PU o
o PU p
p PU q
q))

xp18Tuple :: PU a -> PU b -> PU c -> PU d -> PU e ->
             PU f -> PU g -> PU h -> PU i -> PU j ->
             PU k -> PU l -> PU m -> PU n -> PU o ->
             PU p -> PU q -> PU r -> PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r)
xp18Tuple :: forall a b c d e f g h i j k l m n o p q r.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU i
-> PU j
-> PU k
-> PU l
-> PU m
-> PU n
-> PU o
-> PU p
-> PU q
-> PU r
-> PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r)
xp18Tuple PU a
a PU b
b PU c
c PU d
d PU e
e PU f
f PU g
g PU h
h PU i
i PU j
j PU k
k PU l
l PU m
m PU n
n PU o
o PU p
p PU q
q PU r
r
    = forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap ( \ ((a
a, b
b, c
c, d
d, e
e, f
f), (g
g, h
h, i
i, j
j, k
k, l
l), (m
m, n
n, o
o, p
p, q
q, r
r)) -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l, m
m, n
n, o
o, p
p, q
q, r
r)
             , \ (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l, m
m, n
n, o
o, p
p, q
q, r
r) -> ((a
a, b
b, c
c, d
d, e
e, f
f), (g
g, h
h, i
i, j
j, k
k, l
l), (m
m, n
n, o
o, p
p, q
q, r
r))
             )
      (forall a b c. PU a -> PU b -> PU c -> PU (a, b, c)
xpTriple (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU a
a PU b
b PU c
c PU d
d PU e
e PU f
f) (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU g
g PU h
h PU i
i PU j
j PU k
k PU l
l) (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU m
m PU n
n PU o
o PU p
p PU q
q PU r
r))

xp19Tuple :: PU a -> PU b -> PU c -> PU d -> PU e ->
             PU f -> PU g -> PU h -> PU i -> PU j ->
             PU k -> PU l -> PU m -> PU n -> PU o ->
             PU p -> PU q -> PU r -> PU s -> PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s)
xp19Tuple :: forall a b c d e f g h i j k l m n o p q r s.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU i
-> PU j
-> PU k
-> PU l
-> PU m
-> PU n
-> PU o
-> PU p
-> PU q
-> PU r
-> PU s
-> PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s)
xp19Tuple PU a
a PU b
b PU c
c PU d
d PU e
e PU f
f PU g
g PU h
h PU i
i PU j
j PU k
k PU l
l PU m
m PU n
n PU o
o PU p
p PU q
q PU r
r PU s
s
    = forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap ( \ (a
a, (b
b, c
c, d
d, e
e, f
f, g
g), (h
h, i
i, j
j, k
k, l
l, m
m), (n
n, o
o, p
p, q
q, r
r, s
s)) -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l, m
m, n
n, o
o, p
p, q
q, r
r, s
s)
             , \ (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l, m
m, n
n, o
o, p
p, q
q, r
r, s
s) -> (a
a, (b
b, c
c, d
d, e
e, f
f, g
g), (h
h, i
i, j
j, k
k, l
l, m
m), (n
n, o
o, p
p, q
q, r
r, s
s))
             )
      (forall a b c d. PU a -> PU b -> PU c -> PU d -> PU (a, b, c, d)
xp4Tuple PU a
a (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU b
b PU c
c PU d
d PU e
e PU f
f PU g
g) (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU h
h PU i
i PU j
j PU k
k PU l
l PU m
m) (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU n
n PU o
o PU p
p PU q
q PU r
r PU s
s))

xp20Tuple :: PU a -> PU b -> PU c -> PU d -> PU e ->
             PU f -> PU g -> PU h -> PU i -> PU j ->
             PU k -> PU l -> PU m -> PU n -> PU o ->
             PU p -> PU q -> PU r -> PU s -> PU t ->
             PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t)
xp20Tuple :: forall a b c d e f g h i j k l m n o p q r s t.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU i
-> PU j
-> PU k
-> PU l
-> PU m
-> PU n
-> PU o
-> PU p
-> PU q
-> PU r
-> PU s
-> PU t
-> PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t)
xp20Tuple PU a
a PU b
b PU c
c PU d
d PU e
e PU f
f PU g
g PU h
h PU i
i PU j
j PU k
k PU l
l PU m
m PU n
n PU o
o PU p
p PU q
q PU r
r PU s
s PU t
t
    = forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap ( \ ((a
a, b
b), (c
c, d
d, e
e, f
f, g
g, h
h), (i
i, j
j, k
k, l
l, m
m, n
n), (o
o, p
p, q
q, r
r, s
s, t
t)) -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l, m
m, n
n, o
o, p
p, q
q, r
r, s
s, t
t)
             , \ (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l, m
m, n
n, o
o, p
p, q
q, r
r, s
s, t
t) -> ((a
a, b
b), (c
c, d
d, e
e, f
f, g
g, h
h), (i
i, j
j, k
k, l
l, m
m, n
n), (o
o, p
p, q
q, r
r, s
s, t
t))
             )
      (forall a b c d. PU a -> PU b -> PU c -> PU d -> PU (a, b, c, d)
xp4Tuple (forall a b. PU a -> PU b -> PU (a, b)
xpPair PU a
a PU b
b) (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU c
c PU d
d PU e
e PU f
f PU g
g PU h
h) (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU i
i PU j
j PU k
k PU l
l PU m
m PU n
n) (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU o
o PU p
p PU q
q PU r
r PU s
s PU t
t))

xp21Tuple :: PU a -> PU b -> PU c -> PU d -> PU e ->
             PU f -> PU g -> PU h -> PU i -> PU j ->
             PU k -> PU l -> PU m -> PU n -> PU o ->
             PU p -> PU q -> PU r -> PU s -> PU t ->
             PU u -> PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u)
xp21Tuple :: forall a b c d e f g h i j k l m n o p q r s t u.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU i
-> PU j
-> PU k
-> PU l
-> PU m
-> PU n
-> PU o
-> PU p
-> PU q
-> PU r
-> PU s
-> PU t
-> PU u
-> PU
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u)
xp21Tuple PU a
a PU b
b PU c
c PU d
d PU e
e PU f
f PU g
g PU h
h PU i
i PU j
j PU k
k PU l
l PU m
m PU n
n PU o
o PU p
p PU q
q PU r
r PU s
s PU t
t PU u
u
    = forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap ( \ ((a
a, b
b, c
c), (d
d, e
e, f
f, g
g, h
h, i
i), (j
j, k
k, l
l, m
m, n
n, o
o), (p
p, q
q, r
r, s
s, t
t, u
u)) -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l, m
m, n
n, o
o, p
p, q
q, r
r, s
s, t
t, u
u)
             , \ (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l, m
m, n
n, o
o, p
p, q
q, r
r, s
s, t
t, u
u) -> ((a
a, b
b, c
c), (d
d, e
e, f
f, g
g, h
h, i
i), (j
j, k
k, l
l, m
m, n
n, o
o), (p
p, q
q, r
r, s
s, t
t, u
u))
             )
      (forall a b c d. PU a -> PU b -> PU c -> PU d -> PU (a, b, c, d)
xp4Tuple (forall a b c. PU a -> PU b -> PU c -> PU (a, b, c)
xpTriple PU a
a PU b
b PU c
c) (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU d
d PU e
e PU f
f PU g
g PU h
h PU i
i) (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU j
j PU k
k PU l
l PU m
m PU n
n PU o
o) (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU p
p PU q
q PU r
r PU s
s PU t
t PU u
u))

xp22Tuple :: PU a -> PU b -> PU c -> PU d -> PU e ->
             PU f -> PU g -> PU h -> PU i -> PU j ->
             PU k -> PU l -> PU m -> PU n -> PU o ->
             PU p -> PU q -> PU r -> PU s -> PU t ->
             PU u -> PU v -> PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v)
xp22Tuple :: forall a b c d e f g h i j k l m n o p q r s t u v.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU i
-> PU j
-> PU k
-> PU l
-> PU m
-> PU n
-> PU o
-> PU p
-> PU q
-> PU r
-> PU s
-> PU t
-> PU u
-> PU v
-> PU
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v)
xp22Tuple PU a
a PU b
b PU c
c PU d
d PU e
e PU f
f PU g
g PU h
h PU i
i PU j
j PU k
k PU l
l PU m
m PU n
n PU o
o PU p
p PU q
q PU r
r PU s
s PU t
t PU u
u PU v
v
    = forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap ( \ ((a
a, b
b, c
c, d
d), (e
e, f
f, g
g, h
h, i
i, j
j), (k
k, l
l, m
m, n
n, o
o, p
p), (q
q, r
r, s
s, t
t, u
u, v
v)) -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l, m
m, n
n, o
o, p
p, q
q, r
r, s
s, t
t, u
u, v
v)
             , \ (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l, m
m, n
n, o
o, p
p, q
q, r
r, s
s, t
t, u
u, v
v) -> ((a
a, b
b, c
c, d
d), (e
e, f
f, g
g, h
h, i
i, j
j), (k
k, l
l, m
m, n
n, o
o, p
p), (q
q, r
r, s
s, t
t, u
u, v
v))
             )
      (forall a b c d. PU a -> PU b -> PU c -> PU d -> PU (a, b, c, d)
xp4Tuple (forall a b c d. PU a -> PU b -> PU c -> PU d -> PU (a, b, c, d)
xp4Tuple PU a
a PU b
b PU c
c PU d
d) (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU e
e PU f
f PU g
g PU h
h PU i
i PU j
j) (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU k
k PU l
l PU m
m PU n
n PU o
o PU p
p) (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU q
q PU r
r PU s
s PU t
t PU u
u PU v
v))

xp23Tuple :: PU a -> PU b -> PU c -> PU d -> PU e ->
             PU f -> PU g -> PU h -> PU i -> PU j ->
             PU k -> PU l -> PU m -> PU n -> PU o ->
             PU p -> PU q -> PU r -> PU s -> PU t ->
             PU u -> PU v -> PU w -> PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v, w)
xp23Tuple :: forall a b c d e f g h i j k l m n o p q r s t u v w.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU i
-> PU j
-> PU k
-> PU l
-> PU m
-> PU n
-> PU o
-> PU p
-> PU q
-> PU r
-> PU s
-> PU t
-> PU u
-> PU v
-> PU w
-> PU
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w)
xp23Tuple PU a
a PU b
b PU c
c PU d
d PU e
e PU f
f PU g
g PU h
h PU i
i PU j
j PU k
k PU l
l PU m
m PU n
n PU o
o PU p
p PU q
q PU r
r PU s
s PU t
t PU u
u PU v
v PU w
w
    = forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap ( \ ((a
a, b
b, c
c, d
d, e
e), (f
f, g
g, h
h, i
i, j
j, k
k), (l
l, m
m, n
n, o
o, p
p, q
q), (r
r, s
s, t
t, u
u, v
v, w
w)) -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l, m
m, n
n, o
o, p
p, q
q, r
r, s
s, t
t, u
u, v
v, w
w)
             , \ (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l, m
m, n
n, o
o, p
p, q
q, r
r, s
s, t
t, u
u, v
v, w
w) -> ((a
a, b
b, c
c, d
d, e
e), (f
f, g
g, h
h, i
i, j
j, k
k), (l
l, m
m, n
n, o
o, p
p, q
q), (r
r, s
s, t
t, u
u, v
v, w
w))
             )
      (forall a b c d. PU a -> PU b -> PU c -> PU d -> PU (a, b, c, d)
xp4Tuple (forall a b c d e.
PU a -> PU b -> PU c -> PU d -> PU e -> PU (a, b, c, d, e)
xp5Tuple PU a
a PU b
b PU c
c PU d
d PU e
e) (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU f
f PU g
g PU h
h PU i
i PU j
j PU k
k) (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU l
l PU m
m PU n
n PU o
o PU p
p PU q
q) (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU r
r PU s
s PU t
t PU u
u PU v
v PU w
w))

-- | Hopefully no one needs a xp25Tuple

xp24Tuple :: PU a -> PU b -> PU c -> PU d -> PU e ->
             PU f -> PU g -> PU h -> PU i -> PU j ->
             PU k -> PU l -> PU m -> PU n -> PU o ->
             PU p -> PU q -> PU r -> PU s -> PU t ->
             PU u -> PU v -> PU w -> PU x -> PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v, w, x)
xp24Tuple :: forall a b c d e f g h i j k l m n o p q r s t u v w x.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU i
-> PU j
-> PU k
-> PU l
-> PU m
-> PU n
-> PU o
-> PU p
-> PU q
-> PU r
-> PU s
-> PU t
-> PU u
-> PU v
-> PU w
-> PU x
-> PU
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x)
xp24Tuple PU a
a PU b
b PU c
c PU d
d PU e
e PU f
f PU g
g PU h
h PU i
i PU j
j PU k
k PU l
l PU m
m PU n
n PU o
o PU p
p PU q
q PU r
r PU s
s PU t
t PU u
u PU v
v PU w
w PU x
x
    = forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap ( \ ((a
a, b
b, c
c, d
d, e
e, f
f), (g
g, h
h, i
i, j
j, k
k, l
l), (m
m, n
n, o
o, p
p, q
q, r
r), (s
s, t
t, u
u, v
v, w
w, x
x)) -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l, m
m, n
n, o
o, p
p, q
q, r
r, s
s, t
t, u
u, v
v, w
w, x
x)
             , \ (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l, m
m, n
n, o
o, p
p, q
q, r
r, s
s, t
t, u
u, v
v, w
w, x
x) -> ((a
a, b
b, c
c, d
d, e
e, f
f), (g
g, h
h, i
i, j
j, k
k, l
l), (m
m, n
n, o
o, p
p, q
q, r
r), (s
s, t
t, u
u, v
v, w
w, x
x))
             )
      (forall a b c d. PU a -> PU b -> PU c -> PU d -> PU (a, b, c, d)
xp4Tuple (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU a
a PU b
b PU c
c PU d
d PU e
e PU f
f) (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU g
g PU h
h PU i
i PU j
j PU k
k PU l
l) (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU m
m PU n
n PU o
o PU p
p PU q
q PU r
r) (forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple PU s
s PU t
t PU u
u PU v
v PU w
w PU x
x))

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


-- | Pickle a string into an XML text node
--
-- One of the most often used primitive picklers. Attention:
-- For pickling empty strings use 'xpText0'. If the text has a more
-- specific datatype than xsd:string, use 'xpTextDT'

xpText  :: PU String
xpText :: PU String
xpText  = Schema -> PU String
xpTextDT Schema
scString1
{-# INLINE xpText #-}

-- | Pickle a string into an XML text node
--
-- Text pickler with a description of the structure of the text
-- by a schema. A schema for a data type can be defined by 'Text.XML.HXT.Arrow.Pickle.Schema.scDT'.
-- In 'Text.XML.HXT.Arrow.Pickle.Schema' there are some more functions for creating
-- simple datatype descriptions.

xpTextDT        :: Schema -> PU String
xpTextDT :: Schema -> PU String
xpTextDT Schema
sc     = PU { appPickle :: Pickler String
appPickle   = XmlTree -> St -> St
putCont forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. XmlNode a => String -> a
XN.mkText
                     , appUnPickle :: Unpickler String
appUnPickle = do XmlTree
t <- Unpickler XmlTree
getCont
                                        forall a. String -> Maybe a -> Unpickler a
liftMaybe String
"xpText: XML text expected" forall a b. (a -> b) -> a -> b
$ forall a. XmlNode a => a -> Maybe String
XN.getText XmlTree
t
                     , theSchema :: Schema
theSchema   = Schema
sc
                     }

-- | Pickle a possibly empty string into an XML node.
--
-- Must be used in all places, where empty strings are legal values.
-- If the content of an element can be an empty string, this string disapears
-- during storing the DOM into a document and reparse the document.
-- So the empty text node becomes nothing, and the pickler must deliver an empty string,
-- if there is no text node in the document.

xpText0         :: PU String
xpText0 :: PU String
xpText0         = Schema -> PU String
xpText0DT Schema
scString1
{-# INLINE xpText0 #-}

-- | Pickle a possibly empty string with a datatype description into an XML node.
--
-- Like 'xpText0' but with extra Parameter for datatype description as in 'xpTextDT'.

xpText0DT       :: Schema -> PU String
xpText0DT :: Schema -> PU String
xpText0DT Schema
sc    = forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap (forall a. a -> Maybe a -> a
fromMaybe String
"", String -> Maybe String
emptyToNothing) forall a b. (a -> b) -> a -> b
$
                  forall a. PU a -> PU (Maybe a)
xpOption forall a b. (a -> b) -> a -> b
$
                  Schema -> PU String
xpTextDT Schema
sc
    where
    emptyToNothing :: String -> Maybe String
emptyToNothing String
"" = forall a. Maybe a
Nothing
    emptyToNothing String
x  = forall a. a -> Maybe a
Just String
x

-- | Pickle an arbitrary value by applyling show during pickling
-- and read during unpickling.
--
-- Real pickling is then done with 'xpText'.
-- One of the most often used pimitive picklers. Applicable for all
-- types which are instances of @Read@ and @Show@

xpPrim                  :: (Read a, Show a) => PU a
xpPrim :: forall a. (Read a, Show a) => PU a
xpPrim                  = forall a b. (a -> Either String b, b -> a) -> PU a -> PU b
xpWrapEither (forall a. Read a => String -> Either String a
readMaybe, forall a. Show a => a -> String
show) PU String
xpText
    where
    readMaybe           :: Read a => String -> Either String a
    readMaybe :: forall a. Read a => String -> Either String a
readMaybe String
str       = forall {b}. [(b, String)] -> Either String b
val (forall a. Read a => ReadS a
reads String
str)
        where
          val :: [(b, String)] -> Either String b
val [(b
x,String
"")]  = forall a b. b -> Either a b
Right b
x
          val [(b, String)]
_         = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"xpPrim: reading string " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
str forall a. [a] -> [a] -> [a]
++ String
" failed"

-- | Pickle an Int
xpInt                   :: PU Int
xpInt :: PU Int
xpInt                   = forall a b. (a -> Either String b, b -> a) -> PU a -> PU b
xpWrapEither (String -> Either String Int
readMaybe, forall a. Show a => a -> String
show) PU String
xpText
    where
      readMaybe :: String -> Either String Int
readMaybe xs :: String
xs@(Char
_:String
_)
          | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
xs = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\ Int
r Char
c -> Int
10 forall a. Num a => a -> a -> a
* Int
r forall a. Num a => a -> a -> a
+ (forall a. Enum a => a -> Int
fromEnum Char
c forall a. Num a => a -> a -> a
- forall a. Enum a => a -> Int
fromEnum Char
'0')) Int
0 forall a b. (a -> b) -> a -> b
$ String
xs
      readMaybe (Char
'-' : String
xs) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int
0 forall a. Num a => a -> a -> a
-) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String Int
readMaybe forall a b. (a -> b) -> a -> b
$ String
xs
      readMaybe (Char
'+' : String
xs) =              String -> Either String Int
readMaybe forall a b. (a -> b) -> a -> b
$ String
xs
      readMaybe        String
xs  = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"xpInt: reading an Int from string " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
xs forall a. [a] -> [a] -> [a]
++ String
" failed"

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

-- | Pickle an XmlTree by just adding it
--
-- Usefull for components of type XmlTree in other data structures

xpTree          :: PU XmlTree
xpTree :: PU XmlTree
xpTree          = PU { appPickle :: XmlTree -> St -> St
appPickle   = XmlTree -> St -> St
putCont
                     , appUnPickle :: Unpickler XmlTree
appUnPickle = Unpickler XmlTree
getCont
                     , theSchema :: Schema
theSchema   = Schema
Any
                     }

-- | Pickle a whole list of XmlTrees by just adding the list, unpickle is done by taking all element contents.
--
-- This pickler should always be combined with 'xpElem' for taking the whole contents of an element.

xpTrees         :: PU [XmlTree]
xpTrees :: PU [XmlTree]
xpTrees         = (forall a. PU a -> PU [a]
xpList PU XmlTree
xpTree) { theSchema :: Schema
theSchema = Schema
Any }

-- | Pickle a string representing XML contents by inserting the tree representation into the XML document.
--
-- Unpickling is done by converting the contents with
-- 'Text.XML.HXT.Arrow.Edit.xshowEscapeXml' into a string,
-- this function will escape all XML special chars, such that pickling the value back becomes save.
-- Pickling is done with 'Text.XML.HXT.Arrow.ReadDocument.xread'

xpXmlText       :: PU String
xpXmlText :: PU String
xpXmlText       = forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap ( [XmlTree] -> String
showXML, String -> [XmlTree]
readXML ) forall a b. (a -> b) -> a -> b
$ PU [XmlTree]
xpTrees
    where
      showXML :: [XmlTree] -> String
showXML   = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. LA a b -> a -> [b]
runLA ( forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n String
xshowEscapeXml forall (a :: * -> * -> *) b. ArrowList a => a [b] b
unlistA )
      readXML :: String -> [XmlTree]
readXML   = forall a b. LA a b -> a -> [b]
runLA forall (a :: * -> * -> *). ArrowXml a => a String XmlTree
xread

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

-- | Encoding of optional data by ignoring the Nothing case during pickling
-- and relying on failure during unpickling to recompute the Nothing case
--
-- The default pickler for Maybe types

xpOption        :: PU a -> PU (Maybe a)
xpOption :: forall a. PU a -> PU (Maybe a)
xpOption PU a
pa     = PU { appPickle :: Pickler (Maybe a)
appPickle  = ( \ Maybe a
a ->
                                      case Maybe a
a of
                                        Maybe a
Nothing -> forall a. a -> a
id
                                        Just a
x  -> forall a. PU a -> Pickler a
appPickle PU a
pa a
x
                                    )

                     , appUnPickle :: Unpickler (Maybe a)
appUnPickle = forall b a. PU b -> PU a -> (a -> PU b) -> Unpickler b
xpChoice (forall a. a -> PU a
xpLift forall a. Maybe a
Nothing) PU a
pa (forall a. a -> PU a
xpLift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just)

                     , theSchema :: Schema
theSchema   = Schema -> Schema
scOption (forall a. PU a -> Schema
theSchema PU a
pa)
                     }

-- | Optional conversion with default value
--
-- The default value is not encoded in the XML document,
-- during unpickling the default value is inserted if the pickler fails

xpDefault       :: (Eq a) => a -> PU a -> PU a
xpDefault :: forall a. Eq a => a -> PU a -> PU a
xpDefault a
df    = forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap ( forall a. a -> Maybe a -> a
fromMaybe a
df
                         , \ a
x -> if a
x forall a. Eq a => a -> a -> Bool
== a
df then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just a
x
                         ) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  forall a. PU a -> PU (Maybe a)
xpOption

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

-- | Encoding of list values by pickling all list elements sequentially.
--
-- Unpickler relies on failure for detecting the end of the list.
-- The standard pickler for lists. Can also be used in combination with 'xpWrap'
-- for constructing set and map picklers

xpList          :: PU a -> PU [a]
xpList :: forall a. PU a -> PU [a]
xpList PU a
pa       = PU { appPickle :: Pickler [a]
appPickle  = ( \ [a]
a ->
                                      case [a]
a of
                                        []  -> forall a. a -> a
id
                                        a
_:[a]
_ -> forall a. PU a -> Pickler a
appPickle PU [a]
pc [a]
a
                                    )
                     , appUnPickle :: Unpickler [a]
appUnPickle = forall b a. PU b -> PU a -> (a -> PU b) -> Unpickler b
xpChoice
                                     (forall a. a -> PU a
xpLift [])
                                     PU a
pa
                                     (\ a
x -> forall b a. (b -> a) -> PU a -> (a -> PU b) -> PU b
xpSeq forall a. a -> a
id (forall a. PU a -> PU [a]
xpList PU a
pa) (\[a]
xs -> forall a. a -> PU a
xpLift (a
xforall a. a -> [a] -> [a]
:[a]
xs)))

                     , theSchema :: Schema
theSchema   = Schema -> Schema
scList (forall a. PU a -> Schema
theSchema PU a
pa)
                     }
      where
      pc :: PU [a]
pc        = forall b a. (b -> a) -> PU a -> (a -> PU b) -> PU b
xpSeq forall a. [a] -> a
head  PU a
pa         (\ a
x  ->
                  forall b a. (b -> a) -> PU a -> (a -> PU b) -> PU b
xpSeq forall a. [a] -> [a]
tail (forall a. PU a -> PU [a]
xpList PU a
pa) (\ [a]
xs ->
                  forall a. a -> PU a
xpLift (a
xforall a. a -> [a] -> [a]
:[a]
xs)          ))

-- | Encoding of a none empty list of values
--
-- Attention: when calling this pickler with an empty list,
-- an internal error \"head of empty list is raised\".

xpList1         :: PU a -> PU [a]
xpList1 :: forall a. PU a -> PU [a]
xpList1 PU a
pa      = ( forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap (\ (a
x, [a]
xs) -> a
x forall a. a -> [a] -> [a]
: [a]
xs
                           ,\ [a]
x -> (forall a. [a] -> a
head [a]
x, forall a. [a] -> [a]
tail [a]
x)
                           ) forall a b. (a -> b) -> a -> b
$
                    forall a b. PU a -> PU b -> PU (a, b)
xpPair PU a
pa (forall a. PU a -> PU [a]
xpList PU a
pa)
                  ) { theSchema :: Schema
theSchema = Schema -> Schema
scList1 (forall a. PU a -> Schema
theSchema PU a
pa) }

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

-- | Standard pickler for maps
--
-- This pickler converts a map into a list of pairs.
-- All key value pairs are mapped to an element with name (1.arg),
-- the key is encoded as an attribute named by the 2. argument,
-- the 3. arg is the pickler for the keys, the last one for the values

xpMap           :: Ord k => String -> String -> PU k -> PU v -> PU (Map k v)
xpMap :: forall k v.
Ord k =>
String -> String -> PU k -> PU v -> PU (Map k v)
xpMap String
en String
an PU k
xpk PU v
xpv
                = forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap ( forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
                         , forall k a. Map k a -> [(k, a)]
M.toList
                         ) forall a b. (a -> b) -> a -> b
$
                  forall a. PU a -> PU [a]
xpList forall a b. (a -> b) -> a -> b
$
                  forall a. String -> PU a -> PU a
xpElem String
en forall a b. (a -> b) -> a -> b
$
                  forall a b. PU a -> PU b -> PU (a, b)
xpPair ( forall a. String -> PU a -> PU a
xpAttr String
an forall a b. (a -> b) -> a -> b
$ PU k
xpk ) PU v
xpv

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

-- | Pickler for sum data types.
--
-- Every constructor is mapped to an index into the list of picklers.
-- The index is used only during pickling, not during unpickling, there the 1. match is taken

xpAlt           :: (a -> Int) -> [PU a] -> PU a
xpAlt :: forall a. (a -> Int) -> [PU a] -> PU a
xpAlt a -> Int
tag [PU a]
ps    = PU { appPickle :: Pickler a
appPickle   = \ a
a ->
                                     forall a. PU a -> Pickler a
appPickle ([PU a]
ps forall a. [a] -> Int -> a
!! a -> Int
tag a
a) a
a

                     , appUnPickle :: Unpickler a
appUnPickle = case [PU a]
ps of
                                       []     -> forall a. String -> Unpickler a
throwMsg String
"xpAlt: no matching unpickler found for a sum datatype"
                                       PU a
pa:[PU a]
ps1 -> forall b a. PU b -> PU a -> (a -> PU b) -> Unpickler b
xpChoice (forall a. (a -> Int) -> [PU a] -> PU a
xpAlt a -> Int
tag [PU a]
ps1) PU a
pa forall a. a -> PU a
xpLift

                     , theSchema :: Schema
theSchema   = [Schema] -> Schema
scAlts (forall a b. (a -> b) -> [a] -> [b]
map forall a. PU a -> Schema
theSchema [PU a]
ps)
                     }

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

-- | Pickler for wrapping\/unwrapping data into an XML element
--
-- Extra parameter is the element name given as a QName. THE pickler for constructing
-- nested structures
--
-- Example:
--
-- > xpElemQN (mkName "number") $ xpickle
--
-- will map an (42::Int) onto
--
-- > <number>42</number>

xpElemQN        :: QName -> PU a -> PU a
xpElemQN :: forall a. QName -> PU a -> PU a
xpElemQN QName
qn PU a
pa  = PU { appPickle :: Pickler a
appPickle   = ( \ a
a ->
                                       let st' :: St
st' = forall a. PU a -> Pickler a
appPickle PU a
pa a
a St
emptySt in
                                       XmlTree -> St -> St
putCont (QName -> [XmlTree] -> [XmlTree] -> XmlTree
XN.mkElement QName
qn (St -> [XmlTree]
attributes St
st') (St -> [XmlTree]
contents St
st'))
                                     )
                     , appUnPickle :: Unpickler a
appUnPickle = Unpickler a
upElem
                     , theSchema :: Schema
theSchema   = String -> Schema -> Schema
scElem (QName -> String
qualifiedName QName
qn) (forall a. PU a -> Schema
theSchema PU a
pa)
                     }
      where
      upElem :: Unpickler a
upElem    = do XmlTree
t <- Unpickler XmlTree
getCont
                     QName
n <- forall a. String -> Maybe a -> Unpickler a
liftMaybe String
"xpElem: XML element expected" forall a b. (a -> b) -> a -> b
$ forall a. XmlNode a => a -> Maybe QName
XN.getElemName XmlTree
t
                     if QName
n forall a. Eq a => a -> a -> Bool
/= QName
qn
                        then forall a. String -> Unpickler a
throwMsg (String
"xpElem: got element name " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show QName
n forall a. [a] -> [a] -> [a]
++ String
", but expected " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show QName
qn)
                        else do Int
l <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets St -> Int
nesting
                                forall a. UnpickleVal a -> Unpickler a
liftUnpickleVal forall a b. (a -> b) -> a -> b
$ forall a. PU a -> Int -> XmlTree -> UnpickleVal a
unpickleElem' (forall a. PU a -> PU a
xpCheckEmpty PU a
pa) (Int
l forall a. Num a => a -> a -> a
+ Int
1) XmlTree
t

-- | convenient Pickler for xpElemQN
--
-- > xpElem n = xpElemQN (mkName n)

xpElem          :: String -> PU a -> PU a
xpElem :: forall a. String -> PU a -> PU a
xpElem          = forall a. QName -> PU a -> PU a
xpElemQN forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> QName
mkName

-- | convenient Pickler for xpElemQN
--   for pickling elements with respect to namespaces
--
-- > xpElemNS ns px lp = xpElemQN (mkQName px lp ns)

xpElemNS        :: String -> String -> String -> PU a -> PU a
xpElemNS :: forall a. String -> String -> String -> PU a -> PU a
xpElemNS String
ns String
px String
lp
                = forall a. QName -> PU a -> PU a
xpElemQN forall a b. (a -> b) -> a -> b
$ String -> String -> String -> QName
mkQName String
px String
lp String
ns

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

-- | Pickler for wrapping\/unwrapping data into an XML element with an attribute with given value
--
-- To make XML structures flexible but limit the number of different elements, it's sometimes
-- useful to use a kind of generic element with a key value structure
--
-- Example:
--
-- > <attr name="key1">value1</attr>
-- > <attr name="key2">value2</attr>
-- > <attr name="key3">value3</attr>
--
-- the Haskell datatype may look like this
--
-- > type T = T { key1 :: Int ; key2 :: String ; key3 :: Double }
--
-- Then the picker for that type looks like this
--
-- > xpT :: PU T
-- > xpT = xpWrap ( uncurry3 T, \ t -> (key1 t, key2 t, key3 t) ) $
-- >       xpTriple (xpElemWithAttrValue "attr" "name" "key1" $ xpickle)
-- >                (xpElemWithAttrValue "attr" "name" "key2" $ xpText0)
-- >                (xpElemWithAttrValue "attr" "name" "key3" $ xpickle)

xpElemWithAttrValue     :: String -> String -> String -> PU a -> PU a
xpElemWithAttrValue :: forall a. String -> String -> String -> PU a -> PU a
xpElemWithAttrValue String
name String
an String
av PU a
pa
                = forall a. String -> PU a -> PU a
xpElem String
name forall a b. (a -> b) -> a -> b
$
                  forall a. String -> String -> PU a -> PU a
xpAddFixedAttr String
an String
av forall a b. (a -> b) -> a -> b
$
                  PU a
pa

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

-- | Pickler for storing\/retreiving data into\/from an attribute value
--
-- The attribute is inserted in the surrounding element constructed by the 'xpElem' pickler

xpAttrQN        :: QName -> PU a -> PU a
xpAttrQN :: forall a. QName -> PU a -> PU a
xpAttrQN QName
qn PU a
pa  = PU { appPickle :: Pickler a
appPickle   = ( \ a
a ->
                                       let st' :: St
st' = forall a. PU a -> Pickler a
appPickle PU a
pa a
a St
emptySt in
                                       QName -> [XmlTree] -> St -> St
putAtt QName
qn (St -> [XmlTree]
contents St
st')
                                     )
                     , appUnPickle :: Unpickler a
appUnPickle = Unpickler a
upAttr
                     , theSchema :: Schema
theSchema   = String -> Schema -> Schema
scAttr (QName -> String
qualifiedName QName
qn) (forall a. PU a -> Schema
theSchema PU a
pa)
                     }
      where
      upAttr :: Unpickler a
upAttr    = do XmlTree
a <- QName -> Unpickler XmlTree
getAtt QName
qn
                     Int
l <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets St -> Int
nesting
                     forall a. UnpickleVal a -> Unpickler a
liftUnpickleVal forall a b. (a -> b) -> a -> b
$ forall a. PU a -> Int -> XmlTree -> UnpickleVal a
unpickleElem' (forall a. PU a -> PU a
xpCheckEmptyContents PU a
pa) Int
l XmlTree
a

-- | convenient Pickler for xpAttrQN
--
-- > xpAttr n = xpAttrQN (mkName n)

xpAttr          :: String -> PU a -> PU a
xpAttr :: forall a. String -> PU a -> PU a
xpAttr          = forall a. QName -> PU a -> PU a
xpAttrQN forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> QName
mkName

-- | convenient Pickler for xpAttrQN
--
-- > xpAttr ns px lp = xpAttrQN (mkQName px lp ns)

xpAttrNS        :: String -> String -> String -> PU a -> PU a
xpAttrNS :: forall a. String -> String -> String -> PU a -> PU a
xpAttrNS String
ns String
px String
lp
                = forall a. QName -> PU a -> PU a
xpAttrQN (String -> String -> String -> QName
mkQName String
px String
lp String
ns)

-- | A text attribute.
xpTextAttr      :: String -> PU String
xpTextAttr :: String -> PU String
xpTextAttr      = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. String -> PU a -> PU a
xpAttr PU String
xpText

-- | Add an optional attribute for an optional value (Maybe a).

xpAttrImplied   :: String -> PU a -> PU (Maybe a)
xpAttrImplied :: forall a. String -> PU a -> PU (Maybe a)
xpAttrImplied String
name PU a
pa
                = forall a. PU a -> PU (Maybe a)
xpOption forall a b. (a -> b) -> a -> b
$ forall a. String -> PU a -> PU a
xpAttr String
name PU a
pa

xpAttrFixed     :: String -> String -> PU ()
xpAttrFixed :: String -> String -> PU ()
xpAttrFixed String
name String
val
                = ( forall a b. (a -> Either String b, b -> a) -> PU a -> PU b
xpWrapEither ( \ String
v ->
                                   if String
v forall a. Eq a => a -> a -> Bool
== String
val
                                   then forall a b. b -> Either a b
Right ()
                                   else forall a b. a -> Either a b
Left ( String
"xpAttrFixed: value "
                                               forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
val
                                               forall a. [a] -> [a] -> [a]
++ String
" expected, but got "
                                               forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
v
                                             )
                                 , forall a b. a -> b -> a
const String
val
                                 ) forall a b. (a -> b) -> a -> b
$
                    forall a. String -> PU a -> PU a
xpAttr String
name PU String
xpText
                  ) { theSchema :: Schema
theSchema   = String -> Schema -> Schema
scAttr String
name (String -> Schema
scFixed String
val) }

-- | Add/Check an attribute with a fixed value.
--

xpAddFixedAttr  :: String -> String -> PU a -> PU a
xpAddFixedAttr :: forall a. String -> String -> PU a -> PU a
xpAddFixedAttr String
name String
val
                = forall a. PU () -> PU a -> PU a
xpSeq' forall a b. (a -> b) -> a -> b
$ String -> String -> PU ()
xpAttrFixed String
name String
val

-- | Add a namespace declaration.
--
-- When generating XML the namespace decl is added,
-- when reading a document, the unpickler checks
-- whether there is a namespace declaration for the given
-- namespace URI (2. arg)

xpAddNSDecl  :: String -> String -> PU a -> PU a
xpAddNSDecl :: forall a. String -> String -> PU a -> PU a
xpAddNSDecl String
name String
val
                = forall a. PU () -> PU a -> PU a
xpSeq' forall a b. (a -> b) -> a -> b
$ String -> String -> PU ()
xpAttrNSDecl String
name' String
val
    where
      name' :: String
name'
          | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
name = String
"xmlns"
          | Bool
otherwise = String
"xmlns:" forall a. [a] -> [a] -> [a]
++ String
name

xpAttrNSDecl     :: String -> String -> PU ()
xpAttrNSDecl :: String -> String -> PU ()
xpAttrNSDecl String
name String
ns
                 = PU { appPickle :: Pickler ()
appPickle   = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ QName -> [XmlTree] -> St -> St
putAtt (String -> QName
mkName String
name) [forall a. XmlNode a => String -> a
XN.mkText String
ns]
                      , appUnPickle :: Unpickler ()
appUnPickle = String -> Unpickler ()
getNSAtt String
ns
                      , theSchema :: Schema
theSchema   = String -> Schema -> Schema
scAttr String
name (String -> Schema
scFixed String
ns)
                      }

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

xpIgnoreCont    :: LA XmlTree XmlTree -> PU ()
xpIgnoreCont :: LA XmlTree XmlTree -> PU ()
xpIgnoreCont    = (([XmlTree] -> [XmlTree]) -> St -> St)
-> LA XmlTree XmlTree -> PU ()
xpIgnoreInput forall a b. (a -> b) -> a -> b
$ \ [XmlTree] -> [XmlTree]
mf St
s -> St
s {contents :: [XmlTree]
contents   = [XmlTree] -> [XmlTree]
mf forall a b. (a -> b) -> a -> b
$ St -> [XmlTree]
contents   St
s}

xpIgnoreAttr    :: LA XmlTree XmlTree -> PU ()
xpIgnoreAttr :: LA XmlTree XmlTree -> PU ()
xpIgnoreAttr    = (([XmlTree] -> [XmlTree]) -> St -> St)
-> LA XmlTree XmlTree -> PU ()
xpIgnoreInput forall a b. (a -> b) -> a -> b
$ \ [XmlTree] -> [XmlTree]
mf St
s -> St
s {attributes :: [XmlTree]
attributes = [XmlTree] -> [XmlTree]
mf forall a b. (a -> b) -> a -> b
$ St -> [XmlTree]
attributes St
s}

-- | When unpickling, filter the contents of the element currently processed,
-- before applying the pickler argument
--
-- Maybe useful to ignore some stuff in the input, or to do some cleanup before unpickling.

xpFilterCont    :: LA XmlTree XmlTree -> PU a -> PU a
xpFilterCont :: forall a. LA XmlTree XmlTree -> PU a -> PU a
xpFilterCont LA XmlTree XmlTree
f  = forall a. PU () -> PU a -> PU a
xpSeq' forall a b. (a -> b) -> a -> b
$ LA XmlTree XmlTree -> PU ()
xpIgnoreCont LA XmlTree XmlTree
f

-- | Same as 'xpFilterCont' but for the  attribute list of the element currently processed.
--
-- Maybe useful to ignore some stuff in the input, e.g. class attributes, or to do some cleanup before unpickling.

xpFilterAttr    :: LA XmlTree XmlTree -> PU a -> PU a
xpFilterAttr :: forall a. LA XmlTree XmlTree -> PU a -> PU a
xpFilterAttr LA XmlTree XmlTree
f  = forall a. PU () -> PU a -> PU a
xpSeq' forall a b. (a -> b) -> a -> b
$ LA XmlTree XmlTree -> PU ()
xpIgnoreAttr LA XmlTree XmlTree
f

xpIgnoreInput   :: (([XmlTree] -> [XmlTree]) -> St -> St) -> LA XmlTree XmlTree -> PU ()
xpIgnoreInput :: (([XmlTree] -> [XmlTree]) -> St -> St)
-> LA XmlTree XmlTree -> PU ()
xpIgnoreInput ([XmlTree] -> [XmlTree]) -> St -> St
m LA XmlTree XmlTree
f
                =  PU { appPickle :: Pickler ()
appPickle   = forall a b. a -> b -> a
const forall a. a -> a
id
                      , appUnPickle :: Unpickler ()
appUnPickle = do forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (([XmlTree] -> [XmlTree]) -> St -> St
m [XmlTree] -> [XmlTree]
filterCont)
                                         forall (m :: * -> *) a. Monad m => a -> m a
return ()
                      , theSchema :: Schema
theSchema   = Schema
scNull
                      }
    where
      filterCont :: [XmlTree] -> [XmlTree]
filterCont = forall a b. LA a b -> a -> [b]
runLA (forall (a :: * -> * -> *) b. ArrowList a => a [b] b
unlistA forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> LA XmlTree XmlTree
f)

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

-- | The class for overloading 'xpickle', the default pickler

class XmlPickler a where
    xpickle :: PU a

instance XmlPickler Int where
    xpickle :: PU Int
xpickle = forall a. (Read a, Show a) => PU a
xpPrim

instance XmlPickler Integer where
    xpickle :: PU Integer
xpickle = forall a. (Read a, Show a) => PU a
xpPrim

{-
  no instance of XmlPickler Char
  because then every text would be encoded
  char by char, because of the instance for lists

instance XmlPickler Char where
    xpickle = xpPrim
-}

instance XmlPickler () where
    xpickle :: PU ()
xpickle = PU ()
xpUnit

instance (XmlPickler a, XmlPickler b) => XmlPickler (a,b) where
    xpickle :: PU (a, b)
xpickle = forall a b. PU a -> PU b -> PU (a, b)
xpPair forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle

instance (XmlPickler a, XmlPickler b, XmlPickler c) => XmlPickler (a,b,c) where
    xpickle :: PU (a, b, c)
xpickle = forall a b c. PU a -> PU b -> PU c -> PU (a, b, c)
xpTriple forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle

instance (XmlPickler a, XmlPickler b, XmlPickler c, XmlPickler d) => XmlPickler (a,b,c,d) where
    xpickle :: PU (a, b, c, d)
xpickle = forall a b c d. PU a -> PU b -> PU c -> PU d -> PU (a, b, c, d)
xp4Tuple forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle

instance (XmlPickler a, XmlPickler b, XmlPickler c, XmlPickler d, XmlPickler e) => XmlPickler (a,b,c,d,e) where
    xpickle :: PU (a, b, c, d, e)
xpickle = forall a b c d e.
PU a -> PU b -> PU c -> PU d -> PU e -> PU (a, b, c, d, e)
xp5Tuple forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle

instance (XmlPickler a, XmlPickler b, XmlPickler c, XmlPickler d, XmlPickler e, XmlPickler f) => XmlPickler (a, b, c, d, e, f) where
  xpickle :: PU (a, b, c, d, e, f)
xpickle = forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
xp6Tuple forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle

instance (XmlPickler a, XmlPickler b, XmlPickler c, XmlPickler d, XmlPickler e, XmlPickler f, XmlPickler g) => XmlPickler (a, b, c, d, e, f, g) where
  xpickle :: PU (a, b, c, d, e, f, g)
xpickle = forall a b c d e f g.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU (a, b, c, d, e, f, g)
xp7Tuple forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle

instance (XmlPickler a, XmlPickler b, XmlPickler c, XmlPickler d, XmlPickler e, XmlPickler f, XmlPickler g, XmlPickler h) => XmlPickler (a, b, c, d, e, f, g, h) where
  xpickle :: PU (a, b, c, d, e, f, g, h)
xpickle = forall a b c d e f g h.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU (a, b, c, d, e, f, g, h)
xp8Tuple forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle

instance (XmlPickler a, XmlPickler b, XmlPickler c, XmlPickler d, XmlPickler e, XmlPickler f, XmlPickler g, XmlPickler h, XmlPickler i) => XmlPickler (a, b, c, d, e, f, g, h, i) where
  xpickle :: PU (a, b, c, d, e, f, g, h, i)
xpickle = forall a b c d e f g h i.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU i
-> PU (a, b, c, d, e, f, g, h, i)
xp9Tuple forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle

instance (XmlPickler a, XmlPickler b, XmlPickler c, XmlPickler d, XmlPickler e, XmlPickler f, XmlPickler g, XmlPickler h, XmlPickler i, XmlPickler j) => XmlPickler (a, b, c, d, e, f, g, h, i, j) where
  xpickle :: PU (a, b, c, d, e, f, g, h, i, j)
xpickle = forall a b c d e f g h i j.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU i
-> PU j
-> PU (a, b, c, d, e, f, g, h, i, j)
xp10Tuple forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle

instance (XmlPickler a, XmlPickler b, XmlPickler c, XmlPickler d, XmlPickler e, XmlPickler f, XmlPickler g, XmlPickler h, XmlPickler i, XmlPickler j, XmlPickler k) => XmlPickler (a, b, c, d, e, f, g, h, i, j, k) where
  xpickle :: PU (a, b, c, d, e, f, g, h, i, j, k)
xpickle = forall a b c d e f g h i j k.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU i
-> PU j
-> PU k
-> PU (a, b, c, d, e, f, g, h, i, j, k)
xp11Tuple forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle

instance (XmlPickler a, XmlPickler b, XmlPickler c, XmlPickler d, XmlPickler e, XmlPickler f, XmlPickler g, XmlPickler h, XmlPickler i, XmlPickler j, XmlPickler k, XmlPickler l) => XmlPickler (a, b, c, d, e, f, g, h, i, j, k, l) where
  xpickle :: PU (a, b, c, d, e, f, g, h, i, j, k, l)
xpickle = forall a b c d e f g h i j k l.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU i
-> PU j
-> PU k
-> PU l
-> PU (a, b, c, d, e, f, g, h, i, j, k, l)
xp12Tuple forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle

instance (XmlPickler a, XmlPickler b, XmlPickler c, XmlPickler d, XmlPickler e, XmlPickler f, XmlPickler g, XmlPickler h, XmlPickler i, XmlPickler j, XmlPickler k, XmlPickler l, XmlPickler m) => XmlPickler (a, b, c, d, e, f, g, h, i, j, k, l, m) where
  xpickle :: PU (a, b, c, d, e, f, g, h, i, j, k, l, m)
xpickle = forall a b c d e f g h i j k l m.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU i
-> PU j
-> PU k
-> PU l
-> PU m
-> PU (a, b, c, d, e, f, g, h, i, j, k, l, m)
xp13Tuple forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle

instance (XmlPickler a, XmlPickler b, XmlPickler c, XmlPickler d, XmlPickler e, XmlPickler f, XmlPickler g, XmlPickler h, XmlPickler i, XmlPickler j, XmlPickler k, XmlPickler l, XmlPickler m, XmlPickler n) => XmlPickler (a, b, c, d, e, f, g, h, i, j, k, l, m, n) where
  xpickle :: PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
xpickle = forall a b c d e f g h i j k l m n.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU i
-> PU j
-> PU k
-> PU l
-> PU m
-> PU n
-> PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
xp14Tuple forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle

instance (XmlPickler a, XmlPickler b, XmlPickler c, XmlPickler d, XmlPickler e, XmlPickler f, XmlPickler g, XmlPickler h, XmlPickler i, XmlPickler j, XmlPickler k, XmlPickler l, XmlPickler m, XmlPickler n, XmlPickler o) => XmlPickler (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where
  xpickle :: PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
xpickle = forall a b c d e f g h i j k l m n o.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU i
-> PU j
-> PU k
-> PU l
-> PU m
-> PU n
-> PU o
-> PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
xp15Tuple forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle

instance (XmlPickler a, XmlPickler b, XmlPickler c, XmlPickler d, XmlPickler e, XmlPickler f, XmlPickler g, XmlPickler h, XmlPickler i, XmlPickler j, XmlPickler k, XmlPickler l, XmlPickler m, XmlPickler n, XmlPickler o, XmlPickler p) => XmlPickler (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) where
  xpickle :: PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)
xpickle = forall a b c d e f g h i j k l m n o p.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU i
-> PU j
-> PU k
-> PU l
-> PU m
-> PU n
-> PU o
-> PU p
-> PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)
xp16Tuple forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle

instance (XmlPickler a, XmlPickler b, XmlPickler c, XmlPickler d, XmlPickler e, XmlPickler f, XmlPickler g, XmlPickler h, XmlPickler i, XmlPickler j, XmlPickler k, XmlPickler l, XmlPickler m, XmlPickler n, XmlPickler o, XmlPickler p, XmlPickler q) => XmlPickler (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q) where
  xpickle :: PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q)
xpickle = forall a b c d e f g h i j k l m n o p q.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU i
-> PU j
-> PU k
-> PU l
-> PU m
-> PU n
-> PU o
-> PU p
-> PU q
-> PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q)
xp17Tuple forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle

instance (XmlPickler a, XmlPickler b, XmlPickler c, XmlPickler d, XmlPickler e, XmlPickler f, XmlPickler g, XmlPickler h, XmlPickler i, XmlPickler j, XmlPickler k, XmlPickler l, XmlPickler m, XmlPickler n, XmlPickler o, XmlPickler p, XmlPickler q, XmlPickler r) => XmlPickler (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r) where
  xpickle :: PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r)
xpickle = forall a b c d e f g h i j k l m n o p q r.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU i
-> PU j
-> PU k
-> PU l
-> PU m
-> PU n
-> PU o
-> PU p
-> PU q
-> PU r
-> PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r)
xp18Tuple forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle

instance (XmlPickler a, XmlPickler b, XmlPickler c, XmlPickler d, XmlPickler e, XmlPickler f, XmlPickler g, XmlPickler h, XmlPickler i, XmlPickler j, XmlPickler k, XmlPickler l, XmlPickler m, XmlPickler n, XmlPickler o, XmlPickler p, XmlPickler q, XmlPickler r, XmlPickler s) => XmlPickler (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s) where
  xpickle :: PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s)
xpickle = forall a b c d e f g h i j k l m n o p q r s.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU i
-> PU j
-> PU k
-> PU l
-> PU m
-> PU n
-> PU o
-> PU p
-> PU q
-> PU r
-> PU s
-> PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s)
xp19Tuple forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle

instance (XmlPickler a, XmlPickler b, XmlPickler c, XmlPickler d, XmlPickler e, XmlPickler f, XmlPickler g, XmlPickler h, XmlPickler i, XmlPickler j, XmlPickler k, XmlPickler l, XmlPickler m, XmlPickler n, XmlPickler o, XmlPickler p, XmlPickler q, XmlPickler r, XmlPickler s, XmlPickler t) => XmlPickler (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t) where
  xpickle :: PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t)
xpickle = forall a b c d e f g h i j k l m n o p q r s t.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU i
-> PU j
-> PU k
-> PU l
-> PU m
-> PU n
-> PU o
-> PU p
-> PU q
-> PU r
-> PU s
-> PU t
-> PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t)
xp20Tuple forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle

instance (XmlPickler a, XmlPickler b, XmlPickler c, XmlPickler d, XmlPickler e, XmlPickler f, XmlPickler g, XmlPickler h, XmlPickler i, XmlPickler j, XmlPickler k, XmlPickler l, XmlPickler m, XmlPickler n, XmlPickler o, XmlPickler p, XmlPickler q, XmlPickler r, XmlPickler s, XmlPickler t, XmlPickler u) => XmlPickler (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u) where
  xpickle :: PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u)
xpickle = forall a b c d e f g h i j k l m n o p q r s t u.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU i
-> PU j
-> PU k
-> PU l
-> PU m
-> PU n
-> PU o
-> PU p
-> PU q
-> PU r
-> PU s
-> PU t
-> PU u
-> PU
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u)
xp21Tuple forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle

instance (XmlPickler a, XmlPickler b, XmlPickler c, XmlPickler d, XmlPickler e, XmlPickler f, XmlPickler g, XmlPickler h, XmlPickler i, XmlPickler j, XmlPickler k, XmlPickler l, XmlPickler m, XmlPickler n, XmlPickler o, XmlPickler p, XmlPickler q, XmlPickler r, XmlPickler s, XmlPickler t, XmlPickler u, XmlPickler v) => XmlPickler (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v) where
  xpickle :: PU
  (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v)
xpickle = forall a b c d e f g h i j k l m n o p q r s t u v.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU i
-> PU j
-> PU k
-> PU l
-> PU m
-> PU n
-> PU o
-> PU p
-> PU q
-> PU r
-> PU s
-> PU t
-> PU u
-> PU v
-> PU
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v)
xp22Tuple forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle

instance (XmlPickler a, XmlPickler b, XmlPickler c, XmlPickler d, XmlPickler e, XmlPickler f, XmlPickler g, XmlPickler h, XmlPickler i, XmlPickler j, XmlPickler k, XmlPickler l, XmlPickler m, XmlPickler n, XmlPickler o, XmlPickler p, XmlPickler q, XmlPickler r, XmlPickler s, XmlPickler t, XmlPickler u, XmlPickler v, XmlPickler w) => XmlPickler (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v, w) where
  xpickle :: PU
  (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
   w)
xpickle = forall a b c d e f g h i j k l m n o p q r s t u v w.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU i
-> PU j
-> PU k
-> PU l
-> PU m
-> PU n
-> PU o
-> PU p
-> PU q
-> PU r
-> PU s
-> PU t
-> PU u
-> PU v
-> PU w
-> PU
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w)
xp23Tuple forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle

instance (XmlPickler a, XmlPickler b, XmlPickler c, XmlPickler d, XmlPickler e, XmlPickler f, XmlPickler g, XmlPickler h, XmlPickler i, XmlPickler j, XmlPickler k, XmlPickler l, XmlPickler m, XmlPickler n, XmlPickler o, XmlPickler p, XmlPickler q, XmlPickler r, XmlPickler s, XmlPickler t, XmlPickler u, XmlPickler v, XmlPickler w, XmlPickler x) => XmlPickler (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v, w, x) where
  xpickle :: PU
  (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
   w, x)
xpickle = forall a b c d e f g h i j k l m n o p q r s t u v w x.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU i
-> PU j
-> PU k
-> PU l
-> PU m
-> PU n
-> PU o
-> PU p
-> PU q
-> PU r
-> PU s
-> PU t
-> PU u
-> PU v
-> PU w
-> PU x
-> PU
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x)
xp24Tuple forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle

instance XmlPickler a => XmlPickler [a] where
    xpickle :: PU [a]
xpickle = forall a. PU a -> PU [a]
xpList forall a. XmlPickler a => PU a
xpickle

instance XmlPickler a => XmlPickler (Maybe a) where
    xpickle :: PU (Maybe a)
xpickle = forall a. PU a -> PU (Maybe a)
xpOption forall a. XmlPickler a => PU a
xpickle

-- | Pickler for an arbitrary datum of type 'Either'.
instance (XmlPickler l, XmlPickler r) => XmlPickler (Either l r) where
        xpickle :: PU (Either l r)
xpickle = forall l r. PU l -> PU r -> PU (Either l r)
pick forall a. XmlPickler a => PU a
xpickle forall a. XmlPickler a => PU a
xpickle
          where
            pick :: PU l -> PU r -> PU (Either l r)
            pick :: forall l r. PU l -> PU r -> PU (Either l r)
pick PU l
lPickler PU r
rPickler =
              forall a. (a -> Int) -> [PU a] -> PU a
xpAlt (forall a b. a -> b -> a
const Int
0 forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
`either` forall a b. a -> b -> a
const Int
1)
              [ forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap (   forall a b. a -> Either a b
Left            -- Construct.
                       , \ (Left l
l ) -> l
l  -- Deconstruct.
                       ) PU l
lPickler
              , forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap (    forall a b. b -> Either a b
Right          -- Construct.
                       , \ (Right r
r) -> r
r  -- Deconstruct.
                       ) PU r
rPickler
              ]

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

{-
-- Thanks to treeowl:

-- This script was used to generate the tuple instances:

import Data.List (intercalate)

-- | Generates XmlPickler instances for tuples of size 4 <= n <= 24
mkInstance :: Int -> String
mkInstance n =
    "instance (" ++ constrainsts ++ ") => XmlPickler (" ++ tuple ++ ") where\n" ++
    "  xpickle = xp" ++ show n ++ "Tuple " ++ xpickleStrings
  where
    xpickleStrings = intercalate " " (replicate n "xpickle")
    tuple = intercalate ", " letters
    letters = map (:[]) $ take n ['a'..'z']
    constrainsts = intercalate ", " $ map oneConstr letters
    oneConstr a = "XmlPickler " ++ a

mkInstances :: String
mkInstances = intercalate "\n\n" $ mkInstance <$> [6..24]
-}

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

{- begin embeded test cases

-- ------------------------------------------------------------
--
-- a somewhat complex data structure
-- for representing programs of a simple
-- imperative language

type Program    = Stmt

type StmtList   = [Stmt]

data Stmt
    = Assign  Ident  Expr
    | Stmts   StmtList
    | If      Expr  Stmt (Maybe Stmt)
    | While   Expr  Stmt
      deriving (Eq, Show)

type Ident      = String

data Expr
    = IntConst  Int
    | BoolConst Bool
    | Var       Ident
    | UnExpr    UnOp  Expr
    | BinExpr   Op    Expr  Expr
      deriving (Eq, Show)

data Op
    = Add | Sub | Mul | Div | Mod | Eq | Neq
      deriving (Eq, Ord, Enum, Show)

data UnOp
    = UPlus | UMinus | Neg
      deriving (Eq, Ord, Read, Show)

-- ------------------------------------------------------------
--
-- the pickler definition for the data types

-- the main pickler

xpProgram :: PU Program
xpProgram = xpElem "program" $
            xpAddNSDecl "" "program42" $
            xpickle

xpMissingRootElement    :: PU Program
xpMissingRootElement    = xpickle

instance XmlPickler UnOp where
    xpickle = xpPrim

instance XmlPickler Op where
    xpickle = xpWrap (toEnum, fromEnum) xpPrim

instance XmlPickler Expr where
    xpickle = xpAlt tag ps
        where
        tag (IntConst _    ) = 0
        tag (BoolConst _   ) = 1
        tag (Var _         ) = 2
        tag (UnExpr _ _    ) = 3
        tag (BinExpr _ _ _ ) = 4
        ps = [ xpWrap ( IntConst
                      , \ (IntConst i ) -> i
                      ) $
               ( xpElem "int"   $
                 xpAttr "value" $
                 xpickle
               )

             , xpWrap ( BoolConst
                      , \ (BoolConst b) -> b
                      ) $
               ( xpElem "bool"  $
                 xpAttr "value" $
                 xpWrap (toEnum, fromEnum) xpickle
               )

             , xpWrap ( Var
                      , \ (Var n)       -> n
                      ) $
               ( xpElem "var"   $
                 xpAttr "name"  $
                 xpText
               )

             , xpWrap ( uncurry UnExpr
                      , \ (UnExpr op e) -> (op, e)
                      ) $
               ( xpElem "unex" $
                 xpPair (xpAttr "op" xpickle)
                         xpickle
               )

             , xpWrap ( uncurry3 $ BinExpr
                      , \ (BinExpr op e1 e2) -> (op, e1, e2)
                      ) $
               ( xpElem "binex" $
                 xpTriple (xpAttr "op" xpickle)
                           xpickle
                           xpickle
               )
             ]

instance XmlPickler Stmt where
    xpickle = xpAlt tag ps
        where
        tag ( Assign _ _ ) = 0
        tag ( Stmts _ )    = 1
        tag ( If _ _ _ )   = 2
        tag ( While _ _ )  = 3
        ps = [ xpWrap ( uncurry Assign
                      , \ (Assign n v) -> (n, v)
                      ) $
               ( xpElem "assign" $
                 xpFilterCont (neg $ hasName "comment" <+> isText) $  -- test case test7: remove uninteresting stuff
                 xpPair (xpAttr "name" xpText)
                         xpickle
               )
             , xpWrap ( Stmts
                      , \ (Stmts sl) -> sl
                      ) $
               ( xpElem "block" $
                 xpList xpickle
               )
             , xpWrap ( uncurry3 If
                      , \ (If c t e) -> (c, t, e)
                      ) $
               ( xpElem "if" $
                 xpTriple xpickle
                          xpickle
                          xpickle
               )
             , xpWrap ( uncurry While
                      , \ (While c b) -> (c, b)
                      ) $
               ( xpElem "while" $
                 xpPair xpickle
                        xpickle
               )
             ]

-- ------------------------------------------------------------
--
-- example programs

progs   :: [Program]
progs   = [p0, p1, p2]

p0, p1, p2 :: Program

p0 = Stmts []           -- the empty program

p1 = Stmts
     [ Assign i ( UnExpr UMinus ( IntConst (-22) ) )
     , Assign j ( IntConst 20 )
     , While
       ( BinExpr Neq ( Var i ) ( IntConst 0 ) )
       ( Stmts
         [ Assign i ( BinExpr Sub ( Var i ) ( IntConst 1 ) )
         , Assign j ( BinExpr Add ( Var j ) ( IntConst 1 ) )
         , If ( IntConst 0 ) (Stmts []) Nothing
         ]
       )
     ]
    where
    i = "i"
    j = "j"

p2 = Stmts
     [ Assign x (IntConst 6)
     , Assign y (IntConst 7)
     , Assign p (IntConst 0)
     , While
       ( BinExpr Neq (Var x) (IntConst 0) )
       ( If ( BinExpr Neq ( BinExpr Mod (Var x) (IntConst 2) ) (IntConst 0) )
            ( Stmts
              [ Assign x ( BinExpr Sub (Var x) (IntConst 1) )
              , Assign p ( BinExpr Add (Var p) (Var y) )
              ]
            )
            ( Just ( Stmts
                     [ Assign x ( BinExpr Div (Var x) (IntConst 2) )
                     , Assign y ( BinExpr Mul (Var y) (IntConst 2) )
                     ]
                   )
            )
       )
     ]
    where
    x = "x"
    y = "y"
    p = "p"

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

test0 = putStrLn . head . runLA
        ( xshow (arr (pickleDoc xpProgram)
                 >>> getChildren
                )
        )

test0' f = runLA
        ( xshow (arr (pickleDoc xpProgram)
                 >>> getChildren
                )
          >>>
          root [] [xread]
          >>>
          f
        )

test1' f = runLA
        ( xshow (arr (pickleDoc xpProgram)
                 >>> getChildren
                )
          >>>
          root [] [xread]
          >>>
          f
          >>>
          arr (unpickleDoc' xpProgram)
        )

test1 = test0' (processTopDown (setQName (mkName "real") `X.when` hasName "int"))
test2 = test1' this
test3 = test1' (processTopDown (setQName (mkName "real") `X.when` hasName "int"))
test4 = test1' (processTopDown (setQName (mkName "xxx")  `X.when` hasName "program"))
test5 = test1' (processTopDown (setQName (mkName "xxx")  `X.when` hasName "assign"))
test6 = test1' (processTopDownWithAttrl  (txt "xxx"      `X.when` hasText (== "UMinus")))
test7 = test1' (processTopDown (insertComment            `X.when` hasName "assign"))
    where insertComment = replaceChildren (getChildren <+> eelem "comment" <+> txt "zzz")

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

-- end embeded test cases -}