X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FXML%2FGameInfo.hs;h=2b5e1adb9ed3b45ad803a26479811088ab5099e6;hb=6eb1c7477c2d4d3cace6d1b865a5efbec21300a7;hp=8938200ec480e7765cd8d75732d3c1a635be7b9c;hpb=b45f24209ce6f1eb3c24a5f01a71f5940a001c02;p=dead%2Fhtsn-import.git

diff --git a/src/TSN/XML/GameInfo.hs b/src/TSN/XML/GameInfo.hs
index 8938200..2b5e1ad 100644
--- a/src/TSN/XML/GameInfo.hs
+++ b/src/TSN/XML/GameInfo.hs
@@ -21,15 +21,18 @@ where
 
 -- System imports.
 import Data.Either ( rights )
+import Data.String.Utils ( replace )
 import Data.Time.Clock ( UTCTime )
 import Database.Groundhog (
   countAll,
+  insert_,
   migrate,
   runMigration,
   silentMigrationLogger )
 import Database.Groundhog.Generic ( runDbConn )
 import Database.Groundhog.Sqlite ( withSqliteConn )
 import Database.Groundhog.TH (
+  defaultCodegenConfig,
   groundhog,
   mkPersist )
 import Test.Tasty ( TestTree, testGroup )
@@ -38,7 +41,6 @@ import Text.XML.HXT.Core ( XmlTree )
 import Text.XML.HXT.DOM.ShowXml ( xshow )
 
 -- Local imports.
-import TSN.Codegen ( tsn_codegen_config )
 import TSN.DbImport (
   DbImport(..),
   ImportResult(..),
@@ -47,11 +49,7 @@ import TSN.Parse (
   parse_message,
   parse_xmlfid,
   parse_xml_time_stamp )
-import TSN.XmlImport ( XmlImport(..) )
-import Xml (
-  FromXml(..),
-  ToDb(..),
-  unsafe_read_document )
+import Xml ( unsafe_read_document )
 
 
 -- | The DTDs for everything that we consider \"Game Info.\"
@@ -83,85 +81,56 @@ dtds =
     "WorldBaseballPreviewXML.dtd" ]
 
 
--- | XML representation of a GameInfo \<message\>.
+-- | This serves as both the database and XML representation of a
+--   GameInfo \<message\>.
 --
-data Message =
-  Message {
-    xml_dtd :: String,
-    xml_xml_file_id :: Int,
-    xml_time_stamp :: UTCTime,
-    xml_xml :: String }
+data GameInfo =
+  GameInfo {
+    dtd :: String,
+    xml_file_id :: Int,
+    time_stamp :: UTCTime,
+    xml :: String }
   deriving (Eq, Show)
 
 
--- | Attempt to parse a 'Message' from an 'XmlTree'. If we cannot,
+-- | Attempt to parse a 'GameInfo' from an 'XmlTree'. If we cannot,
 --   we fail with an error message.
 --
-parse_xml :: String -> XmlTree -> Either String Message
+parse_xml :: String -> XmlTree -> Either String GameInfo
 parse_xml dtdname xmltree = do
   xmlfid <- parse_xmlfid xmltree
   timestamp <- parse_xml_time_stamp xmltree
   message <- parse_message xmltree
-  return $ Message dtdname (fromInteger xmlfid) timestamp (xshow [message])
-
-
--- | Database representation of a 'Message'.
---
-data GameInfo =
-  GameInfo {
-    db_dtd :: String,
-    db_xml_file_id :: Int,
-    db_time_stamp :: UTCTime,
-    db_xml :: String }
-
-
-instance ToDb Message where
-  -- | The database analogue of a 'Message' is an 'GameInfo'.
-  type Db Message = GameInfo
-
-instance FromXml Message where
-  -- | The XML to DB conversion is trivial here.
-  --
-  from_xml Message{..} = GameInfo {
-                           db_dtd = xml_dtd,
-                           db_xml_file_id = xml_xml_file_id,
-                           db_time_stamp = xml_time_stamp,
-                           db_xml = xml_xml }
-
-
--- | This allows us to insert the XML representation 'Message'
---   directly.
---
-instance XmlImport Message
-
+  return $ GameInfo dtdname (fromInteger xmlfid) timestamp (xshow [message])
 
 --
 -- Database code
 --
 
-instance DbImport Message where
+instance DbImport GameInfo where
   dbmigrate _ =
     run_dbmigrate $ migrate (undefined :: GameInfo)
 
-  -- | We import a 'Message' by inserting the whole thing at
+  -- | We import a 'GameInfo' by inserting the whole thing at
   --   once. Nothing fancy going on here.
   dbimport msg = do
-    insert_xml_ msg
+    insert_ msg
     return ImportSucceeded
 
 
 -- | The database schema for GameInfo is trivial; all we need is for
 --   the XML_File_ID to be unique.
 --
-mkPersist tsn_codegen_config [groundhog|
+mkPersist defaultCodegenConfig [groundhog|
 - entity: GameInfo
+  dbName: game_info
   constructors:
     - name: GameInfo
       uniques:
         - name: unique_game_info
           type: constraint
           # Prevent multiple imports of the same message.
-          fields: [db_xml_file_id]
+          fields: [xml_file_id]
 |]
 
 
@@ -175,34 +144,40 @@ game_info_tests :: TestTree
 game_info_tests =
   testGroup
     "GameInfo tests"
-    [ test_parse_xml_succeeds,
+    [ test_accessors,
+      test_parse_xml_succeeds,
       test_dbimport_succeeds ]
 
 
+-- | Make sure the accessors work and that we can parse one file. Ok,
+--   so the real point of this is to make the unused fields (dtd, xml,
+--   ...) warning go away without having to mangle the groundhog code.
+--
+test_accessors :: TestTree
+test_accessors = testCase "we can access a parsed game_info" $ do
+  xmltree <- unsafe_read_document "test/xml/gameinfo/recapxml.xml"
+  let Right t = parse_xml "recapxml.dtd" xmltree
+  let a1  = dtd t
+  let ex1 = "recapxml.dtd"
+  let a2  = xml_file_id t
+  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)
+  actual @?= expected
+
+
 -- | Sample XML documents for GameInfo types.
 --
 game_info_test_files :: [FilePath]
 game_info_test_files =
-  [ "test/xml/gameinfo/CBASK_Lineup_XML.xml",
-    "test/xml/gameinfo/cbaskpreviewxml.xml",
-    "test/xml/gameinfo/cflpreviewxml.xml",
-    "test/xml/gameinfo/Matchup_NBA_NHL_XML.xml",
-    "test/xml/gameinfo/MLB_Gaming_Matchup_XML.xml",
-    "test/xml/gameinfo/MLB_Lineup_XML.xml",
-    "test/xml/gameinfo/MLB_Matchup_XML.xml",
-    "test/xml/gameinfo/mlbpreviewxml.xml",
-    "test/xml/gameinfo/MLS_Preview_XML.xml",
-    "test/xml/gameinfo/NBA_Gaming_Matchup_XML.xml",
-    "test/xml/gameinfo/NBALineupXML.xml",
-    "test/xml/gameinfo/NBA_Playoff_Matchup_XML.xml",
-    "test/xml/gameinfo/NCAA_FB_Preview_XML.xml",
-    "test/xml/gameinfo/nbapreviewxml.xml",
-    "test/xml/gameinfo/nflpreviewxml.xml",
-    "test/xml/gameinfo/NFL_NCAA_FB_Matchup_XML.xml",
-    "test/xml/gameinfo/nhlpreviewxml.xml",
-    "test/xml/gameinfo/recapxml.xml",
-    "test/xml/gameinfo/WorldBaseballPreviewXML.xml" ]
-
+  map (change_suffix . add_path) dtds
+  where
+     add_path = ("test/xml/gameinfo/" ++ )
+     change_suffix = replace ".dtd" ".xml"
 
 -- | Make sure we can parse every element of 'game_info_test_files'.
 --
@@ -230,7 +205,7 @@ test_dbimport_succeeds = testCase "dbimport succeeds" $ do
   xmltrees <- mapM unsafe_read_document game_info_test_files
   let msgs = rights $ map (parse_xml "dummy") xmltrees
   actual <- withSqliteConn ":memory:" $ runDbConn $ do
-                runMigration silentMigrationLogger $ do
+                runMigration silentMigrationLogger $
                   migrate (undefined :: GameInfo)
                 mapM_ dbimport msgs
                 countAll (undefined :: GameInfo)