X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FXml.hs;h=d4ea4679cef1bafc974e7d9eede7249b39957491;hb=928a90109375caaa888ae4413151b560838948b7;hp=5c846648a85d8a2f7b267db22b6b9b200dc67d78;hpb=d5b58915c065b1e8e523c2c7c2aa79732b328028;p=dead%2Fhtsn-import.git diff --git a/src/Xml.hs b/src/Xml.hs index 5c84664..d4ea467 100644 --- a/src/Xml.hs +++ b/src/Xml.hs @@ -4,15 +4,17 @@ -- | General XML stuff. -- module Xml ( + Child(..), DtdName(..), FromXml(..), FromXmlFk(..), - FromXmlFkTeams(..), ToDb(..), parse_opts, + parse_opts_novalidate, pickle_unpickle, unpickleable, unsafe_read_document, + unsafe_read_invalid_document, unsafe_unpickle ) where @@ -38,9 +40,6 @@ import Text.XML.HXT.Core ( yes ) --- Local imports. -import TSN.Team ( Team(..) ) - -- | Common associated type shared by 'FromXml' and 'FromXmlFk'. This -- basically just forces the client to define the \"database @@ -66,37 +65,29 @@ class (ToDb a) => FromXml a where from_xml :: a -> Db a --- | Some database types cannot be constructed from the XML type --- alone; they must be supplied a foreign key to a parent object --- first. Members of this class can be converted from an XML --- representation to a database representation in this manner. +-- | A class for XML representations which are children of other +-- elements. The foal is to associate a child XML element with its +-- parent element's database type. This is required to construct the +-- database analogue of @a@ in 'FromXmlFk'. -- -class (ToDb a) => FromXmlFk a where +class Child a where -- | The type of our parent object, i.e. to the type to whom our -- foreign key will point. type Parent a :: * + +-- | Some database types cannot be constructed from the XML type +-- alone; they must be supplied a foreign key to a parent object +-- first. Members of this class can be converted from an XML +-- representation to a database representation in this manner. +-- +class (Child a, ToDb a) => FromXmlFk a where -- | The function that produces a @Db a@ out of a foreign key and an -- @a@. The parameter order makes it easier to map this function -- over a bunch of things. from_xml_fk :: DefaultKey (Parent a) -> a -> Db a --- | A further refinement of 'FromXmlFk'. These types need not only a --- foreign key to a parent in order to make the XML -> DB --- conversion, but also two foreign keys to away/home teams (as --- represented in "TSN.Team"). --- -class (ToDb a) => FromXmlFkTeams a where - -- | The function that produces a @Db a@ out of a parent foreign - -- key, two team foreign keys, and an @a@. The parameter order makes - -- it easier to map this function over a bunch of things. - from_xml_fk_teams :: DefaultKey (Parent a) - -> DefaultKey Team -- ^ The away team FK - -> DefaultKey Team -- ^ The home team FK - -> a - -> Db a - -- | Represents the DTD filename (\"SYSTEM\") part of the DOCTYPE -- definition. @@ -108,8 +99,14 @@ newtype DtdName = DtdName String -- parse_opts :: SysConfigList parse_opts = [ withRemoveWS yes, - withSubstDTDEntities no, - withValidate no ] + withSubstDTDEntities no ] + +-- | Like 'parse_opts' except we don't validate the document against +-- its DTD. This is useful when we need to parse a document that we +-- /know/ is invalid so that we can deliver a better error message. +-- +parse_opts_novalidate :: SysConfigList +parse_opts_novalidate = (withValidate no) : parse_opts -- | Given an @unpickler@ and a @filepath@, attempt to unpickle the @@ -185,3 +182,10 @@ unsafe_unpickle filepath unpickler = unsafe_read_document :: FilePath -> IO XmlTree unsafe_read_document filepath = fmap head $ runX $ readDocument parse_opts filepath + +-- | The same as 'unsafe_read_document', except it allows you to read +-- documents which don't validate against their DTDs. +-- +unsafe_read_invalid_document :: FilePath -> IO XmlTree +unsafe_read_invalid_document filepath = + fmap head $ runX $ readDocument parse_opts_novalidate filepath