X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FXml.hs;h=e8b7c4de311e0e90203dbda322e4bae2d2767676;hb=88b80555c3df3649799c8caa4de8d9c87c50be45;hp=c4d4049e2f5ec4fc62d93d80ab31d83e8d07c764;hpb=40ab1bcc0f1517ac9910928dd658c09195f50f12;p=dead%2Fhtsn-import.git diff --git a/src/Xml.hs b/src/Xml.hs index c4d4049..e8b7c4d 100644 --- a/src/Xml.hs +++ b/src/Xml.hs @@ -4,14 +4,13 @@ -- module Xml ( DtdName(..), - ToFromXml(..), + FromXml(..), parse_opts, pickle_unpickle, unpickleable ) where import Control.Exception ( SomeException(..), catch ) -import Database.Groundhog ( AutoKey ) import Text.XML.HXT.Core ( (>>>), (/>), @@ -27,56 +26,42 @@ import Text.XML.HXT.Core ( yes ) --- | A typeclass for types which can be converted into an associated --- XML 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 XML type from the Groundhog --- type. +-- | 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. -- --- At first there appears to be an equally-valid approach, getting the --- Groundhog type from the XML one. But Groundhog won't use type family --- instances, so here we are. +-- 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 ToFromXml a where - -- | Each instance a must declare its associated XML type (Xml a) - type Xml a :: * - type Container a :: * +class FromXml a where + -- | Each instance @a@ must declare its associated database type @Db a@. + type Db a :: * - -- | And provide a function for getting an (Xml a) out of an "a." - to_xml :: a -> Xml a + -- | And provide a function for getting a @Db a@ out of an @a@. + from_xml :: a -> Db a - -- | And provide a function for getting an "a" out of an (Xml a). - from_xml :: Xml a -> a - -- | Often we need to provide a key to use as a foreign key into - -- some container. If the instance "belongs" to some other object, - -- then it might need to be passed a key before it can un-XML - -- itself. For example, the XML version of 'NewsTeam' doesn't - -- contain a message ID which is part of its database type. - from_xml_fk :: AutoKey (Container a) -> Xml a -> a - from_xml_fk _ = from_xml - - --- | 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. +-- 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. -- -- We return the object instead of an XmlTree (which would save us -- an unpickle call) because otherwise the type of @a@ in the call @@ -118,6 +103,9 @@ 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. -- +-- Apologies the the name; unpickleable means \"we can unpickle +-- it\", not \"not pickleable.\" +-- unpickleable :: XmlPickler a => FilePath -> PU a -> IO Bool unpickleable filepath unpickler = do xmldoc <- try_unpickle `catch` (\(SomeException _) -> return [])