unpickleable )
where
+-- System imports.
import Control.Exception ( SomeException(..), catch )
import Text.XML.HXT.Core (
(>>>),
PU,
SysConfigList,
XmlPickler(..),
- hasName,
+ isElem,
readDocument,
runX,
withRemoveWS,
parse_opts = [ withRemoveWS yes ]
--- | Given a root element name and a file path, return both the
--- original unpickled root \"object\" and the one that was
--- constructed by pickled and unpickling the original. This is used
--- in a number of XML tests which pickle/unpickle and then make sure
--- that the output is the same as the input.
+-- | Given an @unpickler@ and a @filepath@, attempt to unpickle the
+-- root element of @filepath@ using @unpickler@ and return both the
+-- original unpickled object and one constructed by pickling and
+-- unpickling that original. This is used in a number of XML tests
+-- which pickle/unpickle and then make sure that the output is the
+-- same as the input.
--
-- We return the object instead of an XmlTree (which would save us
-- an unpickle call) because otherwise the type of @a@ in the call
-- before/after results from this function agree does not mean that
-- the document was successfully unpickled!
--
-pickle_unpickle :: XmlPickler a
- => String
- -> FilePath
+pickle_unpickle :: PU a -- ^ @unpickler@ returning an @a@
+ -> FilePath -- ^ Path to the document to unpickle.
-> IO ([a], [a])
-pickle_unpickle root_element filepath = do
+pickle_unpickle unpickler filepath = do
-- We need to check only the root message element since
-- readDocument produces a bunch of other junk.
expected <- runX arr_getobj
actual <- runX $ arr_getobj
>>>
- xpickleVal xpickle
+ xpickleVal unpickler
>>>
- xunpickleVal xpickle
+ xunpickleVal unpickler
return (expected, actual)
where
arr_getobj = readDocument parse_opts filepath
/>
- hasName root_element
+ isElem -- Drop the extra junk readDocument pulls in.
>>>
- xunpickleVal xpickle
+ xunpickleVal unpickler
-- Apologies the the name; unpickleable means \"we can unpickle
-- it\", not \"not pickleable.\"
--
-unpickleable :: XmlPickler a => FilePath -> PU a -> IO Bool
+unpickleable :: FilePath -> PU a -> IO Bool
unpickleable filepath unpickler = do
xmldoc <- try_unpickle `catch` (\(SomeException _) -> return [])
return $ (not . null) xmldoc