X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FXml.hs;h=866ac4647fc258326cf8369ad5783f0a1ee375a6;hb=4cdcdbe593c30f6434a25896951a1a4dfcc2b1ca;hp=e8b7c4de311e0e90203dbda322e4bae2d2767676;hpb=88b80555c3df3649799c8caa4de8d9c87c50be45;p=dead%2Fhtsn-import.git diff --git a/src/Xml.hs b/src/Xml.hs index e8b7c4d..866ac46 100644 --- a/src/Xml.hs +++ b/src/Xml.hs @@ -10,6 +10,7 @@ module Xml ( unpickleable ) where +-- System imports. import Control.Exception ( SomeException(..), catch ) import Text.XML.HXT.Core ( (>>>), @@ -17,7 +18,7 @@ import Text.XML.HXT.Core ( PU, SysConfigList, XmlPickler(..), - hasName, + isElem, readDocument, runX, withRemoveWS, @@ -57,11 +58,12 @@ parse_opts :: SysConfigList 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 @@ -73,27 +75,26 @@ parse_opts = [ withRemoveWS yes ] -- 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 @@ -106,7 +107,7 @@ pickle_unpickle root_element filepath = do -- 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