From: Michael Orlitzky <michael@orlitzky.com>
Date: Fri, 2 Jan 2015 21:21:38 +0000 (-0500)
Subject: Migrate TSN.XML.Injuries to fixed-vector-hetero.
X-Git-Tag: 0.2.1~22
X-Git-Url: https://gitweb.michael.orlitzky.com/?a=commitdiff_plain;h=6fb74d99ca4eebbd8ca624c64b4f4cf707afad8f;p=dead%2Fhtsn-import.git

Migrate TSN.XML.Injuries to fixed-vector-hetero.
---

diff --git a/src/TSN/XML/Injuries.hs b/src/TSN/XML/Injuries.hs
index 368f846..85b7bee 100644
--- a/src/TSN/XML/Injuries.hs
+++ b/src/TSN/XML/Injuries.hs
@@ -30,6 +30,7 @@ where
 import Data.Data ( Data )
 import Data.Time ( UTCTime )
 import Data.Typeable ( Typeable )
+import qualified Data.Vector.HFixed as H ( HVector, cons, convert )
 import Database.Groundhog (
   countAll,
   deleteAll,
@@ -61,7 +62,6 @@ import Text.XML.HXT.Core (
   xpWrap )
 
 -- Local imports.
-import Generics ( Generic(..), to_tuple )
 import TSN.Codegen ( tsn_codegen_config )
 import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
 import TSN.Picklers ( xp_time_stamp )
@@ -100,33 +100,40 @@ data InjuriesTeam =
 
 -- * InjuriesListing/InjuriesListingXml
 
--- | XML representation of the injury listings.
+-- | XML representation of the injury listings. The leading
+--   underscores prevent unused field warnings.
 --
 data InjuriesListingXml =
   InjuriesListingXml {
-    xml_team :: InjuriesTeam,
-    xml_teamno :: Maybe String, -- ^ Can contain non-numerics, e.g. \"ZR2\"
-    xml_injuries :: String,
-    xml_updated :: Maybe Bool }
+    _xml_team :: InjuriesTeam,
+    _xml_teamno :: Maybe String, -- ^ Can contain non-numerics, e.g. \"ZR2\"
+    _xml_injuries :: String,
+    _xml_updated :: Maybe Bool }
   deriving (Eq, GHC.Generic, Show)
 
 
--- | For 'Generics.to_tuple'.
+-- | For 'H.convert'.
 --
-instance Generic InjuriesListingXml
+instance H.HVector InjuriesListingXml
 
 
 -- | Database representation of a 'InjuriesListing'. It possesses a
 --   foreign key to an 'Injuries' object so that we can easily delete
 --   'InjuriesListing's based on the parent message's time_stamp.
+--   The leading underscores prevent unused field warnings.
 --
 data InjuriesListing =
   InjuriesListing {
-    db_injuries_id :: DefaultKey Injuries,
-    db_team :: InjuriesTeam,
-    db_teamno :: Maybe String, -- ^ Can contain non-numerics, e.g. \"ZR2\"
-    db_injuries :: String,
-    db_updated :: Maybe Bool }
+    _db_injuries_id :: DefaultKey Injuries,
+    _db_team :: InjuriesTeam,
+    _db_teamno :: Maybe String, -- ^ Can contain non-numerics, e.g. \"ZR2\"
+    _db_injuries :: String,
+    _db_updated :: Maybe Bool }
+  deriving ( GHC.Generic )
+
+-- | For 'H.cons'.
+--
+instance H.HVector InjuriesListing
 
 instance ToDb InjuriesListingXml where
   -- | The DB analogue of a 'InjuriesListingXml' is a 'InjuriesListing'
@@ -139,13 +146,7 @@ instance Child InjuriesListingXml where
 instance FromXmlFk InjuriesListingXml where
   -- | To convert between a 'InjuriesListingXml' and a
   --   'InjuriesListing', we simply append the foreign key.
-  from_xml_fk fk InjuriesListingXml{..} =
-    InjuriesListing {
-      db_injuries_id = fk,
-      db_team = xml_team,
-      db_teamno = xml_teamno,
-      db_injuries = xml_injuries,
-      db_updated = xml_updated }
+  from_xml_fk = H.cons
 
 -- | This allows us to insert the XML representation
 --   'InjuriesListingXml' directly.
@@ -168,9 +169,9 @@ data Message =
   deriving (Eq, GHC.Generic, Show)
 
 
--- | For 'Generics.to_tuple'.
+-- | For 'H.HVector'.
 --
-instance Generic Message
+instance H.HVector Message
 
 
 -- | Database representation of a 'Message'.
@@ -239,11 +240,11 @@ mkPersist tsn_codegen_config [groundhog|
   constructors:
     - name: InjuriesListing
       fields:
-        - name: db_team
+        - name: _db_team
           embeddedType:
             - {name: team_name, dbName: team_name}
             - {name: team_league, dbName: team_league}
-        - name: db_injuries_id
+        - name: _db_injuries_id
           reference:
             onDelete: cascade
 
@@ -278,7 +279,7 @@ pickle_injuries_team =
 pickle_listing :: PU InjuriesListingXml
 pickle_listing =
   xpElem "listing" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, H.convert) $
     xp4Tuple pickle_injuries_team
              (xpOption $ xpElem "teamno" xpText)
              (xpElem "injuries" xpText)
@@ -293,7 +294,7 @@ pickle_listing =
 pickle_message :: PU Message
 pickle_message =
   xpElem "message" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, H.convert) $
     xp6Tuple (xpElem "XML_File_ID" xpInt)
              (xpElem "heading" xpText)
              (xpElem "category" xpText)