X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhtsn-import.git;a=blobdiff_plain;f=src%2FTSN%2FXML%2FSportInfo.hs;h=0ceba417492ebf4c4cb55d0a57906ee81a952689;hp=7c5f1ac6da983dc2d6b4a8c6f2af007d0cc43431;hb=2bf6ea31afc5d87e2c953d44ff89ff7e4ec73c32;hpb=02a9363651a96a2469567cb1fb303a9a3cf33dce

diff --git a/src/TSN/XML/SportInfo.hs b/src/TSN/XML/SportInfo.hs
index 7c5f1ac..0ceba41 100644
--- a/src/TSN/XML/SportInfo.hs
+++ b/src/TSN/XML/SportInfo.hs
@@ -10,7 +10,7 @@
 --   database along with the XML_File_ID, but we don't parse any of it.
 --
 --   This is almost completely redundant with "TSN.XML.GameInfo", but
---   the redundancy is necessary: we need separate 'Message' types so
+--   the redundancy is necessary: we need separate message types so
 --   that we can have separate 'DbImport' instances. It would take
 --   more code/work to abstract (if it's even possible) than to
 --   duplicate.
@@ -29,12 +29,14 @@ 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 )
@@ -43,7 +45,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(..),
@@ -52,11 +53,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 \"Sport Info.\"
@@ -196,77 +193,48 @@ dtds =
     "WNBATurnoversXML.dtd" ]
 
 
--- | XML representation of a SportInfo \<message\>.
+-- | This serves as both the database and XML representation of a
+--   SportInfo \<message\>.
 --
-data Message =
-  Message {
-    xml_dtd :: String,
-    xml_xml_file_id :: Int,
-    xml_time_stamp :: UTCTime,
-    xml_xml :: String }
+data SportInfo =
+  SportInfo {
+    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 'SportInfo' 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 SportInfo
 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 SportInfo =
-  SportInfo {
-    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 'SportInfo'.
-  type Db Message = SportInfo
-
-instance FromXml Message where
-  -- | The XML to DB conversion is trivial here.
-  --
-  from_xml Message{..} = SportInfo {
-                           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 $ SportInfo dtdname (fromInteger xmlfid) timestamp (xshow [message])
 
 
 --
 -- Database code
 --
 
-instance DbImport Message where
+instance DbImport SportInfo where
   dbmigrate _ =
     run_dbmigrate $ migrate (undefined :: SportInfo)
 
-  -- | We import a 'Message' by inserting the whole thing at
+  -- | We import a 'SportInfo' 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 SportInfo is trivial; all we need is for
 --   the XML_File_ID to be unique.
 --
-mkPersist tsn_codegen_config [groundhog|
+mkPersist defaultCodegenConfig [groundhog|
 - entity: SportInfo
   constructors:
     - name: SportInfo
@@ -274,7 +242,7 @@ mkPersist tsn_codegen_config [groundhog|
         - name: unique_sport_info
           type: constraint
           # Prevent multiple imports of the same message.
-          fields: [db_xml_file_id]
+          fields: [xml_file_id]
 |]
 
 
@@ -288,10 +256,32 @@ sport_info_tests :: TestTree
 sport_info_tests =
   testGroup
     "SportInfo 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 sport_info" $ do
+  xmltree <- unsafe_read_document "test/xml/sportinfo/wnbastandxml.xml"
+  let Right t = parse_xml "wnbastandxml.dtd" xmltree
+  let a1  = dtd t
+  let ex1 = "wnbastandxml.dtd"
+  let a2  = xml_file_id t
+  let ex2 = 2011
+  let a3  = show $ time_stamp t
+  let ex3 = "2009-09-28 00:50: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 SportInfo types.
 --
 sport_info_test_files :: [FilePath]