{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances #-}
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
data St = St { St -> [XmlTree]
attributes :: [XmlTree]
, St -> [XmlTree]
contents :: [XmlTree]
, St -> Int
nesting :: Int
, St -> QName
pname :: QName
, 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
, PU a -> Unpickler a
appUnPickle :: Unpickler a
, PU a -> Schema
theSchema :: Schema
}
type Pickler a = a -> St -> St
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 f :: a -> b
f u :: 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
st ->
let (r :: UnpickleVal a
r, st' :: 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
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
st -> (a -> UnpickleVal a
forall a b. b -> Either a b
Right a
a, St
st)
uf :: Unpickler (a -> b)
uf <*> :: Unpickler (a -> b) -> Unpickler a -> Unpickler b
<*> ua :: 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
st ->
let (f :: UnpickleVal (a -> b)
f, st' :: 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 err :: UnpickleErr
err -> (UnpickleErr -> UnpickleVal b
forall a b. a -> Either a b
Left UnpickleErr
err, St
st')
Right f' :: 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
u :: Unpickler a
u >>= :: Unpickler a -> (a -> Unpickler b) -> Unpickler b
>>= f :: 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
st ->
let (r :: UnpickleVal a
r, st' :: 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 err :: UnpickleErr
err -> (UnpickleErr -> UnpickleVal b
forall a b. a -> Either a b
Left UnpickleErr
err, St
st')
Right v :: 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 -> (St -> UnpickleVal St
forall a b. b -> Either a b
Right St
st, St
st)
put :: St -> Unpickler ()
put st :: 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
$ \ _ -> (() -> UnpickleVal ()
forall a b. b -> Either a b
Right (), St
st)
instance MonadError UnpickleErr Unpickler where
throwError :: UnpickleErr -> Unpickler a
throwError err :: 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
st -> (UnpickleErr -> UnpickleVal a
forall a b. a -> Either a b
Left UnpickleErr
err, St
st)
catchError :: Unpickler a -> (UnpickleErr -> Unpickler a) -> Unpickler a
catchError u :: Unpickler a
u handler :: 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
st ->
let (r :: UnpickleVal a
r, st' :: 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 err :: 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
_ -> (UnpickleVal a
r, St
st')
throwMsg :: String -> Unpickler a
throwMsg :: String -> Unpickler a
throwMsg msg :: 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
st -> (UnpickleErr -> UnpickleVal a
forall a b. a -> Either a b
Left (String
msg, St
st), St
st)
mchoice :: Unpickler a -> (a -> Unpickler b) -> Unpickler b -> Unpickler b
mchoice :: Unpickler a -> (a -> Unpickler b) -> Unpickler b -> Unpickler b
mchoice u :: Unpickler a
u f :: a -> Unpickler b
f v :: 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
st ->
let (r :: UnpickleVal a
r, st' :: 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 x :: 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'
Left e :: UnpickleErr
e@(_msg :: String
_msg, st'' :: St
st'')
-> if St -> Int
nesting St
st'' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== St -> Int
nesting St
st
then Unpickler b -> St -> (UnpickleVal b, St)
forall a. Unpickler a -> St -> (UnpickleVal a, St)
runUP Unpickler b
v St
st
else (UnpickleErr -> UnpickleVal b
forall a b. a -> Either a b
Left UnpickleErr
e, St
st')
liftMaybe :: String -> Maybe a -> Unpickler a
liftMaybe :: String -> Maybe a -> Unpickler a
liftMaybe e :: String
e v :: Maybe a
v = case Maybe a
v of
Nothing -> String -> Unpickler a
forall a. String -> Unpickler a
throwMsg String
e
Just x :: a
x -> a -> Unpickler a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
liftUnpickleVal :: UnpickleVal a -> Unpickler a
liftUnpickleVal :: UnpickleVal a -> Unpickler a
liftUnpickleVal v :: 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
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 "no more contents to be read"
(x :: XmlTree
x : xs :: [XmlTree]
xs) -> do (St -> St) -> Unpickler ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\ s :: 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 qn :: 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
Nothing -> String -> Unpickler XmlTree
forall a. String -> Unpickler a
throwMsg (String -> Unpickler XmlTree) -> String -> Unpickler XmlTree
forall a b. (a -> b) -> a -> b
$ "no attribute value found for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ QName -> String
forall a. Show a => a -> String
show QName
qn
Just (a :: XmlTree
a, as' :: [XmlTree]
as') -> do (St -> St) -> Unpickler ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\ s :: 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 a' :: 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 ""
getNSAtt :: String -> Unpickler ()
getNSAtt :: String -> Unpickler ()
getNSAtt ns :: 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
Nothing -> String -> Unpickler ()
forall a. String -> Unpickler a
throwMsg (String -> Unpickler ()) -> String -> Unpickler ()
forall a b. (a -> b) -> a -> b
$
"no namespace declaration found for namespace " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
ns
Just (_a :: XmlTree
_a, as' :: [XmlTree]
as') -> do (St -> St) -> Unpickler ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\ s :: St
s -> St
s {attributes :: [XmlTree]
attributes = [XmlTree]
as'})
() -> Unpickler ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
isNS :: XmlTree -> Bool
isNS t :: 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 = 0
, pname :: QName
pname = String -> QName
mkName "/"
, pelem :: Bool
pelem = Bool
True
}
putAtt :: QName -> [XmlTree] -> St -> St
putAtt :: QName -> [XmlTree] -> St -> St
putAtt qn :: QName
qn v :: [XmlTree]
v s :: 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 x :: XmlTree
x s :: St
s = St
s {contents :: [XmlTree]
contents = XmlTree
x XmlTree -> [XmlTree] -> [XmlTree]
forall a. a -> [a] -> [a]
: St -> [XmlTree]
contents St
s}
{-# INLINE putCont #-}
findElem :: (a -> Bool) -> [a] -> Maybe (a, [a])
findElem :: (a -> Bool) -> [a] -> Maybe (a, [a])
findElem p :: 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' _ [] = Maybe (a, c)
forall a. Maybe a
Nothing
find' prefix :: [a] -> c
prefix (x :: a
x : xs :: [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
formatSt :: St -> String
formatSt :: St -> String
formatSt st :: 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 = "\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ "context: " String -> ShowS
forall a. [a] -> [a] -> [a]
++
( if St -> Bool
pelem St
st
then "element"
else "attribute"
) String -> ShowS
forall a. [a] -> [a] -> [a]
++
" " 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 [] = ""
fc cs :: [XmlTree]
cs = "\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ "contents: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [XmlTree] -> String
formatXML [XmlTree]
cs
fa :: [XmlTree] -> String
fa [] = ""
fa as :: [XmlTree]
as = "\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ "attributes: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [XmlTree] -> String
formatXML [XmlTree]
as
formatXML :: [XmlTree] -> String
formatXML = Int -> ShowS
format 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 n :: Int
n s :: 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
+ 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]
++ "..."
pickleDoc :: PU a -> a -> XmlTree
pickleDoc :: PU a -> a -> XmlTree
pickleDoc p :: PU a
p v :: 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
unpickleDoc :: PU a -> XmlTree -> Maybe a
unpickleDoc :: PU a -> XmlTree -> Maybe a
unpickleDoc p :: 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
unpickleDoc' :: PU a -> XmlTree -> Either String a
unpickleDoc' :: PU a -> XmlTree -> Either String a
unpickleDoc' p :: PU a
p t :: 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 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
.
\ (msg :: String
msg, st :: 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
unpickleElem' :: PU a -> Int -> XmlTree -> UnpickleVal a
unpickleElem' :: PU a -> Int -> XmlTree -> UnpickleVal a
unpickleElem' p :: PU a
p l :: Int
l t :: XmlTree
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
}
showPickled :: (XmlPickler a) => SysConfigList -> a -> String
showPickled :: SysConfigList -> a -> String
showPickled a :: 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))
xpZero :: String -> PU a
xpZero :: String -> PU a
xpZero err :: 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
}
xpUnit :: PU ()
xpUnit :: PU ()
xpUnit = () -> PU ()
forall a. a -> PU a
xpLift ()
xpCheckEmptyContents :: PU a -> PU a
xpCheckEmptyContents :: PU a -> PU a
xpCheckEmptyContents pa :: 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
"xpCheckEmptyContents: unprocessed XML content detected"
xpCheckEmptyAttributes :: PU a -> PU a
xpCheckEmptyAttributes :: PU a -> PU a
xpCheckEmptyAttributes pa :: 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
"xpCheckEmptyAttributes: unprocessed XML attribute(s) detected"
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 x :: 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
}
xpLiftMaybe :: Maybe a -> PU a
xpLiftMaybe :: Maybe a -> PU a
xpLiftMaybe v :: 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'' Nothing = String -> PU a
forall a. String -> PU a
xpZero "xpLiftMaybe: got Nothing"
xpLiftMaybe'' (Just x :: 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 v :: 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 err :: String
err) = String -> PU a
forall a. String -> PU a
xpZero String
err
xpLiftEither'' (Right x :: a
x) = a -> PU a
forall a. a -> PU a
xpLift a
x
xpSeq :: (b -> a) -> PU a -> (a -> PU b) -> PU b
xpSeq :: (b -> a) -> PU a -> (a -> PU b) -> PU b
xpSeq f :: b -> a
f pa :: PU a
pa k :: a -> PU b
k
= PU :: forall a. Pickler a -> Unpickler a -> Schema -> PU a
PU { appPickle :: Pickler b
appPickle = ( \ b :: 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
}
xpSeq' :: PU () -> PU a -> PU a
xpSeq' :: PU () -> PU a -> PU a
xpSeq' pa :: 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
, \ y :: 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
xpChoice :: PU b -> PU a -> (a -> PU b) -> Unpickler b
xpChoice :: PU b -> PU a -> (a -> PU b) -> Unpickler b
xpChoice pb :: PU b
pb pa :: PU a
pa k :: 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)
xpWrap :: (a -> b, b -> a) -> PU a -> PU b
xpWrap :: (a -> b, b -> a) -> PU a -> PU b
xpWrap (i :: a -> b
i, j :: b -> a
j) pa :: 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 }
xpWrapMaybe :: (a -> Maybe b, b -> a) -> PU a -> PU b
xpWrapMaybe :: (a -> Maybe b, b -> a) -> PU a -> PU b
xpWrapMaybe (i :: a -> Maybe b
i, j :: b -> a
j) pa :: 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 }
xpWrapEither :: (a -> Either String b, b -> a) -> PU a -> PU b
xpWrapEither :: (a -> Either String b, b -> a) -> PU a -> PU b
xpWrapEither (i :: a -> Either String b
i, j :: b -> a
j) pa :: 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 }
xpPair :: PU a -> PU b -> PU (a, b)
xpPair :: PU a -> PU b -> PU (a, b)
xpPair pa :: PU a
pa pb :: 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 ->
((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
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) }
xpTriple :: PU a -> PU b -> PU c -> PU (a, b, c)
xpTriple :: PU a -> PU b -> PU c -> PU (a, b, c)
xpTriple pa :: PU a
pa pb :: PU b
pb pc :: 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
a, ~(b :: b
b, c :: c
c)) = (a
a, b
b, c
c )
fromTriple :: (a, a, b) -> (a, (a, b))
fromTriple ~(a :: a
a, b :: a
b, c :: b
c ) = (a
a, (a
b, b
c))
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 pa :: PU a
pa pb :: PU b
pb pc :: PU c
pc pd :: 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
a, ~(b :: b
b, ~(c :: c
c, d :: 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
b, c :: a
c, d :: b
d ) = (a
a, (a
b, (a
c, b
d)))
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 pa :: PU a
pa pb :: PU b
pb pc :: PU c
pc pd :: PU d
pd pe :: 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
a, ~(b :: b
b, ~(c :: c
c, ~(d :: d
d, e :: 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
b, c :: a
c, d :: a
d, e :: b
e ) = (a
a, (a
b, (a
c, (a
d, b
e))))
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 pa :: PU a
pa pb :: PU b
pb pc :: PU c
pc pd :: PU d
pd pe :: PU e
pe pf :: 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
a, ~(b :: b
b, ~(c :: c
c, ~(d :: d
d, ~(e :: e
e, f :: 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
b, c :: a
c, d :: a
d, e :: a
e, f :: b
f) = (a
a, (a
b, (a
c, (a
d, (a
e, b
f)))))
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 a :: PU a
a b :: PU b
b c :: PU c
c d :: PU d
d e :: PU e
e f :: PU f
f g :: 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
a, (b :: b
b, c :: c
c, d :: d
d, e :: e
e, f :: f
f, g :: g
g)) -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g)
, \ (a :: a
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e, f :: f
f, g :: 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 a :: PU a
a b :: PU b
b c :: PU c
c d :: PU d
d e :: PU e
e f :: PU f
f g :: PU g
g h :: 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
a, b :: b
b), (c :: c
c, d :: d
d, e :: e
e, f :: f
f, g :: g
g, h :: h
h)) -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h)
, \ (a :: a
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e, f :: f
f, g :: g
g, h :: 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 a :: PU a
a b :: PU b
b c :: PU c
c d :: PU d
d e :: PU e
e f :: PU f
f g :: PU g
g h :: PU h
h i :: 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
a, b :: b
b, c :: c
c), (d :: d
d, e :: e
e, f :: f
f, g :: g
g, h :: h
h, i :: i
i)) -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i)
, \ (a :: a
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e, f :: f
f, g :: g
g, h :: h
h, i :: 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 a :: PU a
a b :: PU b
b c :: PU c
c d :: PU d
d e :: PU e
e f :: PU f
f g :: PU g
g h :: PU h
h i :: PU i
i j :: 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
a, b :: b
b, c :: c
c, d :: d
d), (e :: e
e, f :: f
f, g :: g
g, h :: h
h, i :: i
i, j :: j
j)) -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j)
, \ (a :: a
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e, f :: f
f, g :: g
g, h :: h
h, i :: i
i, j :: 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 a :: PU a
a b :: PU b
b c :: PU c
c d :: PU d
d e :: PU e
e f :: PU f
f g :: PU g
g h :: PU h
h i :: PU i
i j :: PU j
j k :: 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
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e), (f :: f
f, g :: g
g, h :: h
h, i :: i
i, j :: j
j, k :: 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
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e, f :: f
f, g :: g
g, h :: h
h, i :: i
i, j :: j
j, k :: 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 a :: PU a
a b :: PU b
b c :: PU c
c d :: PU d
d e :: PU e
e f :: PU f
f g :: PU g
g h :: PU h
h i :: PU i
i j :: PU j
j k :: PU k
k l :: 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
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e, f :: f
f), (g :: g
g, h :: h
h, i :: i
i, j :: j
j, k :: k
k, l :: 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
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e, f :: f
f, g :: g
g, h :: h
h, i :: i
i, j :: j
j, k :: k
k, l :: 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 a :: PU a
a b :: PU b
b c :: PU c
c d :: PU d
d e :: PU e
e f :: PU f
f g :: PU g
g h :: PU h
h i :: PU i
i j :: PU j
j k :: PU k
k l :: PU l
l m :: 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
a, (b :: b
b, c :: c
c, d :: d
d, e :: e
e, f :: f
f, g :: g
g), (h :: h
h, i :: i
i, j :: j
j, k :: k
k, l :: l
l, m :: 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
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e, f :: f
f, g :: g
g, h :: h
h, i :: i
i, j :: j
j, k :: k
k, l :: l
l, m :: 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 a :: PU a
a b :: PU b
b c :: PU c
c d :: PU d
d e :: PU e
e f :: PU f
f g :: PU g
g h :: PU h
h i :: PU i
i j :: PU j
j k :: PU k
k l :: PU l
l m :: PU m
m n :: 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
a, b :: b
b), (c :: c
c, d :: d
d, e :: e
e, f :: f
f, g :: g
g, h :: h
h), (i :: i
i, j :: j
j, k :: k
k, l :: l
l, m :: m
m, n :: 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
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e, f :: f
f, g :: g
g, h :: h
h, i :: i
i, j :: j
j, k :: k
k, l :: l
l, m :: m
m, n :: 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 a :: PU a
a b :: PU b
b c :: PU c
c d :: PU d
d e :: PU e
e f :: PU f
f g :: PU g
g h :: PU h
h i :: PU i
i j :: PU j
j k :: PU k
k l :: PU l
l m :: PU m
m n :: PU n
n o :: 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
a, b :: b
b, c :: c
c), (d :: d
d, e :: e
e, f :: f
f, g :: g
g, h :: h
h, i :: i
i), (j :: j
j, k :: k
k, l :: l
l, m :: m
m, n :: n
n, o :: 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
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e, f :: f
f, g :: g
g, h :: h
h, i :: i
i, j :: j
j, k :: k
k, l :: l
l, m :: m
m, n :: n
n, o :: 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 a :: PU a
a b :: PU b
b c :: PU c
c d :: PU d
d e :: PU e
e f :: PU f
f g :: PU g
g h :: PU h
h i :: PU i
i j :: PU j
j k :: PU k
k l :: PU l
l m :: PU m
m n :: PU n
n o :: PU o
o p :: 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
a, b :: b
b, c :: c
c, d :: d
d), (e :: e
e, f :: f
f, g :: g
g, h :: h
h, i :: i
i, j :: j
j), (k :: k
k, l :: l
l, m :: m
m, n :: n
n, o :: o
o, p :: 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
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e, f :: f
f, g :: g
g, h :: h
h, i :: i
i, j :: j
j, k :: k
k, l :: l
l, m :: m
m, n :: n
n, o :: o
o, p :: 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 a :: PU a
a b :: PU b
b c :: PU c
c d :: PU d
d e :: PU e
e f :: PU f
f g :: PU g
g h :: PU h
h i :: PU i
i j :: PU j
j k :: PU k
k l :: PU l
l m :: PU m
m n :: PU n
n o :: PU o
o p :: PU p
p q :: 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
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e), (f :: f
f, g :: g
g, h :: h
h, i :: i
i, j :: j
j, k :: k
k), (l :: l
l, m :: m
m, n :: n
n, o :: o
o, p :: p
p, q :: 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
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e, f :: f
f, g :: g
g, h :: h
h, i :: i
i, j :: j
j, k :: k
k, l :: l
l, m :: m
m, n :: n
n, o :: o
o, p :: p
p, q :: 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 a :: PU a
a b :: PU b
b c :: PU c
c d :: PU d
d e :: PU e
e f :: PU f
f g :: PU g
g h :: PU h
h i :: PU i
i j :: PU j
j k :: PU k
k l :: PU l
l m :: PU m
m n :: PU n
n o :: PU o
o p :: PU p
p q :: PU q
q r :: 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
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e, f :: f
f), (g :: g
g, h :: h
h, i :: i
i, j :: j
j, k :: k
k, l :: l
l), (m :: m
m, n :: n
n, o :: o
o, p :: p
p, q :: q
q, r :: 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
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e, f :: f
f, g :: g
g, h :: h
h, i :: i
i, j :: j
j, k :: k
k, l :: l
l, m :: m
m, n :: n
n, o :: o
o, p :: p
p, q :: q
q, r :: 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 a :: PU a
a b :: PU b
b c :: PU c
c d :: PU d
d e :: PU e
e f :: PU f
f g :: PU g
g h :: PU h
h i :: PU i
i j :: PU j
j k :: PU k
k l :: PU l
l m :: PU m
m n :: PU n
n o :: PU o
o p :: PU p
p q :: PU q
q r :: PU r
r s :: 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
a, (b :: b
b, c :: c
c, d :: d
d, e :: e
e, f :: f
f, g :: g
g), (h :: h
h, i :: i
i, j :: j
j, k :: k
k, l :: l
l, m :: m
m), (n :: n
n, o :: o
o, p :: p
p, q :: q
q, r :: r
r, s :: 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
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e, f :: f
f, g :: g
g, h :: h
h, i :: i
i, j :: j
j, k :: k
k, l :: l
l, m :: m
m, n :: n
n, o :: o
o, p :: p
p, q :: q
q, r :: r
r, s :: 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 a :: PU a
a b :: PU b
b c :: PU c
c d :: PU d
d e :: PU e
e f :: PU f
f g :: PU g
g h :: PU h
h i :: PU i
i j :: PU j
j k :: PU k
k l :: PU l
l m :: PU m
m n :: PU n
n o :: PU o
o p :: PU p
p q :: PU q
q r :: PU r
r s :: PU s
s t :: 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
a, b :: b
b), (c :: c
c, d :: d
d, e :: e
e, f :: f
f, g :: g
g, h :: h
h), (i :: i
i, j :: j
j, k :: k
k, l :: l
l, m :: m
m, n :: n
n), (o :: o
o, p :: p
p, q :: q
q, r :: r
r, s :: s
s, t :: 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
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e, f :: f
f, g :: g
g, h :: h
h, i :: i
i, j :: j
j, k :: k
k, l :: l
l, m :: m
m, n :: n
n, o :: o
o, p :: p
p, q :: q
q, r :: r
r, s :: s
s, t :: 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 a :: PU a
a b :: PU b
b c :: PU c
c d :: PU d
d e :: PU e
e f :: PU f
f g :: PU g
g h :: PU h
h i :: PU i
i j :: PU j
j k :: PU k
k l :: PU l
l m :: PU m
m n :: PU n
n o :: PU o
o p :: PU p
p q :: PU q
q r :: PU r
r s :: PU s
s t :: PU t
t u :: 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
a, b :: b
b, c :: c
c), (d :: d
d, e :: e
e, f :: f
f, g :: g
g, h :: h
h, i :: i
i), (j :: j
j, k :: k
k, l :: l
l, m :: m
m, n :: n
n, o :: o
o), (p :: p
p, q :: q
q, r :: r
r, s :: s
s, t :: t
t, u :: 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
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e, f :: f
f, g :: g
g, h :: h
h, i :: i
i, j :: j
j, k :: k
k, l :: l
l, m :: m
m, n :: n
n, o :: o
o, p :: p
p, q :: q
q, r :: r
r, s :: s
s, t :: t
t, u :: 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 a :: PU a
a b :: PU b
b c :: PU c
c d :: PU d
d e :: PU e
e f :: PU f
f g :: PU g
g h :: PU h
h i :: PU i
i j :: PU j
j k :: PU k
k l :: PU l
l m :: PU m
m n :: PU n
n o :: PU o
o p :: PU p
p q :: PU q
q r :: PU r
r s :: PU s
s t :: PU t
t u :: PU u
u v :: 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
a, b :: b
b, c :: c
c, d :: d
d), (e :: e
e, f :: f
f, g :: g
g, h :: h
h, i :: i
i, j :: j
j), (k :: k
k, l :: l
l, m :: m
m, n :: n
n, o :: o
o, p :: p
p), (q :: q
q, r :: r
r, s :: s
s, t :: t
t, u :: u
u, v :: 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
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e, f :: f
f, g :: g
g, h :: h
h, i :: i
i, j :: j
j, k :: k
k, l :: l
l, m :: m
m, n :: n
n, o :: o
o, p :: p
p, q :: q
q, r :: r
r, s :: s
s, t :: t
t, u :: u
u, v :: 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 a :: PU a
a b :: PU b
b c :: PU c
c d :: PU d
d e :: PU e
e f :: PU f
f g :: PU g
g h :: PU h
h i :: PU i
i j :: PU j
j k :: PU k
k l :: PU l
l m :: PU m
m n :: PU n
n o :: PU o
o p :: PU p
p q :: PU q
q r :: PU r
r s :: PU s
s t :: PU t
t u :: PU u
u v :: PU v
v w :: 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
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e), (f :: f
f, g :: g
g, h :: h
h, i :: i
i, j :: j
j, k :: k
k), (l :: l
l, m :: m
m, n :: n
n, o :: o
o, p :: p
p, q :: q
q), (r :: r
r, s :: s
s, t :: t
t, u :: u
u, v :: v
v, w :: 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
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e, f :: f
f, g :: g
g, h :: h
h, i :: i
i, j :: j
j, k :: k
k, l :: l
l, m :: m
m, n :: n
n, o :: o
o, p :: p
p, q :: q
q, r :: r
r, s :: s
s, t :: t
t, u :: u
u, v :: v
v, w :: 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))
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 a :: PU a
a b :: PU b
b c :: PU c
c d :: PU d
d e :: PU e
e f :: PU f
f g :: PU g
g h :: PU h
h i :: PU i
i j :: PU j
j k :: PU k
k l :: PU l
l m :: PU m
m n :: PU n
n o :: PU o
o p :: PU p
p q :: PU q
q r :: PU r
r s :: PU s
s t :: PU t
t u :: PU u
u v :: PU v
v w :: PU w
w x :: 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
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e, f :: f
f), (g :: g
g, h :: h
h, i :: i
i, j :: j
j, k :: k
k, l :: l
l), (m :: m
m, n :: n
n, o :: o
o, p :: p
p, q :: q
q, r :: r
r), (s :: s
s, t :: t
t, u :: u
u, v :: v
v, w :: w
w, x :: 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
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e, f :: f
f, g :: g
g, h :: h
h, i :: i
i, j :: j
j, k :: k
k, l :: l
l, m :: m
m, n :: n
n, o :: o
o, p :: p
p, q :: q
q, r :: r
r, s :: s
s, t :: t
t, u :: u
u, v :: v
v, w :: w
w, x :: 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))
xpText :: PU String
xpText :: PU String
xpText = Schema -> PU String
xpTextDT Schema
scString1
{-# INLINE xpText #-}
xpTextDT :: Schema -> PU String
xpTextDT :: Schema -> PU String
xpTextDT sc :: 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 "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
}
xpText0 :: PU String
xpText0 :: PU String
xpText0 = Schema -> PU String
xpText0DT Schema
scString1
{-# INLINE xpText0 #-}
xpText0DT :: Schema -> PU String
xpText0DT :: Schema -> PU String
xpText0DT sc :: 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 -> 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 "" = Maybe String
forall a. Maybe a
Nothing
emptyToNothing x :: String
x = String -> Maybe String
forall a. a -> Maybe a
Just String
x
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 str :: 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 [(x :: b
x,"")] = b -> Either String b
forall a b. b -> Either a b
Right b
x
val _ = 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
$ "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]
++ " failed"
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 -> 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' (\ r :: Int
r c :: Char
c -> 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 '0')) 0 (String -> Either String Int) -> String -> Either String Int
forall a b. (a -> b) -> a -> b
$ String
xs
readMaybe ('-' : xs :: String
xs) = (Int -> Int) -> Either String Int -> Either String Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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 ('+' : xs :: 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 xs :: 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
$ "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]
++ " failed"
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
}
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 }
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
xpOption :: PU a -> PU (Maybe a)
xpOption :: PU a -> PU (Maybe a)
xpOption pa :: PU a
pa = PU :: forall a. Pickler a -> Unpickler a -> Schema -> PU a
PU { appPickle :: Pickler (Maybe a)
appPickle = ( \ a :: Maybe a
a ->
case Maybe a
a of
Nothing -> St -> St
forall a. a -> a
id
Just x :: 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)
}
xpDefault :: (Eq a) => a -> PU a -> PU a
xpDefault :: a -> PU a -> PU a
xpDefault df :: 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
, \ x :: 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
xpList :: PU a -> PU [a]
xpList :: PU a -> PU [a]
xpList pa :: PU a
pa = PU :: forall a. Pickler a -> Unpickler a -> Schema -> PU a
PU { appPickle :: Pickler [a]
appPickle = ( \ a :: [a]
a ->
case [a]
a of
[] -> St -> St
forall a. a -> a
id
_:_ -> 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
(\ x :: 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) (\xs :: [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 (\ x :: 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) (\ xs :: [a]
xs ->
[a] -> PU [a]
forall a. a -> PU a
xpLift (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) ))
xpList1 :: PU a -> PU [a]
xpList1 :: PU a -> PU [a]
xpList1 pa :: 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 (\ (x :: a
x, xs :: [a]
xs) -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs
,\ x :: [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) }
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 en :: String
en an :: String
an xpk :: PU k
xpk xpv :: 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
xpAlt :: (a -> Int) -> [PU a] -> PU a
xpAlt :: (a -> Int) -> [PU a] -> PU a
xpAlt tag :: a -> Int
tag ps :: [PU a]
ps = PU :: forall a. Pickler a -> Unpickler a -> Schema -> PU a
PU { appPickle :: Pickler a
appPickle = \ a :: 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 "xpAlt: no matching unpickler found for a sum datatype"
pa :: PU a
pa:ps1 :: [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)
}
xpElemQN :: QName -> PU a -> PU a
xpElemQN :: QName -> PU a -> PU a
xpElemQN qn :: QName
qn pa :: PU a
pa = PU :: forall a. Pickler a -> Unpickler a -> Schema -> PU a
PU { appPickle :: Pickler a
appPickle = ( \ a :: 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 "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 ("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]
++ ", 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
+ 1) XmlTree
t
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
xpElemNS :: String -> String -> String -> PU a -> PU a
xpElemNS :: String -> String -> String -> PU a -> PU a
xpElemNS ns :: String
ns px :: String
px lp :: 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
xpElemWithAttrValue :: String -> String -> String -> PU a -> PU a
xpElemWithAttrValue :: String -> String -> String -> PU a -> PU a
xpElemWithAttrValue name :: String
name an :: String
an av :: String
av pa :: 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
xpAttrQN :: QName -> PU a -> PU a
xpAttrQN :: QName -> PU a -> PU a
xpAttrQN qn :: QName
qn pa :: PU a
pa = PU :: forall a. Pickler a -> Unpickler a -> Schema -> PU a
PU { appPickle :: Pickler a
appPickle = ( \ a :: 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
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
xpAttrNS :: String -> String -> String -> PU a -> PU a
xpAttrNS :: String -> String -> String -> PU a -> PU a
xpAttrNS ns :: String
ns px :: String
px lp :: 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)
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
xpAttrImplied :: String -> PU a -> PU (Maybe a)
xpAttrImplied :: String -> PU a -> PU (Maybe a)
xpAttrImplied name :: String
name pa :: 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 name :: String
name val :: String
val
= ( (String -> Either String (), () -> String) -> PU String -> PU ()
forall a b. (a -> Either String b, b -> a) -> PU a -> PU b
xpWrapEither ( \ v :: 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 ( "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]
++ " 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) }
xpAddFixedAttr :: String -> String -> PU a -> PU a
xpAddFixedAttr :: String -> String -> PU a -> PU a
xpAddFixedAttr name :: String
name val :: 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
xpAddNSDecl :: String -> String -> PU a -> PU a
xpAddNSDecl :: String -> String -> PU a -> PU a
xpAddNSDecl name :: String
name val :: 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 = "xmlns"
| Bool
otherwise = "xmlns:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name
xpAttrNSDecl :: String -> String -> PU ()
xpAttrNSDecl :: String -> String -> PU ()
xpAttrNSDecl name :: String
name ns :: 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
$ \ mf :: [XmlTree] -> [XmlTree]
mf s :: 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
$ \ mf :: [XmlTree] -> [XmlTree]
mf s :: 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}
xpFilterCont :: LA XmlTree XmlTree -> PU a -> PU a
xpFilterCont :: LA XmlTree XmlTree -> PU a -> PU a
xpFilterCont f :: 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
xpFilterAttr :: LA XmlTree XmlTree -> PU a -> PU a
xpFilterAttr :: LA XmlTree XmlTree -> PU a -> PU a
xpFilterAttr f :: 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 m :: ([XmlTree] -> [XmlTree]) -> St -> St
m f :: 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)
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
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 [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