Re-enable DTD validation.

[dead/htsn-import.git] / src / Xml.hs

diff --git a/src/Xml.hs b/src/Xml.hs
index ec409ac1b8f2eda9abda3312b020a347584c6cd0..d4ea4679cef1bafc974e7d9eede7249b39957491 100644 (file)
--- a/src/Xml.hs
+++ b/src/Xml.hs
@@ -10,9 +10,11 @@ module Xml (
   FromXmlFk(..),
   ToDb(..),
   parse_opts,
+  parse_opts_novalidate,
   pickle_unpickle,
   unpickleable,
   unsafe_read_document,
+  unsafe_read_invalid_document,
   unsafe_unpickle )
 where
 
@@ -97,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
@@ -174,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