X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FXml.hs;h=866ac4647fc258326cf8369ad5783f0a1ee375a6;hb=2069d0a786bf2c418f27574f5384eae39527d03f;hp=95eddc0e51f949acbb287003dfb98c22ff244cb4;hpb=ce9fabd584f2e8844b8b1ede9b29bb573e2033f7;p=dead%2Fhtsn-import.git diff --git a/src/Xml.hs b/src/Xml.hs index 95eddc0..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, @@ -26,40 +27,43 @@ import Text.XML.HXT.Core ( yes ) --- | A typeclass for XML types that can be converted into an associated --- database type. The story behind this is long, but basically, we need --- to different types for each XML thingie we're going to import: a --- database type and an XML type. Both Groundhog and HXT are very --- particular about the types that they can use, and there's no way --- to reuse e.g. a type that HXT can pickle in Groundhog. So this --- typeclass gives us a way to get the database type from the XML --- type that we have to define for HXT. +-- | A typeclass for XML types that can be converted into an +-- associated database type. The story behind this is long, but +-- basically, we need to different types most XML thingies we're +-- going to import: a database type and an XML type. +-- +-- Both Groundhog and HXT are very particular about the types that +-- they can use, and there's no way to reuse e.g. a type that HXT +-- can pickle in Groundhog. This typeclass gives us a standard way +-- to get the database type from the XML type that we have to define +-- for HXT. -- class FromXml a where - -- | Each instance a must declare its associated database type (Db a) + -- | Each instance @a@ must declare its associated database type @Db a@. type Db a :: * - -- | And provide a function for getting a (Db a) out of an "a". + -- | And provide a function for getting a @Db a@ out of an @a@. from_xml :: a -> Db a --- | Represents the DTD filename ("SYSTEM") part of the DOCTYPE +-- | Represents the DTD filename (\"SYSTEM\") part of the DOCTYPE -- definition. newtype DtdName = DtdName String -- | A list of options passed to 'readDocument' when we parse an XML -- document. All cosmetic whitespace should be removed, otherwise we --- have to parse it in each pickler. +-- would have to parse whitespace in each (un)pickler. -- 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 @@ -71,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 @@ -101,7 +104,10 @@ pickle_unpickle root_element filepath = do -- would result. By taking the unpickler as an argument, we allow -- the caller to indirectly specify a concrete type. -- -unpickleable :: XmlPickler a => FilePath -> PU a -> IO Bool +-- Apologies the the name; unpickleable means \"we can unpickle +-- it\", not \"not pickleable.\" +-- +unpickleable :: FilePath -> PU a -> IO Bool unpickleable filepath unpickler = do xmldoc <- try_unpickle `catch` (\(SomeException _) -> return []) return $ (not . null) xmldoc