Split the (Db a) associated type out into its own class, ToDb.
Update News, Odds, and Weather for the new typeclass hierarchy.
import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
import TSN.Picklers ( xp_time_stamp )
import TSN.XmlImport ( XmlImport(..) )
-import Xml ( FromXml(..), pickle_unpickle, unpickleable )
+import Xml ( FromXml(..), ToDb(..), pickle_unpickle, unpickleable )
NewsTeam { team_name :: String }
deriving (Eq, Show)
--- | This is needed to define the XmlImport instance for NewsTeam; it
--- basically says that the DB representation is the same as the XML
--- representation.
+
+instance ToDb NewsTeam where
+ -- | The database representaion of a 'NewsTeam' is itself.
+ type Db NewsTeam = NewsTeam
+
+-- | This is needed to define the XmlImport instance for NewsTeam.
--
instance FromXml NewsTeam where
- type Db NewsTeam = NewsTeam
+ -- | How to we get a 'NewsTeam' from itself?
from_xml = id
-- | Allow us to call 'insert_xml' on the XML representation of
country :: String }
deriving (Eq, Show)
--- | This is needed to define the XmlImport instance for NewsLocation; it
--- basically says that the DB representation is the same as the XML
--- representation.
+instance ToDb NewsLocation where
+ -- | The database representation of a 'NewsLocation' is itself.
+ type Db NewsLocation = NewsLocation
+
+-- | This is needed to define the XmlImport instance for NewsLocation.
--
instance FromXml NewsLocation where
- type Db NewsLocation = NewsLocation
+ -- | How to we get a 'NewsLocation' from itself?
from_xml = id
-- | Allow us to call 'insert_xml' on the XML representation of
deriving (Data, Eq, Show, Typeable)
+
+instance ToDb Message where
+ type Db Message = News
+
-- | Convert the XML representation 'Message' to the database
-- representation 'News'.
--
instance FromXml Message where
- type Db Message = News
-
-- | We use a record wildcard so GHC doesn't complain that we never
-- used the field names.
--
import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
import TSN.Picklers ( xp_date, xp_time )
import TSN.XmlImport ( XmlImport(..) )
-import Xml ( FromXml(..), pickle_unpickle, unpickleable )
+import Xml ( FromXml(..), ToDb(..), pickle_unpickle, unpickleable )
deriving (Eq, Show)
-instance FromXml OddsGameCasinoXml where
+instance ToDb OddsGameCasinoXml where
-- | The database representation of an 'OddsGameCasinoXml' is an
-- 'OddsCasino'.
--
type Db OddsGameCasinoXml = OddsCasino
+instance FromXml OddsGameCasinoXml where
-- | We convert from XML to the database by dropping the line field.
from_xml OddsGameCasinoXml{..} =
OddsCasino {
xml_home_casinos :: [OddsGameCasinoXml] }
deriving (Eq, Show)
-instance FromXml OddsGameHomeTeamXml where
+instance ToDb OddsGameHomeTeamXml where
-- | The database representation of an 'OddsGameHomeTeamXml' is an
-- 'OddsGameTeam'.
--
type Db OddsGameHomeTeamXml = OddsGameTeam
+instance FromXml OddsGameHomeTeamXml where
-- | We convert from XML to the database by dropping the lines and
-- rotation number (which are specific to the games, not the teams
-- themselves).
xml_away_casinos :: [OddsGameCasinoXml] }
deriving (Eq, Show)
-instance FromXml OddsGameAwayTeamXml where
+instance ToDb OddsGameAwayTeamXml where
-- | The database representation of an 'OddsGameAwayTeamXml' is an
-- 'OddsGameTeam'.
--
type Db OddsGameAwayTeamXml = OddsGameTeam
+instance FromXml OddsGameAwayTeamXml where
-- | We convert from XML to the database by dropping the lines and
-- rotation number (which are specific to the games, not the teams
-- themselves).
xml_game_over_under_casinos = xml_casinos . xml_game_over_under
-instance FromXml OddsGameXml where
+instance ToDb OddsGameXml where
-- | The database representation of an 'OddsGameXml' is an
-- 'OddsGame'.
--
type Db OddsGameXml = OddsGame
+instance FromXml OddsGameXml where
-- | To convert from the XML representation to the database one, we
-- drop the home/away teams and the casino lines, but retain the
-- home/away rotation numbers.
xml_games m = map game (xml_games_with_notes m)
-instance FromXml Message where
+instance ToDb Message where
-- | The database representation of a 'Message' is 'Odds'.
--
type Db Message = Odds
+instance FromXml Message where
-- | To convert from the XML representation to the database one, we
-- just drop a bunch of fields.
--
import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
import TSN.Picklers ( xp_gamedate )
import TSN.XmlImport ( XmlImport(..) )
-import Xml ( FromXml(..), pickle_unpickle, unpickleable )
+import Xml ( FromXml(..), ToDb(..), pickle_unpickle, unpickleable )
db_weather :: String }
deriving (Eq, Show)
+-- | The database analogue of a 'WeatherForecastListing' is itself.
+instance ToDb WeatherForecastListing where
+ type Db WeatherForecastListing = WeatherForecastListing
+
-- | This is needed to define the XmlImport instance for
--- 'WeatherForecastListing'; it basically says that the DB
--- representation is the same as the XML representation.
+-- 'WeatherForecastListing'.
--
instance FromXml WeatherForecastListing where
- type Db WeatherForecastListing = WeatherForecastListing
from_xml = id
-- | Allows us to call 'insert_xml' on the XML representation of
deriving (Eq, Show)
-instance FromXml WeatherForecastXml where
+instance ToDb WeatherForecastXml where
-- | The database representation of a 'WeatherForecastXml' is a
-- 'WeatherForecast'.
--
type Db WeatherForecastXml = WeatherForecast
+instance FromXml WeatherForecastXml where
-- | To convert a 'WeatherForecastXml' into a 'WeatherForecast', we
-- replace the 'WeatherLeague' with its name.
--
deriving (Eq, Show)
-instance FromXml Message where
+instance ToDb Message where
-- | The database representation of 'Message' is 'Weather'.
--
type Db Message = Weather
+instance FromXml Message where
-- | To get a 'Weather' from a 'Message', we drop a bunch of
-- unwanted fields.
--
+{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
-- | General XML stuff.
DtdName(..),
FromXml(..),
FromXmlFk(..),
+ ToDb(..),
parse_opts,
pickle_unpickle,
unpickleable )
-- System imports.
import Control.Exception ( SomeException(..), catch )
-import Database.Groundhog.Core ( DefaultKey )
+import Database.Groundhog.Core ( PersistEntity(..) )
import Text.XML.HXT.Core (
(>>>),
(/>),
xunpickleVal,
yes )
+-- | Common associated type shared by 'FromXml' and 'FromXmlFk'. This
+-- basically just forces the client to define the \"database
+-- version\" of his type.
+--
+class ToDb a where
+ -- | Each instance @a@ must declare its associated database type @Db a@.
+ type Db a :: *
-- | A typeclass for XML types that can be converted into an
-- associated database type. The story behind this is long, but
-- to get the database type from the XML type that we have to define
-- for HXT.
--
-class FromXml a where
- -- | Each instance @a@ must declare its associated database type @Db a@.
- type Db a :: *
-
- -- | And provide a function for getting a @Db a@ out of an @a@.
+class (ToDb a) => FromXml a where
+ -- | A function for getting a @Db a@ out of an @a@.
from_xml :: a -> Db a
-- first. Members of this class can be converted from an XML
-- representation to a database representation in this manner.
--
-class FromXmlFk a where
- -- | Each instance @a@ must declare its associated database type @DbFk a@.
- type DbFk a :: *
-
+class (ToDb a) => FromXmlFk a where
-- | The type of our parent object, i.e. to the type to whom our
-- foreign key will point.
type Parent a :: *
- -- | The function that produces a @DbFk a@ out of an @a@ and a foreign
- -- key.
- from_xml_fk :: a -> DefaultKey (Parent a) -> DbFk a
+ -- | The function that produces a @Db a@ out of a foreign key and an
+ -- @a@. The parameter order makes it easier to map this function
+ -- over a bunch of things.
+ from_xml_fk :: DefaultKey (Parent a) -> a -> Db a
-- | Represents the DTD filename (\"SYSTEM\") part of the DOCTYPE
projects / dead / htsn-import.git / commitdiff