Add the FromXmlFk class, like FromXml except it requires an FK (old idea).

[dead/htsn-import.git] / src / TSN / XML / News.hs

diff --git a/src/TSN/XML/News.hs b/src/TSN/XML/News.hs
index 6e10aed9d166089d7119b543066340a28596f717..130323cc94544b23081e887b6c551273e71c973d 100644 (file)
--- a/src/TSN/XML/News.hs
+++ b/src/TSN/XML/News.hs
@@ -24,6 +24,7 @@ where
 
 -- System imports.
 import Data.Data ( Data, constrFields, dataTypeConstrs, dataTypeOf )
+import Data.Time.Clock ( UTCTime )
 import Data.List.Utils ( join, split )
 import Data.Tuple.Curry ( uncurryN )
 import Data.Typeable ( Typeable )
@@ -55,8 +56,9 @@ import TSN.Codegen (
   tsn_codegen_config,
   tsn_db_field_namer ) -- Used in a test
 import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
+import TSN.Picklers ( xp_time_stamp )
 import TSN.XmlImport ( XmlImport(..) )
-import Xml ( FromXml(..), pickle_unpickle, unpickleable )
+import Xml ( FromXml(..), ToDb(..), pickle_unpickle, unpickleable )
 
 
 
@@ -66,12 +68,15 @@ data NewsTeam =
   NewsTeam { team_name :: String }
   deriving (Eq, Show)
 
--- | This is needed to define the XmlImport instance for NewsTeam; it
---   basically says that the DB representation is the same as the XML
---   representation.
+
+instance ToDb NewsTeam where
+  -- | The database representaion of a 'NewsTeam' is itself.
+  type Db NewsTeam = NewsTeam
+
+-- | This is needed to define the XmlImport instance for NewsTeam.
 --
 instance FromXml NewsTeam where
-  type Db NewsTeam = NewsTeam
+  -- | How to we get a 'NewsTeam' from itself?
   from_xml = id
 
 -- | Allow us to call 'insert_xml' on the XML representation of
@@ -99,12 +104,14 @@ data NewsLocation =
     country :: String }
   deriving (Eq, Show)
 
--- | This is needed to define the XmlImport instance for NewsLocation; it
---   basically says that the DB representation is the same as the XML
---   representation.
+instance ToDb NewsLocation where
+  -- | The database representation of a 'NewsLocation' is itself.
+  type Db NewsLocation = NewsLocation
+
+-- | This is needed to define the XmlImport instance for NewsLocation.
 --
 instance FromXml NewsLocation where
-  type Db NewsLocation = NewsLocation
+  -- | How to we get a 'NewsLocation' from itself?
   from_xml = id
 
 -- | Allow us to call 'insert_xml' on the XML representation of
@@ -150,7 +157,7 @@ data Message =
     xml_editor :: Maybe String,
     xml_text :: Maybe String,     -- Text and continue seem to show up in pairs,
     xml_continue :: Maybe String, -- either both present or both missing.
-    xml_time_stamp :: String }
+    xml_time_stamp :: UTCTime }
   deriving (Eq, Show)
 
 
@@ -166,16 +173,19 @@ data News =
     db_sms :: String,
     db_editor :: Maybe String,
     db_text :: Maybe String,
-    db_continue :: Maybe String }
+    db_continue :: Maybe String,
+    db_time_stamp :: UTCTime }
   deriving (Data, Eq, Show, Typeable)
 
 
+
+instance ToDb Message where
+  type Db Message = News
+
 -- | Convert the XML representation 'Message' to the database
 --   representation 'News'.
 --
 instance FromXml Message where
-  type Db Message = News
-
   -- | We use a record wildcard so GHC doesn't complain that we never
   --   used the field names.
   --
@@ -185,7 +195,8 @@ instance FromXml Message where
                                 db_sms = xml_sms,
                                 db_editor = xml_editor,
                                 db_text = xml_text,
-                                db_continue = xml_continue }
+                                db_continue = xml_continue,
+                                db_time_stamp = xml_time_stamp }
 
 -- | This lets us call 'insert_xml' on a 'Message'.
 --
@@ -279,8 +290,12 @@ mkPersist tsn_codegen_config [groundhog|
       fields:
         - name: news_NewsTeam0 # Default created by mkNormalFieldName
           dbName: news_id
+          reference:
+            onDelete: cascade
         - name: news_NewsTeam1 # Default created by mkNormalFieldName
           dbName: news_teams_id
+          reference:
+            onDelete: cascade
 
 - entity: News_NewsLocation
   dbName: news__news_locations
@@ -289,8 +304,12 @@ mkPersist tsn_codegen_config [groundhog|
       fields:
         - name: news_NewsLocation0 # Default created by mkNormalFieldName
           dbName: news_id
+          reference:
+            onDelete: cascade
         - name: news_NewsLocation1 # Default created by mkNormalFieldName
           dbName: news_locations_id
+          reference:
+            onDelete: cascade
 |]
 
 
@@ -353,7 +372,7 @@ pickle_message =
               (xpOption (xpElem "Editor" xpText))
               (xpOption (xpElem "text" xpText))
               pickle_continue
-              (xpElem "time_stamp" xpText)
+              (xpElem "time_stamp" xp_time_stamp)
   where
     from_tuple = uncurryN Message
     to_tuple m = (xml_xml_file_id m, -- Verbose,
@@ -426,7 +445,7 @@ test_news_fields_have_correct_names =
 
 
 -- | If we unpickle something and then pickle it, we should wind up
---   with the same thing we started with. WARNING: succeess of this
+--   with the same thing we started with. WARNING: success of this
 --   test does not mean that unpickling succeeded.
 --
 test_pickle_of_unpickle_is_identity :: TestTree