X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FTeam.hs;fp=src%2FTSN%2FTeam.hs;h=2f58acf6de5817903e37643a194158bb0842ff02;hb=3a8d465bcc6f36b6e7601cf1902e575171aa7beb;hp=bb73efcf975cf11c949acd92e04db8296eecdae9;hpb=bdf946f013cf93625d5c0ef208f943cd97b5754b;p=dead%2Fhtsn-import.git 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