From: Michael Orlitzky Date: Wed, 30 Jul 2014 07:01:22 +0000 (-0400) Subject: Move the FromXmlFkTeams class out of Xml and into TSN.Team. X-Git-Tag: 0.1.1~11 X-Git-Url: https://gitweb.michael.orlitzky.com/?a=commitdiff_plain;h=3a8d465bcc6f36b6e7601cf1902e575171aa7beb;p=dead%2Fhtsn-import.git Move the FromXmlFkTeams class out of Xml and into TSN.Team. --- diff --git a/src/TSN/Team.hs b/src/TSN/Team.hs index bb73efc..2f58acf 100644 --- 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 diff --git a/src/TSN/XML/JFile.hs b/src/TSN/XML/JFile.hs index 6766374..51e845d 100644 --- a/src/TSN/XML/JFile.hs +++ b/src/TSN/XML/JFile.hs @@ -70,14 +70,17 @@ import TSN.Picklers ( xp_time, xp_time_dots, xp_time_stamp ) -import TSN.Team ( Team(..), HTeam(..), VTeam(..) ) +import TSN.Team ( + FromXmlFkTeams(..), + HTeam(..), + Team(..), + VTeam(..) ) import TSN.XmlImport ( XmlImport(..), XmlImportFkTeams(..) ) import Xml ( Child(..), FromXml(..), - FromXmlFkTeams(..), ToDb(..), pickle_unpickle, unpickleable, diff --git a/src/TSN/XML/Odds.hs b/src/TSN/XML/Odds.hs index 444371a..fed7fa1 100644 --- a/src/TSN/XML/Odds.hs +++ b/src/TSN/XML/Odds.hs @@ -65,12 +65,11 @@ import TSN.Codegen ( tsn_codegen_config ) import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate ) import TSN.Picklers ( xp_date_padded, xp_time, xp_time_stamp ) -import TSN.Team ( Team(..) ) +import TSN.Team ( FromXmlFkTeams(..), Team(..) ) import TSN.XmlImport ( XmlImport(..), XmlImportFkTeams(..) ) import Xml ( Child(..), FromXml(..), - FromXmlFkTeams(..), ToDb(..), pickle_unpickle, unpickleable, diff --git a/src/TSN/XML/Scores.hs b/src/TSN/XML/Scores.hs index adbd5cd..372f1be 100644 --- a/src/TSN/XML/Scores.hs +++ b/src/TSN/XML/Scores.hs @@ -61,12 +61,15 @@ import TSN.Database ( insert_or_select ) import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate ) import TSN.Location ( Location(..), pickle_location ) import TSN.Picklers ( xp_time_stamp ) -import TSN.Team ( Team(..), HTeam(..), VTeam(..) ) +import TSN.Team ( + FromXmlFkTeams(..), + HTeam(..), + Team(..), + VTeam(..) ) import TSN.XmlImport ( XmlImport(..), XmlImportFkTeams(..) ) import Xml ( Child(..), FromXml(..), - FromXmlFkTeams(..), ToDb(..), pickle_unpickle, unpickleable, diff --git a/src/TSN/XmlImport.hs b/src/TSN/XmlImport.hs index 0779ee4..2f9218a 100644 --- a/src/TSN/XmlImport.hs +++ b/src/TSN/XmlImport.hs @@ -20,12 +20,11 @@ import Database.Groundhog.Core ( PersistBackend, PersistEntity ) -- Local imports. -import TSN.Team ( Team(..) ) +import TSN.Team ( FromXmlFkTeams(..), Team(..) ) import Xml ( Child(..), FromXml(..), FromXmlFk(..), - FromXmlFkTeams(..), ToDb(..) ) diff --git a/src/Xml.hs b/src/Xml.hs index 7cfe6eb..ec409ac 100644 --- a/src/Xml.hs +++ b/src/Xml.hs @@ -8,7 +8,6 @@ module Xml ( DtdName(..), FromXml(..), FromXmlFk(..), - FromXmlFkTeams(..), ToDb(..), parse_opts, pickle_unpickle, @@ -39,9 +38,6 @@ import Text.XML.HXT.Core ( yes ) --- Local imports. -import TSN.Team ( Team(..) ) - -- | Common associated type shared by 'FromXml' and 'FromXmlFk'. This -- basically just forces the client to define the \"database @@ -70,8 +66,7 @@ class (ToDb a) => FromXml a where -- | A class for XML representations which are children of other -- elements. The foal is to associate a child XML element with its -- parent element's database type. This is required to construct the --- database analogue of @a@ in the 'FromXmlFk' and 'FromXmlFkTeams' --- classes. +-- database analogue of @a@ in 'FromXmlFk'. -- class Child a where -- | The type of our parent object, i.e. to the type to whom our @@ -91,21 +86,6 @@ class (Child a, ToDb a) => FromXmlFk a where from_xml_fk :: DefaultKey (Parent a) -> a -> Db a --- | 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 - -- | Represents the DTD filename (\"SYSTEM\") part of the DOCTYPE -- definition.