From: Michael Orlitzky Date: Fri, 4 Jul 2014 05:25:12 +0000 (-0400) Subject: Add the FromXmlFkTeams class. X-Git-Tag: 0.0.6~46 X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhtsn-import.git;a=commitdiff_plain;h=d5b58915c065b1e8e523c2c7c2aa79732b328028 Add the FromXmlFkTeams class. --- diff --git a/src/Xml.hs b/src/Xml.hs index e7d47a1..5c84664 100644 --- a/src/Xml.hs +++ b/src/Xml.hs @@ -7,6 +7,7 @@ module Xml ( DtdName(..), FromXml(..), FromXmlFk(..), + FromXmlFkTeams(..), ToDb(..), parse_opts, pickle_unpickle, @@ -36,6 +37,11 @@ import Text.XML.HXT.Core ( xunpickleVal, 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 -- version\" of his type. @@ -76,6 +82,22 @@ class (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 (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. newtype DtdName = DtdName String