{-# 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
(Int -> St -> ShowS)
-> (St -> String) -> ([St] -> ShowS) -> Show St
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 { PU a -> Pickler a
appPickle   :: Pickler a         -- (a, St) -> St
                     , PU a -> Unpickler a
appUnPickle :: Unpickler 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 { 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 :: (a -> b) -> Unpickler a -> Unpickler b
fmap a -> b
f Unpickler a
u    = (St -> (UnpickleVal b, St)) -> Unpickler b
forall a. (St -> (UnpickleVal a, St)) -> Unpickler a
UP ((St -> (UnpickleVal b, St)) -> Unpickler b)
-> (St -> (UnpickleVal b, St)) -> Unpickler b
forall a b. (a -> b) -> a -> b
$ \ St
st ->
                  let (UnpickleVal a
r, St
st') = Unpickler a -> St -> (UnpickleVal a, St)
forall a. Unpickler a -> St -> (UnpickleVal a, St)
runUP Unpickler a
u St
st in ((a -> b) -> UnpickleVal a -> UnpickleVal b
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 :: a -> Unpickler a
pure a
a      = (St -> (UnpickleVal a, St)) -> Unpickler a
forall a. (St -> (UnpickleVal a, St)) -> Unpickler a
UP ((St -> (UnpickleVal a, St)) -> Unpickler a)
-> (St -> (UnpickleVal a, St)) -> Unpickler a
forall a b. (a -> b) -> a -> b
$ \ St
st -> (a -> UnpickleVal a
forall a b. b -> Either a b
Right a
a, St
st)
    Unpickler (a -> b)
uf <*> :: Unpickler (a -> b) -> Unpickler a -> Unpickler b
<*> Unpickler a
ua   = (St -> (UnpickleVal b, St)) -> Unpickler b
forall a. (St -> (UnpickleVal a, St)) -> Unpickler a
UP ((St -> (UnpickleVal b, St)) -> Unpickler b)
-> (St -> (UnpickleVal b, St)) -> Unpickler b
forall a b. (a -> b) -> a -> b
$ \ St
st ->
                  let (UnpickleVal (a -> b)
f, St
st') = Unpickler (a -> b) -> St -> (UnpickleVal (a -> b), 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 -> (UnpickleErr -> UnpickleVal b
forall a b. a -> Either a b
Left UnpickleErr
err, St
st')
                    Right a -> b
f' -> Unpickler b -> St -> (UnpickleVal b, St)
forall a. Unpickler a -> St -> (UnpickleVal a, St)
runUP ((a -> b) -> Unpickler a -> Unpickler b
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 :: a -> Unpickler a
return      = a -> Unpickler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Unpickler a
u >>= :: Unpickler a -> (a -> Unpickler b) -> Unpickler b
>>= a -> Unpickler b
f     = (St -> (UnpickleVal b, St)) -> Unpickler b
forall a. (St -> (UnpickleVal a, St)) -> Unpickler a
UP ((St -> (UnpickleVal b, St)) -> Unpickler b)
-> (St -> (UnpickleVal b, St)) -> Unpickler b
forall a b. (a -> b) -> a -> b
$ \ St
st ->
                  let (UnpickleVal a
r, St
st') = Unpickler a -> St -> (UnpickleVal a, St)
forall a. Unpickler a -> St -> (UnpickleVal a, St)
runUP Unpickler a
u St
st in
                  case UnpickleVal a
r of
                    Left UnpickleErr
err -> (UnpickleErr -> UnpickleVal b
forall a b. a -> Either a b
Left UnpickleErr
err, St
st')
                    Right a
v  -> Unpickler b -> St -> (UnpickleVal b, St)
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         = (St -> (UnpickleVal St, St)) -> Unpickler St
forall a. (St -> (UnpickleVal a, St)) -> Unpickler a
UP ((St -> (UnpickleVal St, St)) -> Unpickler St)
-> (St -> (UnpickleVal St, St)) -> Unpickler St
forall a b. (a -> b) -> a -> b
$ \ St
st -> (St -> UnpickleVal St
forall a b. b -> Either a b
Right St
st, St
st)
    put :: St -> Unpickler ()
put St
st      = (St -> (UnpickleVal (), St)) -> Unpickler ()
forall a. (St -> (UnpickleVal a, St)) -> Unpickler a
UP ((St -> (UnpickleVal (), St)) -> Unpickler ())
-> (St -> (UnpickleVal (), St)) -> Unpickler ()
forall a b. (a -> b) -> a -> b
$ \ St
_  -> (() -> UnpickleVal ()
forall a b. b -> Either a b
Right (), St
st)

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

    -- redundant, not (yet) used
    catchError :: Unpickler a -> (UnpickleErr -> Unpickler a) -> Unpickler a
catchError Unpickler a
u UnpickleErr -> Unpickler a
handler
                = (St -> (UnpickleVal a, St)) -> Unpickler a
forall a. (St -> (UnpickleVal a, St)) -> Unpickler a
UP ((St -> (UnpickleVal a, St)) -> Unpickler a)
-> (St -> (UnpickleVal a, St)) -> Unpickler a
forall a b. (a -> b) -> a -> b
$ \ St
st ->
                  let (UnpickleVal a
r, St
st') = Unpickler a -> St -> (UnpickleVal a, St)
forall a. Unpickler a -> St -> (UnpickleVal a, St)
runUP Unpickler a
u St
st in
                  case UnpickleVal a
r of
                    Left UnpickleErr
err -> Unpickler a -> St -> (UnpickleVal a, St)
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 :: String -> Unpickler a
throwMsg String
msg    = (St -> (UnpickleVal a, St)) -> Unpickler a
forall a. (St -> (UnpickleVal a, St)) -> Unpickler a
UP ((St -> (UnpickleVal a, St)) -> Unpickler a)
-> (St -> (UnpickleVal a, St)) -> Unpickler a
forall a b. (a -> b) -> a -> b
$ \ St
st -> (UnpickleErr -> UnpickleVal a
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 :: Unpickler a -> (a -> Unpickler b) -> Unpickler b -> Unpickler b
mchoice Unpickler a
u a -> Unpickler b
f Unpickler b
v   = (St -> (UnpickleVal b, St)) -> Unpickler b
forall a. (St -> (UnpickleVal a, St)) -> Unpickler a
UP ((St -> (UnpickleVal b, St)) -> Unpickler b)
-> (St -> (UnpickleVal b, St)) -> Unpickler b
forall a b. (a -> b) -> a -> b
$ \ St
st ->
                  let (UnpickleVal a
r, St
st') = Unpickler a -> St -> (UnpickleVal a, St)
forall a. Unpickler a -> St -> (UnpickleVal a, St)
runUP Unpickler a
u St
st in
                  case UnpickleVal a
r of
                    Right a
x
                        -> Unpickler b -> St -> (UnpickleVal b, St)
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'' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== St -> Int
nesting St
st        -- true: failure in parsing curr contents
                           then Unpickler b -> St -> (UnpickleVal b, St)
forall a. Unpickler a -> St -> (UnpickleVal a, St)
runUP Unpickler b
v St
st                      -- try the alternative unpickler
                           else (UnpickleErr -> UnpickleVal b
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 :: String -> Maybe a -> Unpickler a
liftMaybe String
e Maybe a
v  = case Maybe a
v of
                    Maybe a
Nothing -> String -> Unpickler a
forall a. String -> Unpickler a
throwMsg String
e
                    Just a
x  -> a -> Unpickler a
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 :: UnpickleVal a -> Unpickler a
liftUnpickleVal UnpickleVal a
v       = (St -> (UnpickleVal a, St)) -> Unpickler a
forall a. (St -> (UnpickleVal a, St)) -> Unpickler a
UP ((St -> (UnpickleVal a, St)) -> Unpickler a)
-> (St -> (UnpickleVal a, St)) -> Unpickler a
forall a b. (a -> b) -> a -> b
$ \ St
st -> (UnpickleVal a
v, St
st)

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

getCont         :: Unpickler XmlTree
getCont :: Unpickler XmlTree
getCont         = do [XmlTree]
cs <- (St -> [XmlTree]) -> Unpickler [XmlTree]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets St -> [XmlTree]
contents
                     case [XmlTree]
cs of
                       []       -> String -> Unpickler XmlTree
forall a. String -> Unpickler a
throwMsg String
"no more contents to be read"
                       (XmlTree
x : [XmlTree]
xs) -> do (St -> St) -> Unpickler ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\ St
s -> St
s {contents :: [XmlTree]
contents = [XmlTree]
xs})
                                      XmlTree -> Unpickler XmlTree
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 <- (St -> [XmlTree]) -> Unpickler [XmlTree]
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 -> String -> Unpickler XmlTree
forall a. String -> Unpickler a
throwMsg (String -> Unpickler XmlTree) -> String -> Unpickler XmlTree
forall a b. (a -> b) -> a -> b
$ String
"no attribute value found for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ QName -> String
forall a. Show a => a -> String
show QName
qn
                       Just (XmlTree
a, [XmlTree]
as') -> do (St -> St) -> Unpickler ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\ St
s -> St
s {attributes :: [XmlTree]
attributes = [XmlTree]
as'})
                                           XmlTree -> Unpickler XmlTree
forall (m :: * -> *) a. Monad m => a -> m a
return (XmlTree -> Unpickler XmlTree) -> XmlTree -> Unpickler XmlTree
forall a b. (a -> b) -> a -> b
$ XmlTree -> XmlTree
forall (t :: * -> *) a. (XmlNode a, Tree t) => t a -> t a
nonEmptyVal XmlTree
a
    where
      findAtt :: [XmlTree] -> Maybe (XmlTree, [XmlTree])
findAtt     = (XmlTree -> Bool) -> [XmlTree] -> Maybe (XmlTree, [XmlTree])
forall a. (a -> Bool) -> [a] -> Maybe (a, [a])
findElem (Bool -> (QName -> Bool) -> Maybe QName -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
== QName
qn) (Maybe QName -> Bool)
-> (XmlTree -> Maybe QName) -> XmlTree -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTree -> Maybe QName
forall a. XmlNode a => a -> Maybe QName
XN.getAttrName)
      nonEmptyVal :: t a -> t a
nonEmptyVal t a
a'
          | [t a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (t a -> [t a]
forall (t :: * -> *) a. Tree t => t a -> [t a]
XN.getChildren t a
a') = [t a] -> t a -> t 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 = String -> t a
forall a. XmlNode a => String -> a
XN.mkText String
""

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

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

emptySt         :: St
emptySt :: St
emptySt         =  St :: [XmlTree] -> [XmlTree] -> Int -> QName -> Bool -> St
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 XmlTree -> [XmlTree] -> [XmlTree]
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 XmlTree -> [XmlTree] -> [XmlTree]
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 :: (a -> Bool) -> [a] -> Maybe (a, [a])
findElem a -> Bool
p     = ([a] -> [a]) -> [a] -> Maybe (a, [a])
forall c. ([a] -> c) -> [a] -> Maybe (a, c)
find' [a] -> [a]
forall a. a -> a
id
    where
      find' :: ([a] -> c) -> [a] -> Maybe (a, c)
find' [a] -> c
_ []         = Maybe (a, c)
forall a. Maybe a
Nothing
      find' [a] -> c
prefix (a
x : [a]
xs)
          | a -> Bool
p a
x          = (a, c) -> Maybe (a, c)
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 ([a] -> c) -> ([a] -> [a]) -> [a] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:)) [a]
xs

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

formatSt                :: St -> String
formatSt :: St -> String
formatSt St
st             = String
fcx String -> ShowS
forall a. [a] -> [a] -> [a]
++
                          [XmlTree] -> String
fa (St -> [XmlTree]
attributes St
st) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                          [XmlTree] -> String
fc (St -> [XmlTree]
contents   St
st)
    where
      fcx :: String
fcx               = String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"context:    " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                          ( if St -> Bool
pelem St
st
                            then String
"element"
                            else String
"attribute"
                          ) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                          String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ QName -> String
forall a. Show a => a -> String
show (St -> QName
pname St
st)
      fc :: [XmlTree] -> String
fc []             = String
""
      fc [XmlTree]
cs             = String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"contents:   " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [XmlTree] -> String
formatXML [XmlTree]
cs
      fa :: [XmlTree] -> String
fa []             = String
""
      fa [XmlTree]
as             = String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"attributes: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [XmlTree] -> String
formatXML [XmlTree]
as
      formatXML :: [XmlTree] -> String
formatXML         = Int -> ShowS
format Int
80 ShowS -> ([XmlTree] -> String) -> [XmlTree] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [XmlTree] -> String
showXML
      showXML :: [XmlTree] -> String
showXML           = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([XmlTree] -> [String]) -> [XmlTree] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LA [XmlTree] String -> [XmlTree] -> [String]
forall a b. LA a b -> a -> [b]
runLA ( LA [XmlTree] XmlTree -> LA [XmlTree] String
forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n String
xshowEscapeXml LA [XmlTree] XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a [b] b
unlistA )
      format :: Int -> ShowS
format Int
n String
s        = let s' :: String
s' = Int -> ShowS
forall a. Int -> [a] -> [a]
take (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String
s in
                          if String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n then String
s' else Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
n String
s String -> ShowS
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 :: 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        = PU a -> Pickler a
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 :: PU a -> XmlTree -> Maybe a
unpickleDoc PU a
p   = (String -> Maybe a) -> (a -> Maybe a) -> Either String a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> String -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just
                  (Either String a -> Maybe a)
-> (XmlTree -> Either String a) -> XmlTree -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PU a -> XmlTree -> Either String a
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' :: PU a -> XmlTree -> Either String a
unpickleDoc' PU a
p XmlTree
t
    | XmlTree -> Bool
forall a. XmlNode a => a -> Bool
XN.isRoot XmlTree
t       = Either UnpickleErr a -> Either String a
forall b. Either UnpickleErr b -> Either String b
mapErr (Either UnpickleErr a -> Either String a)
-> Either UnpickleErr a -> Either String a
forall a b. (a -> b) -> a -> b
$
                          PU a -> Int -> XmlTree -> Either UnpickleErr a
forall a. PU a -> Int -> XmlTree -> UnpickleVal a
unpickleElem' PU a
p Int
0              XmlTree
t
    | Bool
otherwise         = PU a -> XmlTree -> Either String a
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            = (UnpickleErr -> Either String b)
-> (b -> Either String b)
-> Either UnpickleErr b
-> Either String b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ( String -> Either String b
forall a b. a -> Either a b
Left (String -> Either String b)
-> (UnpickleErr -> String) -> UnpickleErr -> Either String b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                   \ (String
msg, St
st) -> String
msg String -> ShowS
forall a. [a] -> [a] -> [a]
++ St -> String
formatSt St
st
                                 ) b -> Either String b
forall a b. b -> Either a b
Right

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

unpickleElem'   :: PU a -> Int -> XmlTree -> UnpickleVal a
unpickleElem' :: PU a -> Int -> XmlTree -> UnpickleVal a
unpickleElem' PU a
p Int
l XmlTree
t
    = -- T.trace ("unpickleElem': " ++ show t) $
      ( (UnpickleVal a, St) -> UnpickleVal a
forall a b. (a, b) -> a
fst ((UnpickleVal a, St) -> UnpickleVal a)
-> (St -> (UnpickleVal a, St)) -> St -> UnpickleVal a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unpickler a -> St -> (UnpickleVal a, St)
forall a. Unpickler a -> St -> (UnpickleVal a, St)
runUP (PU a -> Unpickler a
forall a. PU a -> Unpickler a
appUnPickle PU a
p) )
      (St -> UnpickleVal a) -> St -> UnpickleVal a
forall a b. (a -> b) -> a -> b
$ St :: [XmlTree] -> [XmlTree] -> Int -> QName -> Bool -> St
St { attributes :: [XmlTree]
attributes = [XmlTree] -> Maybe [XmlTree] -> [XmlTree]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [XmlTree] -> [XmlTree])
-> (XmlTree -> Maybe [XmlTree]) -> XmlTree -> [XmlTree]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          XmlTree -> Maybe [XmlTree]
forall a. XmlNode a => a -> Maybe [XmlTree]
XN.getAttrl (XmlTree -> [XmlTree]) -> XmlTree -> [XmlTree]
forall a b. (a -> b) -> a -> b
$  XmlTree
t
           , contents :: [XmlTree]
contents   = XmlTree -> [XmlTree]
forall (t :: * -> *) a. Tree t => t a -> [t a]
XN.getChildren XmlTree
t
           , nesting :: Int
nesting    = Int
l
           , pname :: QName
pname      = Maybe QName -> QName
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe QName -> QName)
-> (XmlTree -> Maybe QName) -> XmlTree -> QName
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          XmlTree -> Maybe QName
forall a. XmlNode a => a -> Maybe QName
XN.getName  (XmlTree -> QName) -> XmlTree -> QName
forall a b. (a -> b) -> a -> b
$  XmlTree
t
           , pelem :: Bool
pelem      = XmlTree -> Bool
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 :: SysConfigList -> a -> String
showPickled SysConfigList
a = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> (a -> [String]) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PU a -> a -> XmlTree
forall a. PU a -> a -> XmlTree
pickleDoc PU a
forall a. XmlPickler a => PU a
xpickle (a -> XmlTree) -> (XmlTree -> [String]) -> a -> [String]
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> LA XmlTree String -> XmlTree -> [String]
forall a b. LA a b -> a -> [b]
runLA (SysConfigList -> LA XmlTree String
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 :: String -> PU a
xpZero String
err              =  PU :: forall a. Pickler a -> Unpickler a -> Schema -> PU a
PU { appPickle :: Pickler a
appPickle   = (St -> St) -> Pickler a
forall a b. a -> b -> a
const St -> St
forall a. a -> a
id
                              , appUnPickle :: Unpickler a
appUnPickle = String -> Unpickler a
forall a. String -> Unpickler a
throwMsg String
err
                              , theSchema :: Schema
theSchema   = Schema
scNull
                              }

-- | unit pickler

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

-- | Composition of xpCheckEmptyContents and xpCheckAttributes

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

xpLift                  :: a -> PU a
xpLift :: a -> PU a
xpLift a
x                =  PU :: forall a. Pickler a -> Unpickler a -> Schema -> PU a
PU { appPickle :: Pickler a
appPickle   = (St -> St) -> Pickler a
forall a b. a -> b -> a
const St -> St
forall a. a -> a
id
                              , appUnPickle :: Unpickler a
appUnPickle = a -> Unpickler a
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 :: Maybe a -> PU a
xpLiftMaybe Maybe a
v                   = (Maybe a -> PU a
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       = String -> PU a
forall a. String -> PU a
xpZero String
"xpLiftMaybe: got Nothing"
    xpLiftMaybe'' (Just a
x)      = a -> PU a
forall a. a -> PU a
xpLift a
x

xpLiftEither                    :: Either String a -> PU a
xpLiftEither :: Either String a -> PU a
xpLiftEither Either String a
v                  = (Either String a -> PU a
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)   = String -> PU a
forall a. String -> PU a
xpZero String
err
    xpLiftEither'' (Right a
x)    = a -> PU a
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 :: (b -> a) -> PU a -> (a -> PU b) -> PU b
xpSeq b -> a
f PU a
pa a -> PU b
k
    = PU :: forall a. Pickler a -> Unpickler a -> Schema -> PU a
PU { appPickle :: Pickler b
appPickle  = ( \ b
b ->
                          let a :: a
a = b -> a
f b
b in
                          PU a -> Pickler a
forall a. PU a -> Pickler a
appPickle PU a
pa a
a (St -> St) -> (St -> St) -> St -> St
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PU b -> Pickler b
forall a. PU a -> Pickler a
appPickle (a -> PU b
k a
a) b
b
                         )
         , appUnPickle :: Unpickler b
appUnPickle = PU a -> Unpickler a
forall a. PU a -> Unpickler a
appUnPickle PU a
pa Unpickler a -> (a -> Unpickler b) -> Unpickler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (PU b -> Unpickler b
forall a. PU a -> Unpickler a
appUnPickle (PU b -> Unpickler b) -> (a -> PU b) -> a -> Unpickler b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PU b
k)
         , theSchema :: Schema
theSchema   = Schema
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' :: PU () -> PU a -> PU a
xpSeq' PU ()
pa       = (((), a) -> a, a -> ((), a)) -> PU ((), a) -> PU a
forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap ( ((), a) -> a
forall a b. (a, b) -> b
snd
                         , \ a
y -> ((), a
y)
                         ) (PU ((), a) -> PU a) -> (PU a -> PU ((), a)) -> PU a -> PU a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  PU () -> PU a -> PU ((), a)
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 :: PU b -> PU a -> (a -> PU b) -> Unpickler b
xpChoice PU b
pb PU a
pa a -> PU b
k        = Unpickler a -> (a -> Unpickler b) -> Unpickler b -> Unpickler b
forall a b.
Unpickler a -> (a -> Unpickler b) -> Unpickler b -> Unpickler b
mchoice (PU a -> Unpickler a
forall a. PU a -> Unpickler a
appUnPickle PU a
pa) (PU b -> Unpickler b
forall a. PU a -> Unpickler a
appUnPickle (PU b -> Unpickler b) -> (a -> PU b) -> a -> Unpickler b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PU b
k) (PU b -> Unpickler b
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 :: (a -> b, b -> a) -> PU a -> PU b
xpWrap (a -> b
i, b -> a
j) PU a
pa        = ((b -> a) -> PU a -> (a -> PU b) -> PU b
forall b a. (b -> a) -> PU a -> (a -> PU b) -> PU b
xpSeq b -> a
j PU a
pa (b -> PU b
forall a. a -> PU a
xpLift (b -> PU b) -> (a -> b) -> a -> PU b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
i)) { theSchema :: Schema
theSchema = PU a -> Schema
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 :: (a -> Maybe b, b -> a) -> PU a -> PU b
xpWrapMaybe (a -> Maybe b
i, b -> a
j) PU a
pa   = ((b -> a) -> PU a -> (a -> PU b) -> PU b
forall b a. (b -> a) -> PU a -> (a -> PU b) -> PU b
xpSeq b -> a
j PU a
pa (Maybe b -> PU b
forall a. Maybe a -> PU a
xpLiftMaybe (Maybe b -> PU b) -> (a -> Maybe b) -> a -> PU b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe b
i)) { theSchema :: Schema
theSchema = PU a -> Schema
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 :: (a -> Either String b, b -> a) -> PU a -> PU b
xpWrapEither (a -> Either String b
i, b -> a
j) PU a
pa   = ((b -> a) -> PU a -> (a -> PU b) -> PU b
forall b a. (b -> a) -> PU a -> (a -> PU b) -> PU b
xpSeq b -> a
j PU a
pa (Either String b -> PU b
forall a. Either String a -> PU a
xpLiftEither (Either String b -> PU b) -> (a -> Either String b) -> a -> PU b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either String b
i)) { theSchema :: Schema
theSchema = PU a -> Schema
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 :: PU a -> PU b -> PU (a, b)
xpPair PU a
pa PU b
pb
    = ( ((a, b) -> a) -> PU a -> (a -> PU (a, b)) -> PU (a, b)
forall b a. (b -> a) -> PU a -> (a -> PU b) -> PU b
xpSeq (a, b) -> a
forall a b. (a, b) -> a
fst PU a
pa (\ a
a ->
        ((a, b) -> b) -> PU b -> (b -> PU (a, b)) -> PU (a, b)
forall b a. (b -> a) -> PU a -> (a -> PU b) -> PU b
xpSeq (a, b) -> b
forall a b. (a, b) -> b
snd PU b
pb (\ b
b ->
        (a, b) -> PU (a, b)
forall a. a -> PU a
xpLift (a
a,b
b)))
      ) { theSchema :: Schema
theSchema = Schema -> Schema -> Schema
scSeq (PU a -> Schema
forall a. PU a -> Schema
theSchema PU a
pa) (PU b -> Schema
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 :: PU a -> PU b -> PU c -> PU (a, b, c)
xpTriple PU a
pa PU b
pb PU c
pc
    = ((a, (b, c)) -> (a, b, c), (a, b, c) -> (a, (b, c)))
-> PU (a, (b, c)) -> PU (a, b, c)
forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap ((a, (b, c)) -> (a, b, c)
forall a b c. (a, (b, c)) -> (a, b, c)
toTriple, (a, b, c) -> (a, (b, c))
forall a a b. (a, a, b) -> (a, (a, b))
fromTriple) (PU a -> PU (b, c) -> PU (a, (b, c))
forall a b. PU a -> PU b -> PU (a, b)
xpPair PU a
pa (PU b -> PU c -> PU (b, c)
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 :: 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
    = ((a, (b, (c, d))) -> (a, b, c, d),
 (a, b, c, d) -> (a, (b, (c, d))))
-> PU (a, (b, (c, d))) -> PU (a, b, c, d)
forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap ((a, (b, (c, d))) -> (a, b, c, d)
forall a b c d. (a, (b, (c, d))) -> (a, b, c, d)
toQuad, (a, b, c, d) -> (a, (b, (c, d)))
forall a a a b. (a, a, a, b) -> (a, (a, (a, b)))
fromQuad) (PU a -> PU (b, (c, d)) -> PU (a, (b, (c, d)))
forall a b. PU a -> PU b -> PU (a, b)
xpPair PU a
pa (PU b -> PU (c, d) -> PU (b, (c, d))
forall a b. PU a -> PU b -> PU (a, b)
xpPair PU b
pb (PU c -> PU d -> PU (c, d)
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 :: 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
    = ((a, (b, (c, (d, e)))) -> (a, b, c, d, e),
 (a, b, c, d, e) -> (a, (b, (c, (d, e)))))
-> PU (a, (b, (c, (d, e)))) -> PU (a, b, c, d, e)
forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap ((a, (b, (c, (d, e)))) -> (a, b, c, d, e)
forall a b c d e. (a, (b, (c, (d, e)))) -> (a, b, c, d, e)
toQuint, (a, b, c, d, e) -> (a, (b, (c, (d, e))))
forall a a a a b. (a, a, a, a, b) -> (a, (a, (a, (a, b))))
fromQuint) (PU a -> PU (b, (c, (d, e))) -> PU (a, (b, (c, (d, e))))
forall a b. PU a -> PU b -> PU (a, b)
xpPair PU a
pa (PU b -> PU (c, (d, e)) -> PU (b, (c, (d, e)))
forall a b. PU a -> PU b -> PU (a, b)
xpPair PU b
pb (PU c -> PU (d, e) -> PU (c, (d, e))
forall a b. PU a -> PU b -> PU (a, b)
xpPair PU c
pc (PU d -> PU e -> PU (d, e)
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 :: 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
    = ((a, (b, (c, (d, (e, f))))) -> (a, b, c, d, e, f),
 (a, b, c, d, e, f) -> (a, (b, (c, (d, (e, f))))))
-> PU (a, (b, (c, (d, (e, f))))) -> PU (a, b, c, d, e, f)
forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap ((a, (b, (c, (d, (e, f))))) -> (a, b, c, d, e, f)
forall a b c d e f.
(a, (b, (c, (d, (e, f))))) -> (a, b, c, d, e, f)
toSix, (a, b, c, d, e, f) -> (a, (b, (c, (d, (e, f)))))
forall a a a a a b.
(a, a, a, a, a, b) -> (a, (a, (a, (a, (a, b)))))
fromSix) (PU a -> PU (b, (c, (d, (e, f)))) -> PU (a, (b, (c, (d, (e, f)))))
forall a b. PU a -> PU b -> PU (a, b)
xpPair PU a
pa (PU b -> PU (c, (d, (e, f))) -> PU (b, (c, (d, (e, f))))
forall a b. PU a -> PU b -> PU (a, b)
xpPair PU b
pb (PU c -> PU (d, (e, f)) -> PU (c, (d, (e, f)))
forall a b. PU a -> PU b -> PU (a, b)
xpPair PU c
pc (PU d -> PU (e, f) -> PU (d, (e, f))
forall a b. PU a -> PU b -> PU (a, b)
xpPair PU d
pd (PU e -> PU f -> PU (e, f)
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 :: 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
    = ((a, (b, c, d, e, f, g)) -> (a, b, c, d, e, f, g),
 (a, b, c, d, e, f, g) -> (a, (b, c, d, e, f, g)))
-> PU (a, (b, c, d, e, f, g)) -> PU (a, b, c, d, e, f, 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))
             )
      (PU a -> PU (b, c, d, e, f, g) -> PU (a, (b, c, d, e, f, g))
forall a b. PU a -> PU b -> PU (a, b)
xpPair PU a
a (PU b
-> PU c -> PU d -> PU e -> PU f -> PU g -> PU (b, c, d, e, f, 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 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 :: 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
    = (((a, b), (c, d, e, f, g, h)) -> (a, b, c, d, e, f, g, h),
 (a, b, c, d, e, f, g, h) -> ((a, b), (c, d, e, f, g, h)))
-> PU ((a, b), (c, d, e, f, g, h)) -> PU (a, b, c, d, e, f, g, 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))
             )
      (PU (a, b)
-> PU (c, d, e, f, g, h) -> PU ((a, b), (c, d, e, f, g, h))
forall a b. PU a -> PU b -> PU (a, b)
xpPair (PU a -> PU b -> PU (a, b)
forall a b. PU a -> PU b -> PU (a, b)
xpPair PU a
a PU b
b) (PU c
-> PU d -> PU e -> PU f -> PU g -> PU h -> PU (c, d, e, f, g, 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 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 :: 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
    = (((a, b, c), (d, e, f, g, h, i)) -> (a, b, c, d, e, f, g, h, i),
 (a, b, c, d, e, f, g, h, i) -> ((a, b, c), (d, e, f, g, h, i)))
-> PU ((a, b, c), (d, e, f, g, h, i))
-> PU (a, b, c, d, e, f, g, h, 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))
             )
      (PU (a, b, c)
-> PU (d, e, f, g, h, i) -> PU ((a, b, c), (d, e, f, g, h, i))
forall a b. PU a -> PU b -> PU (a, b)
xpPair (PU a -> PU b -> PU c -> PU (a, b, c)
forall a b c. PU a -> PU b -> PU c -> PU (a, b, c)
xpTriple PU a
a PU b
b PU c
c) (PU d
-> PU e -> PU f -> PU g -> PU h -> PU i -> PU (d, e, f, g, h, 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 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 :: 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
    = (((a, b, c, d), (e, f, g, h, i, j))
 -> (a, b, c, d, e, f, g, h, i, j),
 (a, b, c, d, e, f, g, h, i, j)
 -> ((a, b, c, d), (e, f, g, h, i, j)))
-> PU ((a, b, c, d), (e, f, g, h, i, j))
-> PU (a, b, c, d, e, f, g, h, i, 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))
             )
      (PU (a, b, c, d)
-> PU (e, f, g, h, i, j) -> PU ((a, b, c, d), (e, f, g, h, i, j))
forall a b. PU a -> PU b -> PU (a, b)
xpPair (PU a -> PU b -> PU c -> PU d -> PU (a, b, c, d)
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) (PU e
-> PU f -> PU g -> PU h -> PU i -> PU j -> PU (e, f, g, h, i, 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 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 :: 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
    = (((a, b, c, d, e), (f, g, h, i, j, k))
 -> (a, b, c, d, e, f, g, h, i, j, k),
 (a, b, c, d, e, f, g, h, i, j, k)
 -> ((a, b, c, d, e), (f, g, h, i, j, k)))
-> PU ((a, b, c, d, e), (f, g, h, i, j, k))
-> PU (a, b, c, d, e, f, g, h, i, j, 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))
             )
      (PU (a, b, c, d, e)
-> PU (f, g, h, i, j, k)
-> PU ((a, b, c, d, e), (f, g, h, i, j, k))
forall a b. PU a -> PU b -> PU (a, b)
xpPair (PU a -> PU b -> PU c -> PU d -> PU e -> PU (a, b, c, d, e)
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) (PU f
-> PU g -> PU h -> PU i -> PU j -> PU k -> PU (f, g, h, i, j, 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 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 :: 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
    = (((a, b, c, d, e, f), (g, h, i, j, k, l))
 -> (a, b, c, d, e, f, g, h, i, j, k, l),
 (a, b, c, d, e, f, g, h, i, j, k, l)
 -> ((a, b, c, d, e, f), (g, h, i, j, k, l)))
-> PU ((a, b, c, d, e, f), (g, h, i, j, k, l))
-> PU (a, b, c, d, e, f, g, h, i, j, k, 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))
             )
      (PU (a, b, c, d, e, f)
-> PU (g, h, i, j, k, l)
-> PU ((a, b, c, d, e, f), (g, h, i, j, k, l))
forall a b. PU a -> PU b -> PU (a, b)
xpPair (PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, 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 a
a PU b
b PU c
c PU d
d PU e
e PU f
f) (PU g
-> PU h -> PU i -> PU j -> PU k -> PU l -> PU (g, h, i, j, k, 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 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 :: 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
    = ((a, (b, c, d, e, f, g), (h, i, j, k, l, m))
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m),
 (a, b, c, d, e, f, g, h, i, j, k, l, m)
 -> (a, (b, c, d, e, f, g), (h, i, j, k, l, m)))
-> PU (a, (b, c, d, e, f, g), (h, i, j, k, l, m))
-> PU (a, b, c, d, e, f, g, h, i, j, k, l, 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))
             )
      (PU a
-> PU (b, c, d, e, f, g)
-> PU (h, i, j, k, l, m)
-> PU (a, (b, c, d, e, f, g), (h, i, j, k, l, m))
forall a b c. PU a -> PU b -> PU c -> PU (a, b, c)
xpTriple PU a
a (PU b
-> PU c -> PU d -> PU e -> PU f -> PU g -> PU (b, c, d, e, f, 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 b
b PU c
c PU d
d PU e
e PU f
f PU g
g) (PU h
-> PU i -> PU j -> PU k -> PU l -> PU m -> PU (h, i, j, k, l, 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 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 :: 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
    = (((a, b), (c, d, e, f, g, h), (i, j, k, l, m, n))
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n),
 (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
 -> ((a, b), (c, d, e, f, g, h), (i, j, k, l, m, n)))
-> PU ((a, b), (c, d, e, f, g, h), (i, j, k, l, m, n))
-> PU (a, b, c, d, e, f, g, h, i, j, k, l, m, 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))
             )
      (PU (a, b)
-> PU (c, d, e, f, g, h)
-> PU (i, j, k, l, m, n)
-> PU ((a, b), (c, d, e, f, g, h), (i, j, k, l, m, n))
forall a b c. PU a -> PU b -> PU c -> PU (a, b, c)
xpTriple (PU a -> PU b -> PU (a, b)
forall a b. PU a -> PU b -> PU (a, b)
xpPair PU a
a PU b
b) (PU c
-> PU d -> PU e -> PU f -> PU g -> PU h -> PU (c, d, e, f, g, 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 c
c PU d
d PU e
e PU f
f PU g
g PU h
h) (PU i
-> PU j -> PU k -> PU l -> PU m -> PU n -> PU (i, j, k, l, m, 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 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 :: 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
    = (((a, b, c), (d, e, f, g, h, i), (j, k, l, m, n, o))
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o),
 (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
 -> ((a, b, c), (d, e, f, g, h, i), (j, k, l, m, n, o)))
-> PU ((a, b, c), (d, e, f, g, h, i), (j, k, l, m, n, o))
-> PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n, 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))
             )
      (PU (a, b, c)
-> PU (d, e, f, g, h, i)
-> PU (j, k, l, m, n, o)
-> PU ((a, b, c), (d, e, f, g, h, i), (j, k, l, m, n, o))
forall a b c. PU a -> PU b -> PU c -> PU (a, b, c)
xpTriple (PU a -> PU b -> PU c -> PU (a, b, c)
forall a b c. PU a -> PU b -> PU c -> PU (a, b, c)
xpTriple PU a
a PU b
b PU c
c) (PU d
-> PU e -> PU f -> PU g -> PU h -> PU i -> PU (d, e, f, g, h, 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 d
d PU e
e PU f
f PU g
g PU h
h PU i
i) (PU j
-> PU k -> PU l -> PU m -> PU n -> PU o -> PU (j, k, l, m, n, 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 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 :: 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
    = (((a, b, c, d), (e, f, g, h, i, j), (k, l, m, n, o, p))
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p),
 (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)
 -> ((a, b, c, d), (e, f, g, h, i, j), (k, l, m, n, o, p)))
-> PU ((a, b, c, d), (e, f, g, h, i, j), (k, l, m, n, o, p))
-> PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, 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))
             )
      (PU (a, b, c, d)
-> PU (e, f, g, h, i, j)
-> PU (k, l, m, n, o, p)
-> PU ((a, b, c, d), (e, f, g, h, i, j), (k, l, m, n, o, p))
forall a b c. PU a -> PU b -> PU c -> PU (a, b, c)
xpTriple (PU a -> PU b -> PU c -> PU d -> PU (a, b, c, d)
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) (PU e
-> PU f -> PU g -> PU h -> PU i -> PU j -> PU (e, f, g, h, i, 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 e
e PU f
f PU g
g PU h
h PU i
i PU j
j) (PU k
-> PU l -> PU m -> PU n -> PU o -> PU p -> PU (k, l, m, n, o, 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 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 :: 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
    = (((a, b, c, d, e), (f, g, h, i, j, k), (l, m, n, o, p, q))
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q),
 (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q)
 -> ((a, b, c, d, e), (f, g, h, i, j, k), (l, m, n, o, p, q)))
-> PU ((a, b, c, d, e), (f, g, h, i, j, k), (l, m, n, o, p, q))
-> PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, 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))
             )
      (PU (a, b, c, d, e)
-> PU (f, g, h, i, j, k)
-> PU (l, m, n, o, p, q)
-> PU ((a, b, c, d, e), (f, g, h, i, j, k), (l, m, n, o, p, q))
forall a b c. PU a -> PU b -> PU c -> PU (a, b, c)
xpTriple (PU a -> PU b -> PU c -> PU d -> PU e -> PU (a, b, c, d, e)
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) (PU f
-> PU g -> PU h -> PU i -> PU j -> PU k -> PU (f, g, h, i, j, 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 f
f PU g
g PU h
h PU i
i PU j
j PU k
k) (PU l
-> PU m -> PU n -> PU o -> PU p -> PU q -> PU (l, m, n, o, p, 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 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 :: 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
    = (((a, b, c, d, e, f), (g, h, i, j, k, l), (m, n, o, p, q, r))
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r),
 (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r)
 -> ((a, b, c, d, e, f), (g, h, i, j, k, l), (m, n, o, p, q, r)))
-> PU ((a, b, c, d, e, f), (g, h, i, j, k, l), (m, n, o, p, q, r))
-> PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, 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))
             )
      (PU (a, b, c, d, e, f)
-> PU (g, h, i, j, k, l)
-> PU (m, n, o, p, q, r)
-> PU ((a, b, c, d, e, f), (g, h, i, j, k, l), (m, n, o, p, q, r))
forall a b c. PU a -> PU b -> PU c -> PU (a, b, c)
xpTriple (PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, 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 a
a PU b
b PU c
c PU d
d PU e
e PU f
f) (PU g
-> PU h -> PU i -> PU j -> PU k -> PU l -> PU (g, h, i, j, k, 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 g
g PU h
h PU i
i PU j
j PU k
k PU l
l) (PU m
-> PU n -> PU o -> PU p -> PU q -> PU r -> PU (m, n, o, p, q, 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 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 :: 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
    = ((a, (b, c, d, e, f, g), (h, i, j, k, l, m), (n, o, p, q, r, s))
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s),
 (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s)
 -> (a, (b, c, d, e, f, g), (h, i, j, k, l, m), (n, o, p, q, r, s)))
-> PU
     (a, (b, c, d, e, f, g), (h, i, j, k, l, m), (n, o, p, q, r, s))
-> PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, 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))
             )
      (PU a
-> PU (b, c, d, e, f, g)
-> PU (h, i, j, k, l, m)
-> PU (n, o, p, q, r, s)
-> PU
     (a, (b, c, d, e, f, g), (h, i, j, k, l, m), (n, o, p, q, r, s))
forall a b c d. PU a -> PU b -> PU c -> PU d -> PU (a, b, c, d)
xp4Tuple PU a
a (PU b
-> PU c -> PU d -> PU e -> PU f -> PU g -> PU (b, c, d, e, f, 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 b
b PU c
c PU d
d PU e
e PU f
f PU g
g) (PU h
-> PU i -> PU j -> PU k -> PU l -> PU m -> PU (h, i, j, k, l, 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 h
h PU i
i PU j
j PU k
k PU l
l PU m
m) (PU n
-> PU o -> PU p -> PU q -> PU r -> PU s -> PU (n, o, p, q, r, s)
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 :: 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
    = (((a, b), (c, d, e, f, g, h), (i, j, k, l, m, n),
  (o, p, q, r, s, t))
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t),
 (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t)
 -> ((a, b), (c, d, e, f, g, h), (i, j, k, l, m, n),
     (o, p, q, r, s, t)))
-> PU
     ((a, b), (c, d, e, f, g, h), (i, j, k, l, m, n),
      (o, p, q, r, s, t))
-> PU (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, 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))
             )
      (PU (a, b)
-> PU (c, d, e, f, g, h)
-> PU (i, j, k, l, m, n)
-> PU (o, p, q, r, s, t)
-> PU
     ((a, b), (c, d, e, f, g, h), (i, j, k, l, m, n),
      (o, p, q, r, s, t))
forall a b c d. PU a -> PU b -> PU c -> PU d -> PU (a, b, c, d)
xp4Tuple (PU a -> PU b -> PU (a, b)
forall a b. PU a -> PU b -> PU (a, b)
xpPair PU a
a PU b
b) (PU c
-> PU d -> PU e -> PU f -> PU g -> PU h -> PU (c, d, e, f, g, 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 c
c PU d
d PU e
e PU f
f PU g
g PU h
h) (PU i
-> PU j -> PU k -> PU l -> PU m -> PU n -> PU (i, j, k, l, m, 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 i
i PU j
j PU k
k PU l
l PU m
m PU n
n) (PU o
-> PU p -> PU q -> PU r -> PU s -> PU t -> PU (o, p, q, r, s, t)
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 :: 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
    = (((a, b, c), (d, e, f, g, h, i), (j, k, l, m, n, o),
  (p, q, r, s, t, u))
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u),
 (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u)
 -> ((a, b, c), (d, e, f, g, h, i), (j, k, l, m, n, o),
     (p, q, r, s, t, u)))
-> PU
     ((a, b, c), (d, e, f, g, h, i), (j, k, l, m, n, o),
      (p, q, r, s, t, u))
-> PU
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, 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))
             )
      (PU (a, b, c)
-> PU (d, e, f, g, h, i)
-> PU (j, k, l, m, n, o)
-> PU (p, q, r, s, t, u)
-> PU
     ((a, b, c), (d, e, f, g, h, i), (j, k, l, m, n, o),
      (p, q, r, s, t, u))
forall a b c d. PU a -> PU b -> PU c -> PU d -> PU (a, b, c, d)
xp4Tuple (PU a -> PU b -> PU c -> PU (a, b, c)
forall a b c. PU a -> PU b -> PU c -> PU (a, b, c)
xpTriple PU a
a PU b
b PU c
c) (PU d
-> PU e -> PU f -> PU g -> PU h -> PU i -> PU (d, e, f, g, h, 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 d
d PU e
e PU f
f PU g
g PU h
h PU i
i) (PU j
-> PU k -> PU l -> PU m -> PU n -> PU o -> PU (j, k, l, m, n, 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 j
j PU k
k PU l
l PU m
m PU n
n PU o
o) (PU p
-> PU q -> PU r -> PU s -> PU t -> PU u -> PU (p, q, r, s, t, u)
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 :: 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
    = (((a, b, c, d), (e, f, g, h, i, j), (k, l, m, n, o, p),
  (q, r, s, t, u, v))
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u,
     v),
 (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v)
 -> ((a, b, c, d), (e, f, g, h, i, j), (k, l, m, n, o, p),
     (q, r, s, t, u, v)))
-> PU
     ((a, b, c, d), (e, f, g, h, i, j), (k, l, m, n, o, p),
      (q, r, s, t, u, v))
-> PU
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, 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))
             )
      (PU (a, b, c, d)
-> PU (e, f, g, h, i, j)
-> PU (k, l, m, n, o, p)
-> PU (q, r, s, t, u, v)
-> PU
     ((a, b, c, d), (e, f, g, h, i, j), (k, l, m, n, o, p),
      (q, r, s, t, u, v))
forall a b c d. PU a -> PU b -> PU c -> PU d -> PU (a, b, c, d)
xp4Tuple (PU a -> PU b -> PU c -> PU d -> PU (a, b, c, d)
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) (PU e
-> PU f -> PU g -> PU h -> PU i -> PU j -> PU (e, f, g, h, i, 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 e
e PU f
f PU g
g PU h
h PU i
i PU j
j) (PU k
-> PU l -> PU m -> PU n -> PU o -> PU p -> PU (k, l, m, n, o, 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 k
k PU l
l PU m
m PU n
n PU o
o PU p
p) (PU q
-> PU r -> PU s -> PU t -> PU u -> PU v -> PU (q, r, s, t, u, v)
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 :: 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
    = (((a, b, c, d, e), (f, g, h, i, j, k), (l, m, n, o, p, q),
  (r, s, t, u, v, w))
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u,
     v, w),
 (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
  w)
 -> ((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, b, c, d, e), (f, g, h, i, j, k), (l, m, n, o, p, q),
      (r, s, t, u, v, 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)
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))
             )
      (PU (a, b, c, d, e)
-> PU (f, g, h, i, j, k)
-> PU (l, m, n, o, p, q)
-> PU (r, s, t, u, v, 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))
forall a b c d. PU a -> PU b -> PU c -> PU d -> PU (a, b, c, d)
xp4Tuple (PU a -> PU b -> PU c -> PU d -> PU e -> PU (a, b, c, d, e)
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) (PU f
-> PU g -> PU h -> PU i -> PU j -> PU k -> PU (f, g, h, i, j, 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 f
f PU g
g PU h
h PU i
i PU j
j PU k
k) (PU l
-> PU m -> PU n -> PU o -> PU p -> PU q -> PU (l, m, n, o, p, 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 l
l PU m
m PU n
n PU o
o PU p
p PU q
q) (PU r
-> PU s -> PU t -> PU u -> PU v -> PU w -> PU (r, s, t, u, v, w)
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 :: 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
    = (((a, b, c, d, e, f), (g, h, i, j, k, l), (m, n, o, p, q, r),
  (s, t, u, v, w, x))
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u,
     v, w, x),
 (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
  w, x)
 -> ((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, 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, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, 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))
             )
      (PU (a, b, c, d, e, f)
-> PU (g, h, i, j, k, l)
-> PU (m, n, o, p, q, r)
-> PU (s, t, u, v, w, 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))
forall a b c d. PU a -> PU b -> PU c -> PU d -> PU (a, b, c, d)
xp4Tuple (PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, 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 a
a PU b
b PU c
c PU d
d PU e
e PU f
f) (PU g
-> PU h -> PU i -> PU j -> PU k -> PU l -> PU (g, h, i, j, k, 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 g
g PU h
h PU i
i PU j
j PU k
k PU l
l) (PU m
-> PU n -> PU o -> PU p -> PU q -> PU r -> PU (m, n, o, p, q, 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 m
m PU n
n PU o
o PU p
p PU q
q PU r
r) (PU s
-> PU t -> PU u -> PU v -> PU w -> PU x -> PU (s, t, u, v, w, x)
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 :: forall a. Pickler a -> Unpickler a -> Schema -> PU a
PU { appPickle :: Pickler String
appPickle   = XmlTree -> St -> St
putCont (XmlTree -> St -> St) -> (String -> XmlTree) -> Pickler String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> XmlTree
forall a. XmlNode a => String -> a
XN.mkText
                     , appUnPickle :: Unpickler String
appUnPickle = do XmlTree
t <- Unpickler XmlTree
getCont
                                        String -> Maybe String -> Unpickler String
forall a. String -> Maybe a -> Unpickler a
liftMaybe String
"xpText: XML text expected" (Maybe String -> Unpickler String)
-> Maybe String -> Unpickler String
forall a b. (a -> b) -> a -> b
$ XmlTree -> Maybe String
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    = (Maybe String -> String, String -> Maybe String)
-> PU (Maybe String) -> PU String
forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"", String -> Maybe String
emptyToNothing) (PU (Maybe String) -> PU String) -> PU (Maybe String) -> PU String
forall a b. (a -> b) -> a -> b
$
                  PU String -> PU (Maybe String)
forall a. PU a -> PU (Maybe a)
xpOption (PU String -> PU (Maybe String)) -> PU String -> PU (Maybe String)
forall a b. (a -> b) -> a -> b
$
                  Schema -> PU String
xpTextDT Schema
sc
    where
    emptyToNothing :: String -> Maybe String
emptyToNothing String
"" = Maybe String
forall a. Maybe a
Nothing
    emptyToNothing String
x  = String -> Maybe String
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 :: PU a
xpPrim                  = (String -> Either String a, a -> String) -> PU String -> PU a
forall a b. (a -> Either String b, b -> a) -> PU a -> PU b
xpWrapEither (String -> Either String a
forall a. Read a => String -> Either String a
readMaybe, a -> String
forall a. Show a => a -> String
show) PU String
xpText
    where
    readMaybe           :: Read a => String -> Either String a
    readMaybe :: String -> Either String a
readMaybe String
str       = [(a, String)] -> Either String a
forall b. [(b, String)] -> Either String b
val (ReadS a
forall a. Read a => ReadS a
reads String
str)
        where
          val :: [(b, String)] -> Either String b
val [(b
x,String
"")]  = b -> Either String b
forall a b. b -> Either a b
Right b
x
          val [(b, String)]
_         = String -> Either String b
forall a b. a -> Either a b
Left (String -> Either String b) -> String -> Either String b
forall a b. (a -> b) -> a -> b
$ String
"xpPrim: reading string " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
str String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" failed"

-- | Pickle an Int
xpInt                   :: PU Int
xpInt :: PU Int
xpInt                   = (String -> Either String Int, Int -> String) -> PU String -> PU Int
forall a b. (a -> Either String b, b -> a) -> PU a -> PU b
xpWrapEither (String -> Either String Int
readMaybe, Int -> String
forall a. Show a => a -> String
show) PU String
xpText
    where
      readMaybe :: String -> Either String Int
readMaybe xs :: String
xs@(Char
_:String
_)
          | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
xs = Int -> Either String Int
forall a b. b -> Either a b
Right (Int -> Either String Int)
-> (String -> Int) -> String -> Either String Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Char -> Int) -> Int -> String -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\ Int
r Char
c -> Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
'0')) Int
0 (String -> Either String Int) -> String -> Either String Int
forall a b. (a -> b) -> a -> b
$ String
xs
      readMaybe (Char
'-' : String
xs) = (Int -> Int) -> Either String Int -> Either String Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int
0 Int -> Int -> Int
forall a. Num a => a -> a -> a
-) (Either String Int -> Either String Int)
-> (String -> Either String Int) -> String -> Either String Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String Int
readMaybe (String -> Either String Int) -> String -> Either String Int
forall a b. (a -> b) -> a -> b
$ String
xs
      readMaybe (Char
'+' : String
xs) =              String -> Either String Int
readMaybe (String -> Either String Int) -> String -> Either String Int
forall a b. (a -> b) -> a -> b
$ String
xs
      readMaybe        String
xs  = String -> Either String Int
forall a b. a -> Either a b
Left (String -> Either String Int) -> String -> Either String Int
forall a b. (a -> b) -> a -> b
$ String
"xpInt: reading an Int from string " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
xs String -> ShowS
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 :: forall a. Pickler a -> Unpickler a -> Schema -> PU a
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         = (PU XmlTree -> PU [XmlTree]
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       = ([XmlTree] -> String, String -> [XmlTree])
-> PU [XmlTree] -> PU String
forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap ( [XmlTree] -> String
showXML, String -> [XmlTree]
readXML ) (PU [XmlTree] -> PU String) -> PU [XmlTree] -> PU String
forall a b. (a -> b) -> a -> b
$ PU [XmlTree]
xpTrees
    where
      showXML :: [XmlTree] -> String
showXML   = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([XmlTree] -> [String]) -> [XmlTree] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LA [XmlTree] String -> [XmlTree] -> [String]
forall a b. LA a b -> a -> [b]
runLA ( LA [XmlTree] XmlTree -> LA [XmlTree] String
forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n String
xshowEscapeXml LA [XmlTree] XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a [b] b
unlistA )
      readXML :: String -> [XmlTree]
readXML   = LA String XmlTree -> String -> [XmlTree]
forall a b. LA a b -> a -> [b]
runLA LA String XmlTree
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 :: PU a -> PU (Maybe a)
xpOption PU a
pa     = PU :: forall a. Pickler a -> Unpickler a -> Schema -> PU a
PU { appPickle :: Pickler (Maybe a)
appPickle  = ( \ Maybe a
a ->
                                      case Maybe a
a of
                                        Maybe a
Nothing -> St -> St
forall a. a -> a
id
                                        Just a
x  -> PU a -> Pickler a
forall a. PU a -> Pickler a
appPickle PU a
pa a
x
                                    )

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

                     , theSchema :: Schema
theSchema   = Schema -> Schema
scOption (PU a -> Schema
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 :: a -> PU a -> PU a
xpDefault a
df    = (Maybe a -> a, a -> Maybe a) -> PU (Maybe a) -> PU a
forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap ( a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
df
                         , \ a
x -> if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
df then Maybe a
forall a. Maybe a
Nothing else a -> Maybe a
forall a. a -> Maybe a
Just a
x
                         ) (PU (Maybe a) -> PU a) -> (PU a -> PU (Maybe a)) -> PU a -> PU a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  PU a -> PU (Maybe a)
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 :: PU a -> PU [a]
xpList PU a
pa       = PU :: forall a. Pickler a -> Unpickler a -> Schema -> PU a
PU { appPickle :: Pickler [a]
appPickle  = ( \ [a]
a ->
                                      case [a]
a of
                                        []  -> St -> St
forall a. a -> a
id
                                        a
_:[a]
_ -> PU [a] -> Pickler [a]
forall a. PU a -> Pickler a
appPickle PU [a]
pc [a]
a
                                    )
                     , appUnPickle :: Unpickler [a]
appUnPickle = PU [a] -> PU a -> (a -> PU [a]) -> Unpickler [a]
forall b a. PU b -> PU a -> (a -> PU b) -> Unpickler b
xpChoice
                                     ([a] -> PU [a]
forall a. a -> PU a
xpLift [])
                                     PU a
pa
                                     (\ a
x -> ([a] -> [a]) -> PU [a] -> ([a] -> PU [a]) -> PU [a]
forall b a. (b -> a) -> PU a -> (a -> PU b) -> PU b
xpSeq [a] -> [a]
forall a. a -> a
id (PU a -> PU [a]
forall a. PU a -> PU [a]
xpList PU a
pa) (\[a]
xs -> [a] -> PU [a]
forall a. a -> PU a
xpLift (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)))

                     , theSchema :: Schema
theSchema   = Schema -> Schema
scList (PU a -> Schema
forall a. PU a -> Schema
theSchema PU a
pa)
                     }
      where
      pc :: PU [a]
pc        = ([a] -> a) -> PU a -> (a -> PU [a]) -> PU [a]
forall b a. (b -> a) -> PU a -> (a -> PU b) -> PU b
xpSeq [a] -> a
forall a. [a] -> a
head  PU a
pa         (\ a
x  ->
                  ([a] -> [a]) -> PU [a] -> ([a] -> PU [a]) -> PU [a]
forall b a. (b -> a) -> PU a -> (a -> PU b) -> PU b
xpSeq [a] -> [a]
forall a. [a] -> [a]
tail (PU a -> PU [a]
forall a. PU a -> PU [a]
xpList PU a
pa) (\ [a]
xs ->
                  [a] -> PU [a]
forall a. a -> PU a
xpLift (a
xa -> [a] -> [a]
forall 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 :: PU a -> PU [a]
xpList1 PU a
pa      = ( ((a, [a]) -> [a], [a] -> (a, [a])) -> PU (a, [a]) -> PU [a]
forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap (\ (a
x, [a]
xs) -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs
                           ,\ [a]
x -> ([a] -> a
forall a. [a] -> a
head [a]
x, [a] -> [a]
forall a. [a] -> [a]
tail [a]
x)
                           ) (PU (a, [a]) -> PU [a]) -> PU (a, [a]) -> PU [a]
forall a b. (a -> b) -> a -> b
$
                    PU a -> PU [a] -> PU (a, [a])
forall a b. PU a -> PU b -> PU (a, b)
xpPair PU a
pa (PU a -> PU [a]
forall a. PU a -> PU [a]
xpList PU a
pa)
                  ) { theSchema :: Schema
theSchema = Schema -> Schema
scList1 (PU a -> Schema
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 :: String -> String -> PU k -> PU v -> PU (Map k v)
xpMap String
en String
an PU k
xpk PU v
xpv
                = ([(k, v)] -> Map k v, Map k v -> [(k, v)])
-> PU [(k, v)] -> PU (Map k v)
forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap ( [(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
                         , Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
M.toList
                         ) (PU [(k, v)] -> PU (Map k v)) -> PU [(k, v)] -> PU (Map k v)
forall a b. (a -> b) -> a -> b
$
                  PU (k, v) -> PU [(k, v)]
forall a. PU a -> PU [a]
xpList (PU (k, v) -> PU [(k, v)]) -> PU (k, v) -> PU [(k, v)]
forall a b. (a -> b) -> a -> b
$
                  String -> PU (k, v) -> PU (k, v)
forall a. String -> PU a -> PU a
xpElem String
en (PU (k, v) -> PU (k, v)) -> PU (k, v) -> PU (k, v)
forall a b. (a -> b) -> a -> b
$
                  PU k -> PU v -> PU (k, v)
forall a b. PU a -> PU b -> PU (a, b)
xpPair ( String -> PU k -> PU k
forall a. String -> PU a -> PU a
xpAttr String
an (PU k -> PU k) -> PU k -> PU k
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 :: (a -> Int) -> [PU a] -> PU a
xpAlt a -> Int
tag [PU a]
ps    = PU :: forall a. Pickler a -> Unpickler a -> Schema -> PU a
PU { appPickle :: Pickler a
appPickle   = \ a
a ->
                                     PU a -> Pickler a
forall a. PU a -> Pickler a
appPickle ([PU a]
ps [PU a] -> Int -> PU a
forall a. [a] -> Int -> a
!! a -> Int
tag a
a) a
a

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

                     , theSchema :: Schema
theSchema   = [Schema] -> Schema
scAlts ((PU a -> Schema) -> [PU a] -> [Schema]
forall a b. (a -> b) -> [a] -> [b]
map PU a -> Schema
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 :: QName -> PU a -> PU a
xpElemQN QName
qn PU a
pa  = PU :: forall a. Pickler a -> Unpickler a -> Schema -> PU a
PU { appPickle :: Pickler a
appPickle   = ( \ a
a ->
                                       let st' :: St
st' = PU a -> Pickler a
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) (PU a -> Schema
forall a. PU a -> Schema
theSchema PU a
pa)
                     }
      where
      upElem :: Unpickler a
upElem    = do XmlTree
t <- Unpickler XmlTree
getCont
                     QName
n <- String -> Maybe QName -> Unpickler QName
forall a. String -> Maybe a -> Unpickler a
liftMaybe String
"xpElem: XML element expected" (Maybe QName -> Unpickler QName) -> Maybe QName -> Unpickler QName
forall a b. (a -> b) -> a -> b
$ XmlTree -> Maybe QName
forall a. XmlNode a => a -> Maybe QName
XN.getElemName XmlTree
t
                     if QName
n QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
/= QName
qn
                        then String -> Unpickler a
forall a. String -> Unpickler a
throwMsg (String
"xpElem: got element name " String -> ShowS
forall a. [a] -> [a] -> [a]
++ QName -> String
forall a. Show a => a -> String
show QName
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", but expected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ QName -> String
forall a. Show a => a -> String
show QName
qn)
                        else do Int
l <- (St -> Int) -> Unpickler Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets St -> Int
nesting
                                UnpickleVal a -> Unpickler a
forall a. UnpickleVal a -> Unpickler a
liftUnpickleVal (UnpickleVal a -> Unpickler a) -> UnpickleVal a -> Unpickler a
forall a b. (a -> b) -> a -> b
$ PU a -> Int -> XmlTree -> UnpickleVal a
forall a. PU a -> Int -> XmlTree -> UnpickleVal a
unpickleElem' (PU a -> PU a
forall a. PU a -> PU a
xpCheckEmpty PU a
pa) (Int
l Int -> Int -> Int
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 :: String -> PU a -> PU a
xpElem          = QName -> PU a -> PU a
forall a. QName -> PU a -> PU a
xpElemQN (QName -> PU a -> PU a)
-> (String -> QName) -> String -> PU a -> PU a
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 :: String -> String -> String -> PU a -> PU a
xpElemNS String
ns String
px String
lp
                = QName -> PU a -> PU a
forall a. QName -> PU a -> PU a
xpElemQN (QName -> PU a -> PU a) -> QName -> PU a -> PU a
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 :: String -> String -> String -> PU a -> PU a
xpElemWithAttrValue String
name String
an String
av PU a
pa
                = String -> PU a -> PU a
forall a. String -> PU a -> PU a
xpElem String
name (PU a -> PU a) -> PU a -> PU a
forall a b. (a -> b) -> a -> b
$
                  String -> String -> PU a -> PU a
forall a. String -> String -> PU a -> PU a
xpAddFixedAttr String
an String
av (PU a -> PU a) -> PU a -> PU a
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 :: QName -> PU a -> PU a
xpAttrQN QName
qn PU a
pa  = PU :: forall a. Pickler a -> Unpickler a -> Schema -> PU a
PU { appPickle :: Pickler a
appPickle   = ( \ a
a ->
                                       let st' :: St
st' = PU a -> Pickler a
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) (PU a -> Schema
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 <- (St -> Int) -> Unpickler Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets St -> Int
nesting
                     UnpickleVal a -> Unpickler a
forall a. UnpickleVal a -> Unpickler a
liftUnpickleVal (UnpickleVal a -> Unpickler a) -> UnpickleVal a -> Unpickler a
forall a b. (a -> b) -> a -> b
$ PU a -> Int -> XmlTree -> UnpickleVal a
forall a. PU a -> Int -> XmlTree -> UnpickleVal a
unpickleElem' (PU a -> PU a
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 :: String -> PU a -> PU a
xpAttr          = QName -> PU a -> PU a
forall a. QName -> PU a -> PU a
xpAttrQN (QName -> PU a -> PU a)
-> (String -> QName) -> String -> PU a -> PU a
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 :: String -> String -> String -> PU a -> PU a
xpAttrNS String
ns String
px String
lp
                = QName -> PU a -> PU a
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      = (String -> PU String -> PU String)
-> PU String -> String -> PU String
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> PU String -> PU String
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 :: String -> PU a -> PU (Maybe a)
xpAttrImplied String
name PU a
pa
                = PU a -> PU (Maybe a)
forall a. PU a -> PU (Maybe a)
xpOption (PU a -> PU (Maybe a)) -> PU a -> PU (Maybe a)
forall a b. (a -> b) -> a -> b
$ String -> PU a -> PU a
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
                = ( (String -> Either String (), () -> String) -> PU String -> PU ()
forall a b. (a -> Either String b, b -> a) -> PU a -> PU b
xpWrapEither ( \ String
v ->
                                   if String
v String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
val
                                   then () -> Either String ()
forall a b. b -> Either a b
Right ()
                                   else String -> Either String ()
forall a b. a -> Either a b
Left ( String
"xpAttrFixed: value "
                                               String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
val
                                               String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" expected, but got "
                                               String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
v
                                             )
                                 , String -> () -> String
forall a b. a -> b -> a
const String
val
                                 ) (PU String -> PU ()) -> PU String -> PU ()
forall a b. (a -> b) -> a -> b
$
                    String -> PU String -> PU String
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 :: String -> String -> PU a -> PU a
xpAddFixedAttr String
name String
val
                = PU () -> PU a -> PU a
forall a. PU () -> PU a -> PU a
xpSeq' (PU () -> PU a -> PU a) -> PU () -> PU a -> PU a
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 :: String -> String -> PU a -> PU a
xpAddNSDecl String
name String
val
                = PU () -> PU a -> PU a
forall a. PU () -> PU a -> PU a
xpSeq' (PU () -> PU a -> PU a) -> PU () -> PU a -> PU a
forall a b. (a -> b) -> a -> b
$ String -> String -> PU ()
xpAttrNSDecl String
name' String
val
    where
      name' :: String
name'
          | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
name = String
"xmlns"
          | Bool
otherwise = String
"xmlns:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name

xpAttrNSDecl     :: String -> String -> PU ()
xpAttrNSDecl :: String -> String -> PU ()
xpAttrNSDecl String
name String
ns
                 = PU :: forall a. Pickler a -> Unpickler a -> Schema -> PU a
PU { appPickle :: Pickler ()
appPickle   = (St -> St) -> Pickler ()
forall a b. a -> b -> a
const ((St -> St) -> Pickler ()) -> (St -> St) -> Pickler ()
forall a b. (a -> b) -> a -> b
$ QName -> [XmlTree] -> St -> St
putAtt (String -> QName
mkName String
name) [String -> XmlTree
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 ((([XmlTree] -> [XmlTree]) -> St -> St)
 -> LA XmlTree XmlTree -> PU ())
-> (([XmlTree] -> [XmlTree]) -> St -> St)
-> LA XmlTree XmlTree
-> PU ()
forall a b. (a -> b) -> a -> b
$ \ [XmlTree] -> [XmlTree]
mf St
s -> St
s {contents :: [XmlTree]
contents   = [XmlTree] -> [XmlTree]
mf ([XmlTree] -> [XmlTree]) -> [XmlTree] -> [XmlTree]
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 ((([XmlTree] -> [XmlTree]) -> St -> St)
 -> LA XmlTree XmlTree -> PU ())
-> (([XmlTree] -> [XmlTree]) -> St -> St)
-> LA XmlTree XmlTree
-> PU ()
forall a b. (a -> b) -> a -> b
$ \ [XmlTree] -> [XmlTree]
mf St
s -> St
s {attributes :: [XmlTree]
attributes = [XmlTree] -> [XmlTree]
mf ([XmlTree] -> [XmlTree]) -> [XmlTree] -> [XmlTree]
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 :: LA XmlTree XmlTree -> PU a -> PU a
xpFilterCont LA XmlTree XmlTree
f  = PU () -> PU a -> PU a
forall a. PU () -> PU a -> PU a
xpSeq' (PU () -> PU a -> PU a) -> PU () -> PU a -> PU a
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 :: LA XmlTree XmlTree -> PU a -> PU a
xpFilterAttr LA XmlTree XmlTree
f  = PU () -> PU a -> PU a
forall a. PU () -> PU a -> PU a
xpSeq' (PU () -> PU a -> PU a) -> PU () -> PU a -> PU a
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 :: forall a. Pickler a -> Unpickler a -> Schema -> PU a
PU { appPickle :: Pickler ()
appPickle   = (St -> St) -> Pickler ()
forall a b. a -> b -> a
const St -> St
forall a. a -> a
id
                      , appUnPickle :: Unpickler ()
appUnPickle = do (St -> St) -> Unpickler ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (([XmlTree] -> [XmlTree]) -> St -> St
m [XmlTree] -> [XmlTree]
filterCont)
                                         () -> Unpickler ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                      , theSchema :: Schema
theSchema   = Schema
scNull
                      }
    where
      filterCont :: [XmlTree] -> [XmlTree]
filterCont = LA [XmlTree] XmlTree -> [XmlTree] -> [XmlTree]
forall a b. LA a b -> a -> [b]
runLA (LA [XmlTree] XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a [b] b
unlistA LA [XmlTree] XmlTree -> LA XmlTree XmlTree -> LA [XmlTree] XmlTree
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 = PU Int
forall a. (Read a, Show a) => PU a
xpPrim

instance XmlPickler Integer where
    xpickle :: PU Integer
xpickle = PU Integer
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 = PU a -> PU b -> PU (a, b)
forall a b. PU a -> PU b -> PU (a, b)
xpPair PU a
forall a. XmlPickler a => PU a
xpickle PU b
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 = PU a -> PU b -> PU c -> PU (a, b, c)
forall a b c. PU a -> PU b -> PU c -> PU (a, b, c)
xpTriple PU a
forall a. XmlPickler a => PU a
xpickle PU b
forall a. XmlPickler a => PU a
xpickle PU c
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 = PU a -> PU b -> PU c -> PU d -> PU (a, b, c, d)
forall a b c d. PU a -> PU b -> PU c -> PU d -> PU (a, b, c, d)
xp4Tuple PU a
forall a. XmlPickler a => PU a
xpickle PU b
forall a. XmlPickler a => PU a
xpickle PU c
forall a. XmlPickler a => PU a
xpickle PU d
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 = PU a -> PU b -> PU c -> PU d -> PU e -> PU (a, b, c, d, e)
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
forall a. XmlPickler a => PU a
xpickle PU b
forall a. XmlPickler a => PU a
xpickle PU c
forall a. XmlPickler a => PU a
xpickle PU d
forall a. XmlPickler a => PU a
xpickle PU e
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 = PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, 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 a
forall a. XmlPickler a => PU a
xpickle PU b
forall a. XmlPickler a => PU a
xpickle PU c
forall a. XmlPickler a => PU a
xpickle PU d
forall a. XmlPickler a => PU a
xpickle PU e
forall a. XmlPickler a => PU a
xpickle PU f
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 = PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU (a, b, c, d, e, f, g)
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
forall a. XmlPickler a => PU a
xpickle PU b
forall a. XmlPickler a => PU a
xpickle PU c
forall a. XmlPickler a => PU a
xpickle PU d
forall a. XmlPickler a => PU a
xpickle PU e
forall a. XmlPickler a => PU a
xpickle PU f
forall a. XmlPickler a => PU a
xpickle PU g
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 = 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)
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
forall a. XmlPickler a => PU a
xpickle PU b
forall a. XmlPickler a => PU a
xpickle PU c
forall a. XmlPickler a => PU a
xpickle PU d
forall a. XmlPickler a => PU a
xpickle PU e
forall a. XmlPickler a => PU a
xpickle PU f
forall a. XmlPickler a => PU a
xpickle PU g
forall a. XmlPickler a => PU a
xpickle PU h
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 = 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)
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
forall a. XmlPickler a => PU a
xpickle PU b
forall a. XmlPickler a => PU a
xpickle PU c
forall a. XmlPickler a => PU a
xpickle PU d
forall a. XmlPickler a => PU a
xpickle PU e
forall a. XmlPickler a => PU a
xpickle PU f
forall a. XmlPickler a => PU a
xpickle PU g
forall a. XmlPickler a => PU a
xpickle PU h
forall a. XmlPickler a => PU a
xpickle PU i
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 = 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)
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
forall a. XmlPickler a => PU a
xpickle PU b
forall a. XmlPickler a => PU a
xpickle PU c
forall a. XmlPickler a => PU a
xpickle PU d
forall a. XmlPickler a => PU a
xpickle PU e
forall a. XmlPickler a => PU a
xpickle PU f
forall a. XmlPickler a => PU a
xpickle PU g
forall a. XmlPickler a => PU a
xpickle PU h
forall a. XmlPickler a => PU a
xpickle PU i
forall a. XmlPickler a => PU a
xpickle PU j
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 = 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)
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
forall a. XmlPickler a => PU a
xpickle PU b
forall a. XmlPickler a => PU a
xpickle PU c
forall a. XmlPickler a => PU a
xpickle PU d
forall a. XmlPickler a => PU a
xpickle PU e
forall a. XmlPickler a => PU a
xpickle PU f
forall a. XmlPickler a => PU a
xpickle PU g
forall a. XmlPickler a => PU a
xpickle PU h
forall a. XmlPickler a => PU a
xpickle PU i
forall a. XmlPickler a => PU a
xpickle PU j
forall a. XmlPickler a => PU a
xpickle PU k
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 = 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)
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
forall a. XmlPickler a => PU a
xpickle PU b
forall a. XmlPickler a => PU a
xpickle PU c
forall a. XmlPickler a => PU a
xpickle PU d
forall a. XmlPickler a => PU a
xpickle PU e
forall a. XmlPickler a => PU a
xpickle PU f
forall a. XmlPickler a => PU a
xpickle PU g
forall a. XmlPickler a => PU a
xpickle PU h
forall a. XmlPickler a => PU a
xpickle PU i
forall a. XmlPickler a => PU a
xpickle PU j
forall a. XmlPickler a => PU a
xpickle PU k
forall a. XmlPickler a => PU a
xpickle PU l
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 = 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)
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
forall a. XmlPickler a => PU a
xpickle PU b
forall a. XmlPickler a => PU a
xpickle PU c
forall a. XmlPickler a => PU a
xpickle PU d
forall a. XmlPickler a => PU a
xpickle PU e
forall a. XmlPickler a => PU a
xpickle PU f
forall a. XmlPickler a => PU a
xpickle PU g
forall a. XmlPickler a => PU a
xpickle PU h
forall a. XmlPickler a => PU a
xpickle PU i
forall a. XmlPickler a => PU a
xpickle PU j
forall a. XmlPickler a => PU a
xpickle PU k
forall a. XmlPickler a => PU a
xpickle PU l
forall a. XmlPickler a => PU a
xpickle PU m
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 = 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)
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
forall a. XmlPickler a => PU a
xpickle PU b
forall a. XmlPickler a => PU a
xpickle PU c
forall a. XmlPickler a => PU a
xpickle PU d
forall a. XmlPickler a => PU a
xpickle PU e
forall a. XmlPickler a => PU a
xpickle PU f
forall a. XmlPickler a => PU a
xpickle PU g
forall a. XmlPickler a => PU a
xpickle PU h
forall a. XmlPickler a => PU a
xpickle PU i
forall a. XmlPickler a => PU a
xpickle PU j
forall a. XmlPickler a => PU a
xpickle PU k
forall a. XmlPickler a => PU a
xpickle PU l
forall a. XmlPickler a => PU a
xpickle PU m
forall a. XmlPickler a => PU a
xpickle PU n
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 = 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)
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
forall a. XmlPickler a => PU a
xpickle PU b
forall a. XmlPickler a => PU a
xpickle PU c
forall a. XmlPickler a => PU a
xpickle PU d
forall a. XmlPickler a => PU a
xpickle PU e
forall a. XmlPickler a => PU a
xpickle PU f
forall a. XmlPickler a => PU a
xpickle PU g
forall a. XmlPickler a => PU a
xpickle PU h
forall a. XmlPickler a => PU a
xpickle PU i
forall a. XmlPickler a => PU a
xpickle PU j
forall a. XmlPickler a => PU a
xpickle PU k
forall a. XmlPickler a => PU a
xpickle PU l
forall a. XmlPickler a => PU a
xpickle PU m
forall a. XmlPickler a => PU a
xpickle PU n
forall a. XmlPickler a => PU a
xpickle PU o
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 = 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)
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
forall a. XmlPickler a => PU a
xpickle PU b
forall a. XmlPickler a => PU a
xpickle PU c
forall a. XmlPickler a => PU a
xpickle PU d
forall a. XmlPickler a => PU a
xpickle PU e
forall a. XmlPickler a => PU a
xpickle PU f
forall a. XmlPickler a => PU a
xpickle PU g
forall a. XmlPickler a => PU a
xpickle PU h
forall a. XmlPickler a => PU a
xpickle PU i
forall a. XmlPickler a => PU a
xpickle PU j
forall a. XmlPickler a => PU a
xpickle PU k
forall a. XmlPickler a => PU a
xpickle PU l
forall a. XmlPickler a => PU a
xpickle PU m
forall a. XmlPickler a => PU a
xpickle PU n
forall a. XmlPickler a => PU a
xpickle PU o
forall a. XmlPickler a => PU a
xpickle PU p
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 = 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)
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
forall a. XmlPickler a => PU a
xpickle PU b
forall a. XmlPickler a => PU a
xpickle PU c
forall a. XmlPickler a => PU a
xpickle PU d
forall a. XmlPickler a => PU a
xpickle PU e
forall a. XmlPickler a => PU a
xpickle PU f
forall a. XmlPickler a => PU a
xpickle PU g
forall a. XmlPickler a => PU a
xpickle PU h
forall a. XmlPickler a => PU a
xpickle PU i
forall a. XmlPickler a => PU a
xpickle PU j
forall a. XmlPickler a => PU a
xpickle PU k
forall a. XmlPickler a => PU a
xpickle PU l
forall a. XmlPickler a => PU a
xpickle PU m
forall a. XmlPickler a => PU a
xpickle PU n
forall a. XmlPickler a => PU a
xpickle PU o
forall a. XmlPickler a => PU a
xpickle PU p
forall a. XmlPickler a => PU a
xpickle PU q
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 = 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)
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
forall a. XmlPickler a => PU a
xpickle PU b
forall a. XmlPickler a => PU a
xpickle PU c
forall a. XmlPickler a => PU a
xpickle PU d
forall a. XmlPickler a => PU a
xpickle PU e
forall a. XmlPickler a => PU a
xpickle PU f
forall a. XmlPickler a => PU a
xpickle PU g
forall a. XmlPickler a => PU a
xpickle PU h
forall a. XmlPickler a => PU a
xpickle PU i
forall a. XmlPickler a => PU a
xpickle PU j
forall a. XmlPickler a => PU a
xpickle PU k
forall a. XmlPickler a => PU a
xpickle PU l
forall a. XmlPickler a => PU a
xpickle PU m
forall a. XmlPickler a => PU a
xpickle PU n
forall a. XmlPickler a => PU a
xpickle PU o
forall a. XmlPickler a => PU a
xpickle PU p
forall a. XmlPickler a => PU a
xpickle PU q
forall a. XmlPickler a => PU a
xpickle PU r
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 = 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)
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
forall a. XmlPickler a => PU a
xpickle PU b
forall a. XmlPickler a => PU a
xpickle PU c
forall a. XmlPickler a => PU a
xpickle PU d
forall a. XmlPickler a => PU a
xpickle PU e
forall a. XmlPickler a => PU a
xpickle PU f
forall a. XmlPickler a => PU a
xpickle PU g
forall a. XmlPickler a => PU a
xpickle PU h
forall a. XmlPickler a => PU a
xpickle PU i
forall a. XmlPickler a => PU a
xpickle PU j
forall a. XmlPickler a => PU a
xpickle PU k
forall a. XmlPickler a => PU a
xpickle PU l
forall a. XmlPickler a => PU a
xpickle PU m
forall a. XmlPickler a => PU a
xpickle PU n
forall a. XmlPickler a => PU a
xpickle PU o
forall a. XmlPickler a => PU a
xpickle PU p
forall a. XmlPickler a => PU a
xpickle PU q
forall a. XmlPickler a => PU a
xpickle PU r
forall a. XmlPickler a => PU a
xpickle PU s
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 = 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)
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
forall a. XmlPickler a => PU a
xpickle PU b
forall a. XmlPickler a => PU a
xpickle PU c
forall a. XmlPickler a => PU a
xpickle PU d
forall a. XmlPickler a => PU a
xpickle PU e
forall a. XmlPickler a => PU a
xpickle PU f
forall a. XmlPickler a => PU a
xpickle PU g
forall a. XmlPickler a => PU a
xpickle PU h
forall a. XmlPickler a => PU a
xpickle PU i
forall a. XmlPickler a => PU a
xpickle PU j
forall a. XmlPickler a => PU a
xpickle PU k
forall a. XmlPickler a => PU a
xpickle PU l
forall a. XmlPickler a => PU a
xpickle PU m
forall a. XmlPickler a => PU a
xpickle PU n
forall a. XmlPickler a => PU a
xpickle PU o
forall a. XmlPickler a => PU a
xpickle PU p
forall a. XmlPickler a => PU a
xpickle PU q
forall a. XmlPickler a => PU a
xpickle PU r
forall a. XmlPickler a => PU a
xpickle PU s
forall a. XmlPickler a => PU a
xpickle PU t
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 = 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)
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
forall a. XmlPickler a => PU a
xpickle PU b
forall a. XmlPickler a => PU a
xpickle PU c
forall a. XmlPickler a => PU a
xpickle PU d
forall a. XmlPickler a => PU a
xpickle PU e
forall a. XmlPickler a => PU a
xpickle PU f
forall a. XmlPickler a => PU a
xpickle PU g
forall a. XmlPickler a => PU a
xpickle PU h
forall a. XmlPickler a => PU a
xpickle PU i
forall a. XmlPickler a => PU a
xpickle PU j
forall a. XmlPickler a => PU a
xpickle PU k
forall a. XmlPickler a => PU a
xpickle PU l
forall a. XmlPickler a => PU a
xpickle PU m
forall a. XmlPickler a => PU a
xpickle PU n
forall a. XmlPickler a => PU a
xpickle PU o
forall a. XmlPickler a => PU a
xpickle PU p
forall a. XmlPickler a => PU a
xpickle PU q
forall a. XmlPickler a => PU a
xpickle PU r
forall a. XmlPickler a => PU a
xpickle PU s
forall a. XmlPickler a => PU a
xpickle PU t
forall a. XmlPickler a => PU a
xpickle PU u
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 = 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)
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
forall a. XmlPickler a => PU a
xpickle PU b
forall a. XmlPickler a => PU a
xpickle PU c
forall a. XmlPickler a => PU a
xpickle PU d
forall a. XmlPickler a => PU a
xpickle PU e
forall a. XmlPickler a => PU a
xpickle PU f
forall a. XmlPickler a => PU a
xpickle PU g
forall a. XmlPickler a => PU a
xpickle PU h
forall a. XmlPickler a => PU a
xpickle PU i
forall a. XmlPickler a => PU a
xpickle PU j
forall a. XmlPickler a => PU a
xpickle PU k
forall a. XmlPickler a => PU a
xpickle PU l
forall a. XmlPickler a => PU a
xpickle PU m
forall a. XmlPickler a => PU a
xpickle PU n
forall a. XmlPickler a => PU a
xpickle PU o
forall a. XmlPickler a => PU a
xpickle PU p
forall a. XmlPickler a => PU a
xpickle PU q
forall a. XmlPickler a => PU a
xpickle PU r
forall a. XmlPickler a => PU a
xpickle PU s
forall a. XmlPickler a => PU a
xpickle PU t
forall a. XmlPickler a => PU a
xpickle PU u
forall a. XmlPickler a => PU a
xpickle PU v
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 = 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)
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
forall a. XmlPickler a => PU a
xpickle PU b
forall a. XmlPickler a => PU a
xpickle PU c
forall a. XmlPickler a => PU a
xpickle PU d
forall a. XmlPickler a => PU a
xpickle PU e
forall a. XmlPickler a => PU a
xpickle PU f
forall a. XmlPickler a => PU a
xpickle PU g
forall a. XmlPickler a => PU a
xpickle PU h
forall a. XmlPickler a => PU a
xpickle PU i
forall a. XmlPickler a => PU a
xpickle PU j
forall a. XmlPickler a => PU a
xpickle PU k
forall a. XmlPickler a => PU a
xpickle PU l
forall a. XmlPickler a => PU a
xpickle PU m
forall a. XmlPickler a => PU a
xpickle PU n
forall a. XmlPickler a => PU a
xpickle PU o
forall a. XmlPickler a => PU a
xpickle PU p
forall a. XmlPickler a => PU a
xpickle PU q
forall a. XmlPickler a => PU a
xpickle PU r
forall a. XmlPickler a => PU a
xpickle PU s
forall a. XmlPickler a => PU a
xpickle PU t
forall a. XmlPickler a => PU a
xpickle PU u
forall a. XmlPickler a => PU a
xpickle PU v
forall a. XmlPickler a => PU a
xpickle PU w
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 = 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)
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
forall a. XmlPickler a => PU a
xpickle PU b
forall a. XmlPickler a => PU a
xpickle PU c
forall a. XmlPickler a => PU a
xpickle PU d
forall a. XmlPickler a => PU a
xpickle PU e
forall a. XmlPickler a => PU a
xpickle PU f
forall a. XmlPickler a => PU a
xpickle PU g
forall a. XmlPickler a => PU a
xpickle PU h
forall a. XmlPickler a => PU a
xpickle PU i
forall a. XmlPickler a => PU a
xpickle PU j
forall a. XmlPickler a => PU a
xpickle PU k
forall a. XmlPickler a => PU a
xpickle PU l
forall a. XmlPickler a => PU a
xpickle PU m
forall a. XmlPickler a => PU a
xpickle PU n
forall a. XmlPickler a => PU a
xpickle PU o
forall a. XmlPickler a => PU a
xpickle PU p
forall a. XmlPickler a => PU a
xpickle PU q
forall a. XmlPickler a => PU a
xpickle PU r
forall a. XmlPickler a => PU a
xpickle PU s
forall a. XmlPickler a => PU a
xpickle PU t
forall a. XmlPickler a => PU a
xpickle PU u
forall a. XmlPickler a => PU a
xpickle PU v
forall a. XmlPickler a => PU a
xpickle PU w
forall a. XmlPickler a => PU a
xpickle PU x
forall a. XmlPickler a => PU a
xpickle

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

instance XmlPickler a => XmlPickler (Maybe a) where
    xpickle :: PU (Maybe a)
xpickle = PU a -> PU (Maybe a)
forall a. PU a -> PU (Maybe a)
xpOption PU a
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 = PU l -> PU r -> PU (Either l r)
forall l r. PU l -> PU r -> PU (Either l r)
pick PU l
forall a. XmlPickler a => PU a
xpickle PU r
forall a. XmlPickler a => PU a
xpickle
          where
            pick :: PU l -> PU r -> PU (Either l r)
            pick :: PU l -> PU r -> PU (Either l r)
pick PU l
lPickler PU r
rPickler =
              (Either l r -> Int) -> [PU (Either l r)] -> PU (Either l r)
forall a. (a -> Int) -> [PU a] -> PU a
xpAlt (Int -> l -> Int
forall a b. a -> b -> a
const Int
0 (l -> Int) -> (r -> Int) -> Either l r -> Int
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
`either` Int -> r -> Int
forall a b. a -> b -> a
const Int
1)
              [ (l -> Either l r, Either l r -> l) -> PU l -> PU (Either l r)
forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap (   l -> Either l r
forall a b. a -> Either a b
Left            -- Construct.
                       , \ (Left l
l ) -> l
l  -- Deconstruct.
                       ) PU l
lPickler
              , (r -> Either l r, Either l r -> r) -> PU r -> PU (Either l r)
forall a b. (a -> b, b -> a) -> PU a -> PU b
xpWrap (    r -> Either l r
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 -}