xml-picklers 0.3.0 → 0.3.1
raw patch · 2 files changed
+57/−23 lines, 2 files
Files
- src/Data/XML/Pickle.hs +56/−22
- xml-picklers.cabal +1/−1
src/Data/XML/Pickle.hs view
@@ -16,7 +16,8 @@ -- -- * There are no lazy unpicklers ----- * Unpicklers keep track of whether they (and any nested picklers) consumed all input, giving rise to the 'xpClean' and 'xpRecursiveClean' combinators+-- * Most unpicklers will produce an error when their child unpicklers fail to consume all elements.+-- Use 'xpClean' to discard those elements -- -- The data type @'PU' t a@ represents both a pickler (converting Haskell data -- to XML) and an unpickler (XML to Haskell data), so your code only needs to be@@ -24,10 +25,6 @@ -- as 'xpElem' for XML elements, may be composed into complex arrangements using -- 'xpPair' and other combinators. ----- The reason why you a list of nodes instead of just one when working with a single--- element is because the unpickler of 'xpElem' needs to see the whole list of nodes--- so that it can 1. skip whitespace, and 2. search to match the specified tag name.--- -- Most picklers will try to find the /first match/ rather than failing when -- the first element doesn't match. This is why the target type often ist -- a list. To prevent this behaviour and commit the pickler to the first@@ -41,9 +38,12 @@ -- /NB/: Unresolved entities are considered an error and will trigger an exception -- -- When unpickling, the folowing invariant regarding the list of remaining elements should be observed:+-- -- * The returned list should be a subset of or the initial list itself, that is, no elements should be added -- or changed+-- -- * The relative order of elements should be preserved+-- -- * Elements may, however, be removed from anywhere in the list -- -- Here is a simple example to get you started:@@ -154,6 +154,7 @@ -- The List pickler combinators will pickle lists in the given order -- without any special treatment and unpickle as stated. , xpFindMatches+ , xpFindFirst , xpAll , xpSubsetAll , xpAllByNamespace@@ -244,8 +245,15 @@ instance Exception UnpickleError data UnpickleResult t a = UnpickleError UnpickleError- | NoResult Text -- | Not found, description of element- | Result a (Maybe t) -- result and remainder+ | NoResult Text -- ^ Not found, description of element+ | Result a (Maybe t) -- ^ Result and remainder. The+ -- remainder is wrapped in Maybe to+ -- avoid a Monoid constraint on t.+ --+ -- /Invariant/: When t is a+ -- Monoid, the empty remainder should+ -- always be @Nothing@ instead of+ -- @Just mempty@ deriving (Functor, Show) instance Monad (UnpickleResult t) where@@ -288,9 +296,6 @@ data PU t a = PU { unpickleTree :: t -> UnpickleResult t a- -- ^ Either an error or the return value,- -- any remaining input and a Bool value indicating whether- -- all nested picklers where clean , pickleTree :: a -> t } @@ -346,7 +351,7 @@ pickle :: PU t a -> a -> t pickle = pickleTree --- | unpickle a tree, throws away information concerning cleannes+-- | unpickle a tree unpickle :: PU t a -> t -> Either UnpickleError a unpickle xp x = case unpickleTree xp x of UnpickleError e -> Left e@@ -473,8 +478,9 @@ xpText :: PU Text Text xpText = ("xpText","") <?> xpAssert "Input is empty" (not . Text.null) xpText0 --- | Adapts a list of nodes to a single node. Generally used at the top level of--- an XML document.+-- | Transforms a pickler on Lists to a pickler on single elements.+--+-- /N.B./ Will error when the given pickler doesn't produce exactly one element xpRoot ::PU [a] b -> PU a b xpRoot pa = ("xpRoot","") <?+> PU { unpickleTree = \t -> case unpickleTree pa [t] of@@ -616,7 +622,7 @@ } --- | Apply unpickler to all elements with the given ns.+-- | Apply unpickler to all elements with the given namespace. -- -- Pickles like 'xpAll'. xpAllByNamespace :: Text -> PU [Node] b -> PU [Node] [b]@@ -657,7 +663,7 @@ -> PU [Attribute] a -- ^ pickler for attributes -> PU [Node] n -- ^ pickler for child nodes -> PU [Node] (name,a,n)-xpElemByNamespace ns nameP attrP nodeP = tr ns <?+> PU+xpElemByNamespace ns nameP attrP nodeP = PU { unpickleTree = doUnpickleTree , pickleTree = \(name, a,n) -> [NodeElement $ Element (Name (pickleTree nameP name) (Just ns) Nothing)@@ -666,16 +672,23 @@ ] } where doUnpickleTree nodes = case getFirst (nodeElementNSHelper ns) nodes of- Just ((NodeElement (Element name attrs children)), rem) ->+ Just ((NodeElement (Element name attrs children)), rem) -> tr name $ do name' <- child nameP (nameLocalName name) attrs' <- child attrP attrs- nodes' <- child nodeP nodes+ nodes' <- child nodeP children leftover $ remList rem return (name', attrs', nodes') _ -> NoResult $ "Element with namepspace " `Text.append` ns- tr a = ("xpElemByNamespace", Text.concat [ns, " ; ", a])+ 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@@ -683,7 +696,7 @@ -- | Pickler Returns the first found Element untouched -- -- Unpickler wraps element in 'NodeElement'-xpElemVerbatim :: PU [Node] (Element)+xpElemVerbatim :: PU [Node] Element xpElemVerbatim = PU { unpickleTree = doUnpickleTree , pickleTree = \e -> [NodeElement e]@@ -711,7 +724,7 @@ -- | Helper for Elements that don't contain anything xpElemBlank :: Name -> PU [Node] ()-xpElemBlank name = xpWrap (const () ) (const ((),())) $+xpElemBlank name = ("xpElemBlank", "") <?> xpWrap (const () ) (const ((),())) $ xpElem name xpUnit xpUnit -- | When pickling, creates an empty element iff parameter is True@@ -719,7 +732,8 @@ -- When unpickling, checks whether element exists. Generates an error when the -- element is not empty xpElemExists :: Name -> PU [Node] Bool-xpElemExists name = xpWrap (\x -> case x of Nothing -> False; Just _ -> True)+xpElemExists name = ("xpElemBlank", "") <?>+ xpWrap (\x -> case x of Nothing -> False; Just _ -> True) (\x -> if x then Just () else Nothing) $ xpOption (xpElemBlank name) @@ -928,6 +942,25 @@ mbToList Nothing = [] mbToList (Just r) = r +-- | Select a single element from the list and apply unpickler to it.+--+-- Returns no value when no element matches the predicate+--+-- Fails when the unpickler doesn't return a value+--+-- When pickling, this is a noop+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"+ (xs,y:ys) -> do+ leftover . remList $ xs ++ ys+ child' xp [y]+ }+++ xpConst :: a -> PU t () -> PU t a xpConst c xp = ("xpConst" ,"") <?> xpWrap (const c) (const ()) xp @@ -1129,6 +1162,7 @@ xpSnd :: Monoid a => PU t (a, b) -> PU t b xpSnd = xpWrap snd (\y -> (mempty, y)) +-- | Instead of failing the pickler will return no result xpMayFail :: PU t a -> PU t a xpMayFail xp = PU { pickleTree = pickleTree xp , unpickleTree = \v -> case unpickleTree xp v of@@ -1136,7 +1170,7 @@ x -> x } --- | Discard any leftover elements+-- | Run unpickler and consume and discard remaining elements -- -- When pickling, this is a noop xpClean :: PU t a -> PU t a
xml-picklers.cabal view
@@ -1,6 +1,6 @@ Cabal-Version: >= 1.2 Name: xml-picklers-Version: 0.3.0+Version: 0.3.1 Synopsis: XML picklers based on xml-types, ported from hexpat-pickle Description: A library of combinators that allows Haskell data structures to be pickled