Update TODO and add a cascading delete test for newsxml.

diff --git a/doc/TODO b/doc/TODO
index 7876771fd47fa1ac7a7953eda7cd155977c279f4..42f3b2c61cb7ffd4dc2cb870129a8e95c6b1db0d 100644 (file)
--- a/doc/TODO
+++ b/doc/TODO
@@ -4,5 +4,6 @@
 2. Write a test for test/xml/Odds_XML-long-import.xml once it no
    longer takes 10 minutes to import (Postgres only?).
 
-3. Write a test for the ON DELETE CASCADE behavior (newsxml, Odds_XML,
-   weatherxml).
+3. Write a test for the ON DELETE CASCADE behavior (Odds_XML, weatherxml).
+
+4. Add support the the second type of weatherxml (see man page).

diff --git a/src/TSN/XML/News.hs b/src/TSN/XML/News.hs
index 20316343f8afccfe360280e6871fa003bcfea46d..2cc9698fb2d2e212fd9d45da74f71d938eca3c90 100644 (file)
--- a/src/TSN/XML/News.hs
+++ b/src/TSN/XML/News.hs
@@ -29,9 +29,15 @@ import Data.List.Utils ( join, split )
 import Data.Tuple.Curry ( uncurryN )
 import Data.Typeable ( Typeable )
 import Database.Groundhog (
+  countAll,
+  executeRaw,
   insert_,
-  migrate )
+  migrate,
+  runMigration,
+  silentMigrationLogger )
 import Database.Groundhog.Core ( DefaultKey )
+import Database.Groundhog.Generic ( runDbConn )
+import Database.Groundhog.Sqlite ( withSqliteConn )
 import Database.Groundhog.TH (
   defaultCodegenConfig,
   groundhog,
@@ -59,7 +65,12 @@ import TSN.Database ( insert_or_select )
 import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
 import TSN.Picklers ( xp_time_stamp )
 import TSN.XmlImport ( XmlImport(..) )
-import Xml ( FromXml(..), ToDb(..), pickle_unpickle, unpickleable )
+import Xml (
+  FromXml(..),
+  ToDb(..),
+  pickle_unpickle,
+  unpickleable,
+  unsafe_unpickle )
 
 
 --
@@ -420,6 +431,7 @@ news_tests =
   testGroup
     "News tests"
     [ test_news_fields_have_correct_names,
+      test_on_delete_cascade,
       test_pickle_of_unpickle_is_identity,
       test_unpickle_succeeds ]
 
@@ -485,3 +497,39 @@ test_unpickle_succeeds = testGroup "unpickle tests"
       actual <- unpickleable path pickle_message
       let expected = True
       actual @?= expected
+
+
+-- | Make sure everything gets deleted when we delete the top-level
+--   record.
+--
+test_on_delete_cascade :: TestTree
+test_on_delete_cascade = testGroup "cascading delete tests"
+  [ check "deleting news deletes its children"
+          "test/xml/newsxml.xml" ]
+  where
+    check desc path = testCase desc $ do
+      news <- unsafe_unpickle path pickle_message
+      let a = undefined :: News
+      let b = undefined :: NewsTeam
+      let c = undefined :: News_NewsTeam
+      let d = undefined :: NewsLocation
+      let e = undefined :: News_NewsLocation
+      actual <- withSqliteConn ":memory:" $ runDbConn $ do
+                  runMigration silentMigrationLogger $ do
+                    migrate a
+                    migrate b
+                    migrate c
+                    migrate d
+                    migrate e
+                  _ <- dbimport news
+                  -- No idea how 'delete' works, so do this instead.
+                  executeRaw False "DELETE FROM news;" []
+                  count_a <- countAll a
+                  count_b <- countAll b
+                  count_c <- countAll c
+                  count_d <- countAll d
+                  count_e <- countAll e
+                  return $ count_a + count_b + count_c + count_d + count_e
+      -- There are 2 news_teams and 2 news_locations that should remain.
+      let expected = 4
+      actual @?= expected