Use Generics.to_tuple in TSN.XML.InjuriesDetail.

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

diff --git a/src/TSN/XML/InjuriesDetail.hs b/src/TSN/XML/InjuriesDetail.hs
index 4356eb60be9c344267eaea850092d5aed632cac5..90fb0cdb894a523ebbb342bf3ebc59620e1b228b 100644 (file)
--- a/src/TSN/XML/InjuriesDetail.hs
+++ b/src/TSN/XML/InjuriesDetail.hs
@@ -1,8 +1,8 @@
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
 
@@ -30,7 +30,7 @@ import Data.Tuple.Curry ( uncurryN )
 import Database.Groundhog (
   DefaultKey,
   countAll,
-  executeRaw,
+  deleteAll,
   migrate,
   runMigration,
   silentMigrationLogger )
@@ -39,6 +39,7 @@ import Database.Groundhog.Sqlite ( withSqliteConn )
 import Database.Groundhog.TH (
   groundhog,
   mkPersist )
+import qualified GHC.Generics as GHC ( Generic )
 import Test.Tasty ( TestTree, testGroup )
 import Test.Tasty.HUnit ( (@?=), testCase )
 import Text.XML.HXT.Core (
@@ -55,11 +56,13 @@ import Text.XML.HXT.Core (
   xpWrap )
 
 -- Local imports.
+import Generics ( Generic(..), to_tuple )
 import TSN.Codegen ( tsn_codegen_config )
 import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
 import TSN.Picklers( xp_date, xp_time_stamp )
 import TSN.XmlImport ( XmlImport(..), XmlImportFk(..) )
 import Xml (
+  Child(..),
   FromXml(..),
   FromXmlFk(..),
   ToDb(..),
@@ -94,7 +97,13 @@ data Message =
     xml_sport :: String,
     xml_listings :: [InjuriesDetailListingXml],
     xml_time_stamp :: UTCTime }
-  deriving (Eq, Show)
+  deriving (Eq, GHC.Generic, Show)
+
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic Message
+
 
 -- | Database representation of a 'Message'.
 --
@@ -154,18 +163,27 @@ data InjuriesDetailListingXml =
 
     xml_full_name :: String, -- ^ Team full name
     xml_player_listings :: [InjuriesDetailListingPlayerListingXml] }
-  deriving (Eq, Show)
+  deriving (Eq, GHC.Generic, Show)
+
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic InjuriesDetailListingXml
+
 
 instance ToDb InjuriesDetailListingXml where
   -- | The database analogue of an 'InjuriesDetailListingXml' is a
   --   'InjuriesDetailListing'.
   type Db InjuriesDetailListingXml = InjuriesDetailListing
 
-instance FromXmlFk InjuriesDetailListingXml where
+
+instance Child InjuriesDetailListingXml where
   -- | Each 'InjuriesDetailListingXml' is contained in an
   --   'InjuriesDetail'.
   type Parent InjuriesDetailListingXml = InjuriesDetail
 
+
+instance FromXmlFk InjuriesDetailListingXml where
   -- | Construct a 'InjuriesDetailListing' from a
   --   'InjuriesDetailListingXml' and a foreign key to a
   --   'InjuriesDetail'.
@@ -207,8 +225,12 @@ data InjuriesDetailListingPlayerListingXml =
     xml_fantasy   :: Maybe String, -- ^ Nobody knows what this is.
     xml_injured     :: Bool,
     xml_type :: String }
-  deriving (Eq, Show)
+  deriving (Eq, GHC.Generic, Show)
+
 
+-- | For 'Generics.to_tuple'.
+--
+instance Generic InjuriesDetailListingPlayerListingXml
 
 
 -- | Database representation of a
@@ -235,12 +257,15 @@ instance ToDb InjuriesDetailListingPlayerListingXml where
   type Db InjuriesDetailListingPlayerListingXml =
     InjuriesDetailListingPlayerListing
 
-instance FromXmlFk InjuriesDetailListingPlayerListingXml where
+
+instance Child InjuriesDetailListingPlayerListingXml where
   -- | Each 'InjuriesDetailListingPlayerListingXml' is contained in an
   --   'InjuriesDetailListing'.
   --
   type Parent InjuriesDetailListingPlayerListingXml = InjuriesDetailListing
 
+
+instance FromXmlFk InjuriesDetailListingPlayerListingXml where
   -- | To construct a 'InjuriesDetailListingPlayerListing' from a
   --   'InjuriesDetailListingPlayerListingXml' we need to supply a
   --   foreign key to an 'InjuriesDetailListing'.
@@ -343,16 +368,6 @@ pickle_player_listing =
               (xpElem "Type" xpText)
   where
     from_tuple = uncurryN InjuriesDetailListingPlayerListingXml
-    to_tuple pl = (xml_player_team_id pl,
-                   xml_player_id pl,
-                   xml_date pl,
-                   xml_pos pl,
-                   xml_name pl,
-                   xml_injury pl,
-                   xml_status pl,
-                   xml_fantasy pl,
-                   xml_injured pl,
-                   xml_type pl)
 
 
 -- | Convert 'Listing's to/from XML.
@@ -366,9 +381,6 @@ pickle_listing =
              (xpList pickle_player_listing)
   where
     from_tuple = uncurryN InjuriesDetailListingXml
-    to_tuple l = (xml_team_id l,
-                  xml_full_name l,
-                  xml_player_listings l)
 
 
 -- | Convert 'Message's to/from XML.
@@ -385,12 +397,6 @@ pickle_message =
              (xpElem "time_stamp" xp_time_stamp)
   where
     from_tuple = uncurryN Message
-    to_tuple m = (xml_xml_file_id m,
-                  xml_heading m,
-                  xml_category m,
-                  xml_sport m,
-                  xml_listings m,
-                  xml_time_stamp m)
 
 
 --
@@ -463,8 +469,7 @@ test_on_delete_cascade = testGroup "cascading delete tests"
                     migrate b
                     migrate c
                   _ <- dbimport inj
-                  -- No idea how 'delete' works, so do this instead.
-                  executeRaw False "DELETE FROM injuries_detail;" []
+                  deleteAll a
                   count_a <- countAll a
                   count_b <- countAll b
                   count_c <- countAll c