Move the FromXmlFkTeams class out of Xml and into TSN.Team.

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

diff --git a/src/TSN/Team.hs b/src/TSN/Team.hs
index bb73efcf975cf11c949acd92e04db8296eecdae9..2f58acf6de5817903e37643a194158bb0842ff02 100644 (file)
--- a/src/TSN/Team.hs
+++ b/src/TSN/Team.hs
@@ -14,6 +14,7 @@
 --
 module TSN.Team (
   HTeam(..),
+  FromXmlFkTeams(..),
   Team(..),
   VTeam(..),
   -- * WARNING: these are private but exported to silence warnings
@@ -22,11 +23,15 @@ where
 
 -- System imports
 import Database.Groundhog () -- Required for some String instance
+import Database.Groundhog.Core ( PersistEntity(..) )
 import Database.Groundhog.TH (
   defaultCodegenConfig,
   groundhog,
   mkPersist )
 
+-- Local imports
+import Xml ( Child(..), Db(..) )
+
 
 -- * Team
 
@@ -76,3 +81,20 @@ mkPersist defaultCodegenConfig [groundhog|
           type: constraint
           fields: [team_id]
 |]
+
+
+
+-- | A further refinement of 'FromXmlFk'. These types need not only a
+--   foreign key to a parent in order to make the XML -> DB
+--   conversion, but also two foreign keys to away/home teams (as
+--   represented in "TSN.Team").
+--
+class (Child a, ToDb a) => FromXmlFkTeams a where
+  -- | The function that produces a @Db a@ out of a parent foreign
+  -- key, two team foreign keys, and an @a@. The parameter order makes
+  -- it easier to map this function over a bunch of things.
+  from_xml_fk_teams :: DefaultKey (Parent a)
+                    -> DefaultKey Team -- ^ The away team FK
+                    -> DefaultKey Team -- ^ The home team FK
+                    -> a
+                    -> Db a