module Data.XML.Pickle (
PU(..)
, Attribute
, UnpickleResult(..)
, pickle
, unpickle
, xpUnit
, xpZero
, xpThrow
, xpIso
, xpPartial
, xpId
, xpFst
, xpSnd
, xpTrees
, xpHead
, xpTree
, xpText0
, xpText
, xpString
, xpRoot
, xpPrim
, xpAttribute
, xpAttribute'
, xpAttribute_
, xpAttr
, xpAttrImplied
, xpAttrFixed
, xpAddFixedAttr
, xpElem
, xpElemWithName
, xpElemByNamespace
, xpElemVerbatim
, xpElemAttrs
, xpElemNodes
, xpElemText
, xpElemBlank
, xpElemExists
, xpElems
, xpContent
, xpBool
, xpOption
, xpDefault
, xpWithDefault
, xpMap
, xpAlt
, xpChoice
, xpEither
, xpTryCatch
, xpFindMatches
, xpFindFirst
, xpAll
, xpSubsetAll
, xpAllByNamespace
, xpList0
, xpSeqWhile
, xpList
, xpListMinLen
, xp2Tuple
, xpPair
, (<#>)
, xp3Tuple
, xpTriple
, xp4Tuple
, xp5Tuple
, xp6Tuple
, xpWrap
, xpConst
, xpWrapEither
, xpWrapMaybe
, xpWrapMaybe_
, xpAssert
, xpMayFail
, xpUnliftElems
, xpIsolate
, xpPeek
, xpClean
, UnpickleError(..)
, ppUnpickleError
, (<++>)
, (<?+>)
, (<?>)
, (<??>)
, UnresolvedEntityException(..)
, flattenContent
, tErr
, getRest
) where
import Control.Applicative ((<$>))
import Control.Arrow
import Control.Exception
import Control.Monad
import Data.Char (isSpace)
import Data.Either
import Data.List (partition)
import qualified Data.Map as M
import Data.Maybe
import Data.Monoid (Monoid, mempty)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.XML.Types
import Data.XML.Pickle.Tuples
import Data.XML.Pickle.Basic
pickle :: PU t a -> a -> t
pickle = pickleTree
unpickle :: PU t a -> t -> Either UnpickleError a
unpickle xp x = case unpickleTree xp x of
UnpickleError e -> Left e
NoResult e -> Left . ErrorMessage $ "Entity not found " `Text.append` e
Result r _ -> Right r
for :: [a] -> (a -> b) -> [b]
for = flip map
type Attribute = (Name,[Content])
xpIso :: (a -> b) -> (b -> a) -> PU a b
xpIso f g = PU (\t -> Result (f t) Nothing) g
xpPartial :: (a -> Either Text b)
-> (b -> a)
-> PU a b
xpPartial f g = ("xpEither", "") <?+>
PU { pickleTree = g
, unpickleTree = \v -> case f v of
Left e -> UnpickleError $ ErrorMessage e
Right r -> Result r Nothing
}
xpUnit :: PU [a] ()
xpUnit = PU (Result () . remList) (const [])
xpId :: PU a a
xpId = xpIso id id
xpTrees :: PU a a
xpTrees = xpId
xpBool :: PU Text Bool
xpBool = ("xpBool" ,"") <?+> PU
{ unpickleTree =
\v -> case () of ()
| v `elem` ["true", "1"] ->
Result True Nothing
| v `elem` ["false", "0"] ->
Result False Nothing
| otherwise -> UnpickleError
(ErrorMessage $
"Not a boolean value: "
`Text.append` v)
, pickleTree = \v -> case v of
True -> "true"
False -> "false"
}
xpWrap :: (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap to from xp = ("xpWrap","") <?+>
PU { unpickleTree = \x -> to <$> unpickleTree xp x
, pickleTree = pickleTree xp . from
}
xpWrapMaybe :: (a -> Maybe b) -> (b -> a) -> PU t a -> PU t b
xpWrapMaybe a2b b2a pua = ("xpWrapMaybe","") <?>
xpWrapMaybe_ "xpWrapMaybe can't encode Nothing" a2b b2a pua
xpWrapMaybe_ :: String -> (a -> Maybe b) -> ( b -> a) -> PU t a -> PU t b
xpWrapMaybe_ errorMsg a2b b2a pua = ("xpWrapMaybe_","") <?+> PU {
unpickleTree = \t -> case unpickleTree pua t of
Result val rest ->
case a2b val of
Just val' -> Result val' rest
Nothing -> UnpickleError $ upe errorMsg
NoResult e -> NoResult e
UnpickleError e -> UnpickleError e
, pickleTree = pickleTree pua . b2a
}
xpOption :: PU [t] a -> PU [t] (Maybe a)
xpOption pu = PU { unpickleTree = doUnpickle
, pickleTree = \mValue ->
case mValue of
Just value -> pickleTree pu value
Nothing -> mempty
}
where
doUnpickle t =
case unpickleTree pu t of
Result r t' -> Result (Just r) t'
NoResult _e -> Result Nothing (remList t)
UnpickleError e -> UnpickleError e
xpHead :: PU [a] a
xpHead = PU {unpickleTree = \t' -> case t' of
[] -> UnpickleError $ ("xpHead","")
<++> upe "No element remaining"
t:ts -> Result t (if null ts then Nothing else Just ts)
, pickleTree = return
}
xpTree :: PU [a] a
xpTree = xpHead
xpText0 :: PU Text Text
xpText0 = xpId
xpString :: PU Text String
xpString = ("xpString", "") <?> xpIso Text.unpack Text.pack
xpAssert :: Text -> (a -> Bool) -> PU t a -> PU t a
xpAssert err p xp = ("xpAssert",err) <?+>
PU { unpickleTree = \t -> do
r <- unpickleTree xp t
unless (p r) $ UnpickleError assertErr
return r
, pickleTree = pickleTree xp
}
where
assertErr = upe ("Assertion failed; " ++ Text.unpack err)
xpText :: PU Text Text
xpText = ("xpText","") <?> xpAssert "Input is empty" (not . Text.null) xpText0
xpRoot ::PU [a] b -> PU a b
xpRoot pa = ("xpRoot","") <?+> PU
{ unpickleTree = \t -> case unpickleTree pa [t] of
Result x Nothing -> Result x Nothing
Result _x (Just _) -> UnpickleError $ upe "Leftover entities"
UnpickleError e -> UnpickleError e
NoResult e -> NoResult e
, pickleTree = \t -> case pickleTree pa t of
[t1] -> t1
_ -> error "pickler called by xpRoot must output exactly one element"
}
getFirst :: (t -> Bool) -> [t] -> Maybe (t, [t])
getFirst _ [] = Nothing
getFirst p (x:xs) = case p x of
True -> Just (x,xs)
False -> second (x:) <$> getFirst p xs
xpAttribute :: Name -> PU Text a -> PU [Attribute] a
xpAttribute name pu = ("xpAttr" , Text.pack $ ppName name) <?+> PU
{ unpickleTree = doUnpickle
, pickleTree = \value -> [(name, [ContentText $ pickleTree pu value])]
}
where
doUnpickle attrs = case getFirst ((== name) . fst) attrs of
Nothing -> NoResult $ Text.pack $ ppName name
Just ((_, c), rem')
| all isContentText c -> case unpickleTree pu (contentToText c) of
NoResult e -> missingE $ Text.unpack e
UnpickleError e -> UnpickleError e
Result _ (Just e) -> leftoverE $ show e
Result r Nothing -> Result r (remList rem')
| otherwise -> UnpickleError $
upe ("Unresolved entities in " ++ ppName name ++ ".")
contentToText = Text.concat . map contentToText_
contentToText_ (ContentText t) = t
contentToText_ (ContentEntity t) = t
isContentText (ContentText _) = True
isContentText (ContentEntity _) = False
xpAttr :: Name -> PU Text a -> PU [Attribute] a
xpAttr = xpAttribute
xpAttribute' :: Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttribute' name pu = xpOption $ xpAttr name pu
xpAttrImplied :: Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied = xpAttribute'
xpAttribute_ :: Name -> Text -> PU [Attribute] ()
xpAttribute_ name val =
xpWrapMaybe_ ("expected fixed attribute "++ ppName name++"="++show val)
(\v -> if v == val then Just () else Nothing) (const val) $
xpAttr name xpId
xpAttrFixed :: Name -> Text -> PU [Attribute] ()
xpAttrFixed = xpAttribute_
flattenContent :: [Node] -> [Node]
flattenContent xs = case foldr (\x (buf, res) -> case x of
NodeContent (ContentText txt)
-> (txt : buf, res)
NodeComment _ -> (buf, res)
e@(NodeElement _)
-> ([] , e : addConcatText buf res)
_ -> throw UnresolvedEntityException
) ([], []) xs
of
(buf, res) -> addConcatText buf res
where
nc = NodeContent . ContentText
addConcatText [] = id
addConcatText xs' = let txt = Text.concat xs' in
if Text.all isSpace txt then id else (nc txt :)
xpElem :: Name
-> PU [Attribute] a
-> PU [Node] n
-> PU [Node] (a,n)
xpElem name attrP nodeP = tr <?+> PU
{ unpickleTree = doUnpickleTree
, pickleTree = \(a,n) -> [NodeElement $ Element name
(pickleTree attrP a)
(pickleTree nodeP n)
]
} where
doUnpickleTree nodes = case getFirst (nodeElementNameHelper name) nodes of
Just (NodeElement (Element _ attrs children), rem') -> do
as <- ("attrs","") <++.> child attrP attrs
cs <- ("children","") <++.> child nodeP (flattenContent children)
leftover $ remList rem'
return (as, cs)
_ -> NoResult $ Text.pack $ ppName name
tr = ("xpElem", Text.pack $ ppName name)
nodeElementNameHelper name' (NodeElement (Element n _ _)) = n == name'
nodeElementNameHelper _ _ = False
xpElems :: Name
-> PU [Attribute] a
-> PU [Node] n
-> PU [Node] [(a, n)]
xpElems name attrs children = tr <?> xpSubsetAll isThisElem
(xpElem name attrs children)
where
isThisElem (NodeElement (Element name' _ _)) = name' == name
isThisElem _ = False
tr = ("xpElems", Text.pack $ ppName name)
xpAll :: PU [a] b -> PU [a] [b]
xpAll xp = ("xpAll", "") <?+> PU { unpickleTree = doUnpickleTree
, pickleTree = concatMap (pickleTree xp)
} where
doUnpickleTree = mapM (child' xp . return)
xpSubsetAll :: (a -> Bool)
-> PU [a] b
-> PU [a] [b]
xpSubsetAll p xp = ("xpSubsetAll","") <?+> PU { unpickleTree = \t ->
let (targets, rest) = partition p t in
do
leftover $ remList rest
child' (xpAll xp) targets
, pickleTree = pickleTree $ xpAll xp
}
xpAllByNamespace :: Text -> PU [Node] b -> PU [Node] [b]
xpAllByNamespace namespace xp = ("xpAllByNamespace",namespace)
<?> xpSubsetAll helper xp
where
helper (NodeElement (Element (Name _local (Just ns) _pre) _ _ ))
= ns == namespace
helper _ = False
xpElemWithName :: PU [Attribute] a
-> PU [Node] n
-> PU [Node] (Name,a,n)
xpElemWithName attrP nodeP = ("xpElemWithName", "") <?+> PU
{ unpickleTree = doUnpickleTree
, pickleTree = \(name, a,n) -> [NodeElement $ Element name
(pickleTree attrP a)
(pickleTree nodeP n)
]
} where
doUnpickleTree nodes = case getFirst nodeElementHelper nodes of
Just (NodeElement (Element name attrs children), rem') -> do
x <- child attrP attrs
y <- child nodeP $ flattenContent children
leftover $ remList rem'
return (name, x, y)
_ -> NoResult "element"
nodeElementHelper (NodeElement Element{}) = True
nodeElementHelper _ = False
xpElemByNamespace :: Text
-> PU Text name
-> PU [Attribute] a
-> PU [Node] n
-> PU [Node] (name,a,n)
xpElemByNamespace ns nameP attrP nodeP = PU
{ unpickleTree = doUnpickleTree
, pickleTree = \(name, a,n) -> [NodeElement $ Element
(Name (pickleTree nameP name) (Just ns) Nothing)
(pickleTree attrP a)
(pickleTree nodeP n)
]
} where
doUnpickleTree nodes = case getFirst (nodeElementNSHelper ns) nodes of
Just (NodeElement (Element name attrs children), rem') -> tr name $
do
name' <- child nameP (nameLocalName name)
attrs' <- child attrP attrs
nodes' <- child nodeP children
leftover $ remList rem'
return (name', attrs', nodes')
_ -> NoResult $ "Element with namepspace " `Text.append` ns
tr a res = case res of
UnpickleError e -> UnpickleError (TraceStep
( "xpElemByNamespace"
, Text.concat [ ns
, " ; "
, nameLocalName a])
e)
x -> x
nodeElementNSHelper ns' (NodeElement (Element n _ _)) = nameNamespace n == Just ns'
nodeElementNSHelper _ns _ = False
xpElemVerbatim :: PU [Node] Element
xpElemVerbatim = PU
{ unpickleTree = doUnpickleTree
, pickleTree = \e -> [NodeElement e]
} where
doUnpickleTree nodes = case getFirst nodeElementHelper nodes of
Just (NodeElement e@Element{}, re) -> Result e (remList re)
_ -> NoResult "element"
nodeElementHelper (NodeElement Element{}) = True
nodeElementHelper _ = False
xpElemAttrs :: Name -> PU [Attribute] b -> PU [Node] b
xpElemAttrs name puAttrs = xpWrap fst (\a -> (a,())) $
xpElem name puAttrs xpUnit
xpElemNodes :: Name -> PU [Node] b -> PU [Node] b
xpElemNodes name puChildren = xpWrap snd (\a -> ((),a)) $
xpElem name xpUnit puChildren
xpElemText :: Name -> PU [Node] Text
xpElemText name = xpElemNodes name $ xpContent xpId
xpElemBlank :: Name -> PU [Node] ()
xpElemBlank name = ("xpElemBlank", "") <?> xpWrap (const () ) (const ((),())) $
xpElem name xpUnit xpUnit
xpElemExists :: Name -> PU [Node] Bool
xpElemExists name = ("xpElemBlank", "") <?>
xpWrap (\x -> case x of Nothing -> False; Just _ -> True)
(\x -> if x then Just () else Nothing) $
xpOption (xpElemBlank name)
xpContent :: PU Text a -> PU [Node] a
xpContent xp = ("xpContent","") <?+> PU
{ unpickleTree = doUnpickle
, pickleTree = return . NodeContent . ContentText . pickleTree xp
} where
doUnpickle nodes = case getFirst nodeContentHelper
(filter (\node -> case node of
NodeComment _ -> False
_ -> True) nodes) of
Just (NodeContent (ContentText t), _re) -> child xp t
Just (NodeContent (ContentEntity t), _) ->
UnpickleError . upe $ "Unresolved entity" ++ show t ++ "."
_ -> NoResult "node content"
nodeContentHelper (NodeContent _) = True
nodeContentHelper _ = False
xpUnliftElems :: PU [Node] a -> PU [Element] a
xpUnliftElems xp = ("xpUnliftElems","") <?+> PU
{ unpickleTree = doUnpickle
, pickleTree = nodesToElems . pickleTree xp
}
where
doUnpickle nodes = case unpickleTree xp (map NodeElement nodes) of
UnpickleError e -> UnpickleError e
NoResult e -> NoResult e
Result a r -> let r' = case r of
Nothing -> Nothing
Just rs' -> case nodesToElems rs' of
[] -> Nothing
rs -> Just rs
in Result a r'
nodesToElems = foldr (\n es -> case n of
NodeElement e -> e : es
_ -> es) []
xpDefault :: (Eq a) => a -> PU [t] a -> PU [t] a
xpDefault df
= xpWrap (fromMaybe df)
(\ x -> if x == df then Nothing else Just x)
.
xpOption
xpWithDefault :: a -> PU t a -> PU t a
xpWithDefault a pa = PU { pickleTree = pickleTree pa
, unpickleTree = \v -> case unpickleTree pa v of
Result r t -> Result r t
NoResult _ -> Result a (Just v)
UnpickleError e -> UnpickleError e
}
xpPair :: PU [a] b1 -> PU [a] b2 -> PU [a] (b1, b2)
xpPair l r = "xpPair" <??> xp2Tuple l r
(<#>) :: PU [a] b1 -> PU [a] b2 -> PU [a] (b1, b2)
(<#>) l r = "(<#>)" <??> xp2Tuple l r
xpTriple :: PU [a] a1 -> PU [a] a2 -> PU [a] a3 -> PU [a] (a1, a2, a3)
xpTriple l m r = "xpTriple" <??> xp3Tuple l m r
xpPeek :: PU t a -> PU t a
xpPeek xp = PU { pickleTree = pickleTree xp
, unpickleTree = \xs ->
case unpickleTree xp xs of
Result r _ -> Result r (Just xs)
x -> x
}
xpIsolate :: PU [t] a -> PU [t] a
xpIsolate xp = ("xpIsolate","") <?+>
PU { pickleTree = pickleTree xp
, unpickleTree = \xs' -> case xs' of
[] -> NoResult "entity"
(x:xs) -> case unpickleTree xp [x] of
Result r t -> Result r (remList $ mbToList t ++ xs)
NoResult e -> missingE $ Text.unpack e
y -> y
} where
mbToList Nothing = []
mbToList (Just r) = r
xpFindFirst :: (t -> Bool) -> PU [t] a -> PU [t] a
xpFindFirst p xp = ("xpFindFirst","") <?+>
PU { pickleTree = pickleTree xp
, unpickleTree = \xs -> case break p xs of
(_, []) -> NoResult "entity"
(ys,z:zs) -> do
leftover . remList $ ys ++ zs
child' xp [z]
}
xpConst :: a -> PU t () -> PU t a
xpConst c xp = ("xpConst" ,"") <?> xpWrap (const c) (const ()) xp
xpPrim :: (Show a, Read a) => PU Text a
xpPrim = PU { unpickleTree = \x -> case reads $ Text.unpack x of
[] -> UnpickleError $ ("xpPrim","") <++>
upe ("Couldn't read " ++ show x ++ ".")
(r,rest):_ -> Result r (Text.pack <$> remList rest)
, pickleTree = Text.pack . show
}
xpFindMatches :: PU [b] a -> PU [b] [a]
xpFindMatches xp = PU { unpickleTree = doUnpickleTree
, pickleTree = \xs -> pickleTree xp =<< xs
} where
doUnpickleTree xs =
let (ls, rs) = partitionEithers . for xs $ \x ->
case unpickleTree xp [x] of
NoResult _ -> Left x
Result r Nothing -> Right $ Result r Nothing
Result _r (Just _) -> Right $ leftoverE ""
UnpickleError e -> Right $ UnpickleError e
in leftover (remList ls) >> sequence rs
xpList0 :: PU [a] b -> PU [a] [b]
xpList0 = xpAll
xpListMinLen :: Int -> PU [a] b -> PU [a] [b]
xpListMinLen ml = xpWrapEither testLength id . xpList
where
testLength as
| length as < ml = Left $ "Expecting at least " ++ show ml ++ " elements"
testLength as = Right as
xpSeqWhile :: PU [a] b -> PU [a] [b]
xpSeqWhile pu = ("xpSeqWhile", "") <?+> PU {
unpickleTree = doUnpickle
, pickleTree = concatMap $ pickleTree pu
}
where
doUnpickle [] = Result [] Nothing
doUnpickle es@(elt:re) =
case unpickleTree pu [elt] of
Result val _ -> case doUnpickle re of
Result xs r -> Result (val:xs) r
e -> e
NoResult _ -> Result [] (Just es)
UnpickleError e -> UnpickleError e
xpList :: PU [a] b -> PU [a] [b]
xpList = xpSeqWhile
xpMap :: Ord k =>
Name
-> Name
-> PU Text k
-> PU [Node] a
-> PU [Node] (M.Map k a)
xpMap en an xpk xpv
= xpWrap M.fromList
M.toList
$
xpAll $
xpElem en
(xpAttr an xpk)
xpv
xpWrapEither :: Show e => (a -> Either e b) -> (b -> a) -> PU t a -> PU t b
xpWrapEither a2b b2a pua = ("xpWrapEither","") <?+>
PU {
unpickleTree = \t -> case unpickleTree pua t of
Result val rest -> case a2b val of
Left e -> UnpickleError . upe $ "Function returned Left "
++ show e
Right r -> Result r rest
NoResult e -> NoResult e
UnpickleError e -> UnpickleError e
,
pickleTree = pickleTree pua . b2a
}
xpAlt :: (a -> Int)
-> [PU t a]
-> PU t a
xpAlt selector picklers = PU {
unpickleTree = doUnpickle,
pickleTree = \value -> pickleTree (picklers !! selector value) value
}
where
eitherResult (Result r t) = Right (Result r t)
eitherResult (UnpickleError e) = Left e
eitherResult (NoResult e) = Left . missing $ Text.unpack e
splitResults v = partitionEithers $ map (eitherResult . flip unpickleTree v)
picklers
doUnpickle v = case splitResults v of
(_, Result r t:_) -> Result r t
(es, []) -> ("xpAlt", "") <++.> UnpickleError (Variants es)
_ -> error "xpAlt: splitResults returned impossible result"
xpChoice :: (a -> Int)
-> [PU t a]
-> PU t a
xpChoice selector picklers =
PU { unpickleTree = go picklers (1 :: Integer)
, pickleTree = \value -> pickleTree (picklers !! selector value) value
}
where
go [] _ _ = NoResult "entity"
go (p:ps) i v = case unpickleTree p v of
r@Result{} -> r
UnpickleError e -> UnpickleError $ ("xpChoice", Text.pack $ show i)
<++> e
NoResult _ -> go ps (i+1) v
xpEither :: PU n t1 -> PU n t2 -> PU n (Either t1 t2)
xpEither xpl xpr = PU {
unpickleTree = doUnpickle,
pickleTree = \v -> case v of
Left l -> pickleTree xpl l
Right r -> pickleTree xpr r
}
where
doUnpickle t = case unpickleTree xpl t of
Result r s -> Result (Left r) s
NoResult e1 -> case unpickleTree xpr t of
Result r s -> Result (Right r) s
NoResult e2 -> UnpickleError $ ("xpEither","")
<++> Variants [ missing $ Text.unpack e1
, missing $ Text.unpack e2
]
UnpickleError e -> UnpickleError $ ("xpEither","Right")
<++> e
UnpickleError e -> UnpickleError $ ("xpEither","Left")
<++> e
xpTryCatch :: PU t a -> PU t a -> PU t a
xpTryCatch pu1 pu2 = PU
{ unpickleTree = \t -> case unpickleTree pu1 t of
Result val1 rest -> Result val1 rest
NoResult e1 -> case unpickleTree pu2 t of
Result val2 rest -> Result val2 rest
NoResult e2 -> NoResult $ Text.concat [e1, " / ", e2]
UnpickleError e2 -> UnpickleError $ ("xpTryCatch","Right")
<++> e2
UnpickleError e1 -> case unpickleTree pu2 t of
Result val2 rest -> Result val2 rest
NoResult e2 -> UnpickleError
$ Variants [ e1
, upe $ " / not found:"
++ Text.unpack e2
]
UnpickleError e2 -> UnpickleError $ ("xpTryCatch","")
<++> Variants [e1, e2]
, pickleTree = pickleTree pu1
}
xpZero :: PU [t] a
xpZero = ("xpZero","") <?> xpThrow "got xpZero"
xpThrow :: Monoid m
=> String
-> PU m a
xpThrow msg = PU
{ unpickleTree = \_ -> UnpickleError $ ("xpThrow",Text.pack msg) <++> upe msg
, pickleTree = const mempty
}
xpAddFixedAttr :: Name -> Text -> PU [Attribute] b -> PU [Attribute] b
xpAddFixedAttr name val pa
= xpWrap snd ((,) ()) $
xp2Tuple (xpAttrFixed name val) pa
xpFst :: Monoid b => PU t (a, b) -> PU t a
xpFst = xpWrap fst (\x -> (x, mempty))
xpSnd :: Monoid a => PU t (a, b) -> PU t b
xpSnd = xpWrap snd (\y -> (mempty, y))
xpMayFail :: PU t a -> PU t a
xpMayFail xp = PU { pickleTree = pickleTree xp
, unpickleTree = \v -> case unpickleTree xp v of
UnpickleError _ -> NoResult "failed with xpMayFail"
x -> x
}
xpClean :: PU t a -> PU t a
xpClean xp = PU { unpickleTree = \x -> case unpickleTree xp x of
Result r _ -> Result r Nothing
e -> e
, pickleTree = pickleTree xp
}