X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FXML%2FNews.hs;h=913477168540ea47e178adca60e0d1b21bd2165e;hb=d8550887f728a0169fc0b999e13d0ecf8e006021;hp=20316343f8afccfe360280e6871fa003bcfea46d;hpb=c5d61081ad0d95950ca06761978d240632c44510;p=dead%2Fhtsn-import.git

diff --git a/src/TSN/XML/News.hs b/src/TSN/XML/News.hs
index 2031634..9134771 100644
--- a/src/TSN/XML/News.hs
+++ b/src/TSN/XML/News.hs
@@ -3,7 +3,6 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
 
@@ -11,6 +10,7 @@
 --   a root element \<message\> that contains an entire news item.
 --
 module TSN.XML.News (
+  dtd,
   pickle_message,
   -- * Tests
   news_tests,
@@ -29,9 +29,15 @@ import Data.List.Utils ( join, split )
 import Data.Tuple.Curry ( uncurryN )
 import Data.Typeable ( Typeable )
 import Database.Groundhog (
+  countAll,
+  deleteAll,
   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,18 @@ 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 )
+
+
+-- | The DTD to which this module corresponds. Used to invoke dbimport.
+--
+dtd :: String
+dtd = "newsxml.dtd"
 
 
 --
@@ -68,9 +85,9 @@ import Xml ( FromXml(..), ToDb(..), pickle_unpickle, unpickleable )
 
 -- * News/Message
 
--- | The msg_id child of <message> contains an event_id attribute; we
---   embed it into the 'News' type. We (pointlessly) use the "db_"
---   prefix here so that the two names don't collide on "id" when
+-- | The msg_id child of \<message\> contains an event_id attribute; we
+--   embed it into the 'News' type. We (pointlessly) use the \"db_\"
+--   prefix here so that the two names don't collide on \"id\" when
 --   Groundhog is creating its fields using our field namer.
 --
 data MsgId =
@@ -261,7 +278,6 @@ mkPersist defaultCodegenConfig [groundhog|
 -- use our own codegen to peel those off before naming the columns.
 mkPersist tsn_codegen_config [groundhog|
 - entity: News
-  dbName: news
   constructors:
     - name: News
       uniques:
@@ -420,6 +436,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 +502,38 @@ 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"
+          4 -- 2 news_teams and 2 news_locations that should remain.
+  ]
+  where
+    check desc path expected = 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
+                  deleteAll a
+                  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
+      actual @?= expected