X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FXml.hs;h=95eddc0e51f949acbb287003dfb98c22ff244cb4;hb=5124833f973f6c47a4eda3f4e343d3d8631897c6;hp=e98e4b1c5fc8a5c3251fbafa57182bf0f0eb4cc6;hpb=6883632cfac0e3ee7ad6781300555dbf40d98b40;p=dead%2Fhtsn-import.git diff --git a/src/Xml.hs b/src/Xml.hs index e98e4b1..95eddc0 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 ( (>>>), (/>), @@ -19,49 +18,29 @@ import Text.XML.HXT.Core ( SysConfigList, XmlPickler(..), hasName, - no, readDocument, runX, - withPreserveComment, withRemoveWS, - withSubstDTDEntities, - withValidate, xpickleVal, xunpickleVal, yes ) --- | A typeclass for types which can be converted into an associated --- XML type. The story behind this is long, but basically, we need +-- | 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 XML type from the Groundhog --- type. +-- typeclass gives us a way to get the database type from the XML +-- type that we have to define for HXT. -- --- 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. --- -class ToFromXml a where - -- | Each instance a must declare its associated XML type (Xml a) - type Xml a :: * - type Container 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 an "a" out of an (Xml a). - from_xml :: Xml a -> a +class FromXml a where + -- | Each instance a must declare its associated database type (Db a) + type Db 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 + -- | 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 @@ -69,18 +48,11 @@ class ToFromXml a where newtype DtdName = DtdName String -- | A list of options passed to 'readDocument' when we parse an XML --- document. We don't validate because the DTDs from TSN are --- wrong. As a result, we don't want to keep useless DTDs --- areound. Thus we disable 'withSubstDTDEntities' which, when --- combined with "withValidate no", prevents HXT from trying to read --- the DTD at all. +-- document. All cosmetic whitespace should be removed, otherwise we +-- have to parse it in each pickler. -- parse_opts :: SysConfigList -parse_opts = - [ withPreserveComment no, - withRemoveWS yes, - withSubstDTDEntities no, - withValidate no ] +parse_opts = [ withRemoveWS yes ] -- | Given a root element name and a file path, return both the