Re-enable DTD validation.

This enables DTD validation in the default parse_opts. To work around
some broken document types, we've added another parse_opts_novalidate
and used that where applicable.

The test suite is still failing so this is a work-in-progress.

diff --git a/src/TSN/XML/News.hs b/src/TSN/XML/News.hs
index 645d1daf1e786e1779e231c672094ce9da2c4754..77dc74a7f880e4d84e7602a91a4a05d2716f8d06 100644 (file)
--- a/src/TSN/XML/News.hs
+++ b/src/TSN/XML/News.hs
@@ -80,7 +80,7 @@ import Xml (
   ToDb(..),
   pickle_unpickle,
   unpickleable,
-  unsafe_read_document,
+  unsafe_read_invalid_document,
   unsafe_unpickle )
 
 
@@ -574,6 +574,6 @@ test_sms_detected_correctly =
             False ]
   where
     check path desc expected = testCase desc $ do
-      xmltree <- unsafe_read_document path
+      xmltree <- unsafe_read_invalid_document path
       let actual = has_only_single_sms xmltree
       actual @?= expected

diff --git a/src/TSN/XML/Weather.hs b/src/TSN/XML/Weather.hs
index 2f3a3ca2b2d32a8759083b13ffa675338393978d..2bcb7360155947f5b5dbb94e7a5683809ae6c554 100644 (file)
--- a/src/TSN/XML/Weather.hs
+++ b/src/TSN/XML/Weather.hs
@@ -80,7 +80,7 @@ import Xml (
   ToDb(..),
   pickle_unpickle,
   unpickleable,
-  unsafe_read_document,
+  unsafe_read_invalid_document,
   unsafe_unpickle )
 
 
@@ -743,7 +743,7 @@ test_types_detected_correctly =
             False ]
   where
     check path desc expected = testCase desc $ do
-      xmltree <- unsafe_read_document path
+      xmltree <- unsafe_read_invalid_document path
       let actual = is_type1 xmltree
       actual @?= expected
 
@@ -764,6 +764,6 @@ test_normal_teams_detected_correctly =
           False ]
   where
     check desc path expected = testCase desc $ do
-      xmltree <- unsafe_read_document path
+      xmltree <- unsafe_read_invalid_document path
       let actual = teams_are_normal xmltree
       actual @?= expected

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