X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FXML%2FInjuries.hs;h=f7eba8d7a072796c08aca39a1dab9a76d3a3c586;hb=e0fe6c60035c9561154d0238ae7c49e7134abcaa;hp=03f956595606ae2c342faa9c68384141d8497e88;hpb=2bbf0d040d768659224b298adb51a8bdabe6a5be;p=dead%2Fhtsn-import.git diff --git a/src/TSN/XML/Injuries.hs b/src/TSN/XML/Injuries.hs index 03f9565..f7eba8d 100644 --- a/src/TSN/XML/Injuries.hs +++ b/src/TSN/XML/Injuries.hs @@ -10,8 +10,9 @@ -- contains a root element \ that in turn contains zero or -- more \s. -- --- The listings will be mapped to a database table called "injuries" --- automatically. The root message is not retained. +-- The listings will be mapped to a database table called +-- \"injuries_listings\" automatically. The root message is not +-- retained. -- module TSN.XML.Injuries ( pickle_message, @@ -21,6 +22,7 @@ module TSN.XML.Injuries ( ListingConstructor(..) ) where +-- System imports. import Data.Data ( Data ) import Data.Typeable ( Typeable ) import Database.Groundhog ( @@ -46,17 +48,23 @@ import Text.XML.HXT.Core ( xpText, xpWrap ) - +-- Local imports. import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate ) import TSN.XmlImport ( XmlImport(..) ) import Xml ( FromXml(..), pickle_unpickle, unpickleable ) +-- | XML/Database representation of a team as they appear in the +-- injuries documents. +-- data InjuriesTeam = InjuriesTeam { team_name :: String, team_league :: Maybe String } deriving (Data, Eq, Show, Typeable) + +-- | XML/Database representation of the injury listings. +-- data Listing = Listing { team :: InjuriesTeam, @@ -65,12 +73,23 @@ data Listing = updated :: Maybe Bool } deriving (Eq, Show) + instance FromXml Listing where + -- | The DB analogue of a 'Listing' is... itself! type Db Listing = Listing + + -- | To convert between a 'Listing' and a 'Listing', we do nothing. from_xml = id +-- | This lets us call 'insert_xml' on a 'Listing' without having to +-- explicitly convert it to its database analogue first. +-- instance XmlImport Listing + +-- | XML representation of an injuriesxml \. This is only +-- used for (un)pickling; 'Message's are not saved to the database. +-- data Message = Message { xml_file_id :: Int, @@ -78,10 +97,13 @@ data Message = category :: String, sport :: String, listings :: [Listing], - time_stamp :: String } + time_stamp :: String -- ^ Slightly lax, but we don't save it, so who cares. + } deriving (Eq, Show) instance DbImport Message where + -- | We import a 'Message' by inserting all of its 'listings'. + -- dbimport msg = mapM_ insert_xml (listings msg) >> return ImportSucceeded dbmigrate _ = run_dbmigrate $ migrate (undefined :: Listing) @@ -103,6 +125,8 @@ mkPersist defaultCodegenConfig [groundhog| |] +-- | A pickler for 'InjuriesTeam's that can convert them to/from XML. +-- pickle_injuries_team :: PU InjuriesTeam pickle_injuries_team = xpElem "team" $ @@ -113,6 +137,8 @@ pickle_injuries_team = to_tuple m = (team_name m, team_league m) +-- | A pickler for 'Listings's that can convert them to/from XML. +-- pickle_listing :: PU Listing pickle_listing = xpElem "listing" $ @@ -126,6 +152,8 @@ pickle_listing = to_tuple l = (team l, teamno l, injuries l, updated l) +-- | A pickler for 'Message's that can convert them to/from XML. +-- pickle_message :: PU Message pickle_message = xpElem "message" $