Add game_id/schedule_id parsers to TSN.Parse.

[dead/htsn-import.git] / src / TSN / XML / GameInfo.hs

diff --git a/src/TSN/XML/GameInfo.hs b/src/TSN/XML/GameInfo.hs
index 2b5e1adb9ed3b45ad803a26479811088ab5099e6..2830295a78d16d898989d0d45df94858c760e3f1 100644 (file)
--- a/src/TSN/XML/GameInfo.hs
+++ b/src/TSN/XML/GameInfo.hs
@@ -46,7 +46,10 @@ import TSN.DbImport (
   ImportResult(..),
   run_dbmigrate )
 import TSN.Parse (
+  ParseError,
+  parse_game_id,
   parse_message,
+  parse_schedule_id,
   parse_xmlfid,
   parse_xml_time_stamp )
 import Xml ( unsafe_read_document )
@@ -84,10 +87,23 @@ dtds =
 -- | This serves as both the database and XML representation of a
 --   GameInfo \<message\>.
 --
+--   The 'game_id' and 'schedule_id' fields are foreign keys, but they
+--   key into multiple tables and key on records which may not exist
+--   when we import the GameInfo document. We therefore don't declare
+--   them as foreign keys; i.e. we don't require them to point
+--   anywhere in particular. But if they do, that's nice.
+--
 data GameInfo =
   GameInfo {
     dtd :: String,
     xml_file_id :: Int,
+    game_id :: Maybe Int, -- ^ These are optional because they are missing
+                          --   from at least the MLB_Matchup_XML.dtd documents.
+                          --   They provide foreign keys into any tables storing
+                          --   games with their IDs.
+
+    schedule_id :: Int,   -- ^ Required foreign key into any table storing a
+                          --   schedule along with its ID.
     time_stamp :: UTCTime,
     xml :: String }
   deriving (Eq, Show)
@@ -96,15 +112,23 @@ data GameInfo =
 -- | Attempt to parse a 'GameInfo' from an 'XmlTree'. If we cannot,
 --   we fail with an error message.
 --
-parse_xml :: String -> XmlTree -> Either String GameInfo
+parse_xml :: String -> XmlTree -> Either ParseError GameInfo
 parse_xml dtdname xmltree = do
   xmlfid <- parse_xmlfid xmltree
+  game_id <- parse_game_id xmltree
+  schedule_id <- parse_schedule_id xmltree
   timestamp <- parse_xml_time_stamp xmltree
   message <- parse_message xmltree
-  return $ GameInfo dtdname (fromInteger xmlfid) timestamp (xshow [message])
+  return $ GameInfo
+             dtdname
+             xmlfid
+             game_id
+             schedule_id
+             timestamp
+             (xshow [message])
 
 --
--- Database code
+-- * Database code
 --
 
 instance DbImport GameInfo where
@@ -163,10 +187,14 @@ test_accessors = testCase "we can access a parsed game_info" $ do
   let ex2 = 21201550
   let a3  = show $ time_stamp t
   let ex3 = "2014-05-31 15:13:00 UTC"
-  let a4  = take 9 (xml t)
-  let ex4 = "<message>"
-  let actual = (a1,a2,a3,a4)
-  let expected = (ex1,ex2,ex3,ex4)
+  let a4  = game_id t
+  let ex4  = Just 39978
+  let a5  = schedule_id t
+  let ex5  = 39978
+  let a6  = take 9 (xml t)
+  let ex6 = "<message>"
+  let actual = (a1,a2,a3,a4,a5,a6)
+  let expected = (ex1,ex2,ex3,ex4,ex5,ex6)
   actual @?= expected