X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FXML%2FInjuriesDetail.hs;h=7d7c19f99d2d236716171f0a381ea0dc8ca20cb1;hb=610f18c6810edc6bb5dee5cad8bff9e8e59b408a;hp=3f8be8f4ccd118caf61fbf1f3a1bc5f8345d4568;hpb=8fd79929d4e139608ecde40fc70703e0efd56f30;p=dead%2Fhtsn-import.git

diff --git a/src/TSN/XML/InjuriesDetail.hs b/src/TSN/XML/InjuriesDetail.hs
index 3f8be8f..7d7c19f 100644
--- a/src/TSN/XML/InjuriesDetail.hs
+++ b/src/TSN/XML/InjuriesDetail.hs
@@ -13,14 +13,18 @@
 --   found within the \<PlayerListing\>s.
 --
 --   The player listings will be mapped to a database table called
---   "injuries_detail" automatically. The root "message" and "listing"
---   are not retained.
+--   \"injuries_detail_player_listings\" automatically. The root
+--   \"message\" and \"listing\" are not retained.
 --
 module TSN.XML.InjuriesDetail (
+  pickle_message,
+  -- * Tests
   injuries_detail_tests,
-  pickle_message )
+  -- * WARNING: these are private but exported to silence warnings
+  PlayerListingConstructor(..) )
 where
 
+-- System imports.
 import Data.Time ( UTCTime )
 import Data.Tuple.Curry ( uncurryN )
 import Database.Groundhog (
@@ -44,16 +48,24 @@ import Text.XML.HXT.Core (
   xpText,
   xpWrap )
 
-import TSN.Picklers( xp_date, xp_team_id )
+-- Local imports.
+import TSN.Picklers( xp_date )
 import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
 import TSN.XmlImport ( XmlImport(..) )
 import Xml ( FromXml(..), pickle_unpickle, unpickleable )
 
 
+-- | Database representation of a \<PlayerListing\>, the main type of
+--   element contains in Injuries_Detail_XML messages.
+--
 data PlayerListing =
   PlayerListing {
-    team_id   :: String, -- ^ TeamIDs are (apparently) three characters long
-                         --   and not necessarily numeric.
+    team_id   :: String, -- ^ TeamIDs are (apparently) three
+                         --   characters long and not necessarily
+                         --   numeric. Postgres imposes no performance
+                         --   penalty on a lengthless text field,
+                         --   so we ignore the likely upper bound of
+                         --   three characters.
     player_id :: Int,
     date      :: UTCTime,
     pos       :: String,
@@ -66,12 +78,24 @@ data PlayerListing =
     }
   deriving (Eq, Show)
 
+
 instance FromXml PlayerListing where
+  -- | The DB analogue of a 'PlayerListing' is... itself!
   type Db PlayerListing = PlayerListing
+
+    -- | To convert between a 'PlayerListing' and a 'PlayerListing',
+    --   we do nothing.
   from_xml = id
 
+-- | This lets us call 'insert_xml' on a 'PlayerListing' without
+--   having to explicitly convert it to its database analogue first.
+--
 instance XmlImport PlayerListing
 
+
+-- | XML incarnation of a \<Listing\> element. We don't store these;
+--   the data type is used only for parsing.
+--
 data Listing =
   Listing {
     listing_team_id :: String -- ^ Avoid conflict with PlayerListing's team_id.
@@ -82,6 +106,9 @@ data Listing =
   deriving (Eq, Show)
 
 
+-- | XML representation of the top-level \<message\> element. These
+--   are not stored; the data type is used only for parsing.
+--
 data Message =
   Message {
     xml_file_id :: Int,
@@ -93,28 +120,28 @@ data Message =
   deriving (Eq, Show)
 
 instance DbImport Message where
+  -- | To import a 'Message', we import all of its 'PlayerListing's,
+  --   which we have to dig out of its 'Listing's.
   dbimport msg = do
     mapM_ insert_xml (concatMap player_listings $ listings msg)
     return ImportSucceeded
 
   dbmigrate _ = run_dbmigrate $ migrate (undefined :: PlayerListing)
 
+
 mkPersist defaultCodegenConfig [groundhog|
 - entity: PlayerListing
   dbName: injuries_detail_player_listings
-  constructors:
-    - name: PlayerListing
-      fields:
-        - name: team_id
-          type: varchar(3)
 |]
 
 
+-- | Convert 'PlayerListing's to/from XML.
+--
 pickle_player_listing :: PU PlayerListing
 pickle_player_listing =
   xpElem "PlayerListing" $
     xpWrap (from_tuple, to_tuple) $
-    xp10Tuple (xpElem "TeamID" xp_team_id)
+    xp10Tuple (xpElem "TeamID" xpText)
               (xpElem "PlayerID" xpInt)
               (xpElem "Date" xp_date)
               (xpElem "Pos" xpText)
@@ -138,11 +165,13 @@ pickle_player_listing =
                    injury_type pl)
 
 
+-- | Convert 'Listing's to/from XML.
+--
 pickle_listing :: PU Listing
 pickle_listing =
   xpElem "Listing" $
     xpWrap (from_tuple, to_tuple) $
-    xpTriple (xpElem "TeamID" xp_team_id)
+    xpTriple (xpElem "TeamID" xpText)
              (xpElem "FullName" xpText)
              (xpList pickle_player_listing)
   where
@@ -150,6 +179,8 @@ pickle_listing =
     to_tuple l = (listing_team_id l, full_name l, player_listings l)
 
 
+-- | Convert 'Message's to/from XML.
+--
 pickle_message :: PU Message
 pickle_message =
   xpElem "message" $
@@ -170,7 +201,12 @@ pickle_message =
                   time_stamp m)
 
 
--- * Tasty Tests
+--
+-- Tasty Tests
+--
+
+-- | A list of all tests for this module.
+--
 injuries_detail_tests :: TestTree
 injuries_detail_tests =
   testGroup
@@ -179,8 +215,10 @@ injuries_detail_tests =
       test_unpickle_succeeds ]
 
 
--- | Warning, succeess of this test does not mean that unpickling
---   succeeded.
+-- | If we unpickle something and then pickle it, we should wind up
+--   with the same thing we started with. WARNING: success of this
+--   test does not mean that unpickling succeeded.
+--
 test_pickle_of_unpickle_is_identity :: TestTree
 test_pickle_of_unpickle_is_identity = testGroup "pickle-unpickle tests"
   [ check "pickle composed with unpickle is the identity"
@@ -194,6 +232,8 @@ test_pickle_of_unpickle_is_identity = testGroup "pickle-unpickle tests"
       actual @?= expected
 
 
+-- | Make sure we can actually unpickle these things.
+--
 test_unpickle_succeeds :: TestTree
 test_unpickle_succeeds = testGroup "unpickle tests"
   [ check "unpickling succeeds"