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

diff --git a/src/TSN/XML/InjuriesDetail.hs b/src/TSN/XML/InjuriesDetail.hs
index 90fb0cdb894a523ebbb342bf3ebc59620e1b228b..4dda8442eca62840a55cc3ed14e51265f6eb48e2 100644 (file)
--- a/src/TSN/XML/InjuriesDetail.hs
+++ b/src/TSN/XML/InjuriesDetail.hs
@@ -27,6 +27,8 @@ where
 import Control.Monad ( forM_ )
 import Data.Time ( UTCTime )
 import Data.Tuple.Curry ( uncurryN )
 import Control.Monad ( forM_ )
 import Data.Time ( UTCTime )
 import Data.Tuple.Curry ( uncurryN )

+import qualified Data.Vector.HFixed as H ( HVector, cons, convert, tail )
+import qualified Data.Vector.HFixed.Cont as H (ContVec)

 import Database.Groundhog (
   DefaultKey,
   countAll,
 import Database.Groundhog (
   DefaultKey,
   countAll,


@@ -56,7 +58,6 @@ import Text.XML.HXT.Core (
   xpWrap )
 
 -- Local imports.
   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_date, xp_time_stamp )
 import TSN.Codegen ( tsn_codegen_config )
 import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
 import TSN.Picklers( xp_date, xp_time_stamp )


@@ -100,9 +101,9 @@ data Message =
   deriving (Eq, GHC.Generic, Show)
 
 
   deriving (Eq, GHC.Generic, Show)
 
 

--- | For 'Generics.to_tuple'.
+-- | For 'H.convert'.

 --
 --

-instance Generic Message
+instance H.HVector Message

 
 
 -- | Database representation of a 'Message'.
 
 
 -- | Database representation of a 'Message'.


@@ -166,9 +167,9 @@ data InjuriesDetailListingXml =
   deriving (Eq, GHC.Generic, Show)
 
 
   deriving (Eq, GHC.Generic, Show)
 
 

--- | For 'Generics.to_tuple'.
+-- | For 'H.convert'.

 --
 --

-instance Generic InjuriesDetailListingXml
+instance H.HVector InjuriesDetailListingXml

 
 
 instance ToDb InjuriesDetailListingXml where
 
 
 instance ToDb InjuriesDetailListingXml where


@@ -203,11 +204,12 @@ instance XmlImportFk InjuriesDetailListingXml
 -- * InjuriesDetailListingPlayerListing
 
 -- | XML representation of a \<PlayerListing\>, the main type of
 -- * InjuriesDetailListingPlayerListing
 
 -- | XML representation of a \<PlayerListing\>, the main type of

---   element contains in Injuries_Detail_XML messages.
+--   element contains in Injuries_Detail_XML messages. The leading
+--   underscores prevent unused field warnings.

 --
 data InjuriesDetailListingPlayerListingXml =
   InjuriesDetailListingPlayerListingXml {
 --
 data InjuriesDetailListingPlayerListingXml =
   InjuriesDetailListingPlayerListingXml {

-    xml_player_team_id :: String, -- ^ TeamIDs are (apparently) three
+    _xml_player_team_id :: String, -- ^ TeamIDs are (apparently) three

                                   --   characters long and not
                                   --   necessarily numeric. Postgres
                                   --   imposes no performance penalty
                                   --   characters long and not
                                   --   necessarily numeric. Postgres
                                   --   imposes no performance penalty


@@ -216,39 +218,45 @@ data InjuriesDetailListingPlayerListingXml =
                                   --   bound of three characters.
                                   --   We add the \"player\" to avoid conflict
                                   --   with 'InjuriesDetailListingXml'.
                                   --   bound of three characters.
                                   --   We add the \"player\" to avoid conflict
                                   --   with 'InjuriesDetailListingXml'.

-    xml_player_id :: Int,
-    xml_date      :: UTCTime,
-    xml_pos       :: String,
-    xml_name      :: String,
-    xml_injury    :: String,
-    xml_status    :: String,
-    xml_fantasy   :: Maybe String, -- ^ Nobody knows what this is.
-    xml_injured     :: Bool,
-    xml_type :: String }
+    _xml_player_id :: Int,
+    _xml_date      :: UTCTime,
+    _xml_pos       :: String,
+    _xml_name      :: String,
+    _xml_injury    :: String,
+    _xml_status    :: String,
+    _xml_fantasy   :: Maybe String, -- ^ Nobody knows what this is.
+    _xml_injured     :: Bool,
+    _xml_type :: String }

   deriving (Eq, GHC.Generic, Show)
 
 
   deriving (Eq, GHC.Generic, Show)
 
 

--- | For 'Generics.to_tuple'.
+-- | For 'H.convert'.

 --
 --

-instance Generic InjuriesDetailListingPlayerListingXml
+instance H.HVector InjuriesDetailListingPlayerListingXml

 
 
 -- | Database representation of a
 --   'InjuriesDetailListingPlayerListingXml'. We drop the team_id
 
 
 -- | Database representation of a
 --   'InjuriesDetailListingPlayerListingXml'. We drop the team_id

---   because it's redundant.
+--   because it's redundant. The leading underscores prevent unused
+--   field warnings.

 --
 data InjuriesDetailListingPlayerListing =
   InjuriesDetailListingPlayerListing {
 --
 data InjuriesDetailListingPlayerListing =
   InjuriesDetailListingPlayerListing {

-    db_injuries_detail_listings_id :: DefaultKey InjuriesDetailListing,
-    db_player_id :: Int,
-    db_date      :: UTCTime,
-    db_pos       :: String,
-    db_name      :: String,
-    db_injury    :: String,
-    db_status    :: String,
-    db_fantasy   :: Maybe String, -- ^ Nobody knows what this is.
-    db_injured     :: Bool,
-    db_type :: String }
+    _db_injuries_detail_listings_id :: DefaultKey InjuriesDetailListing,
+    _db_player_id :: Int,
+    _db_date      :: UTCTime,
+    _db_pos       :: String,
+    _db_name      :: String,
+    _db_injury    :: String,
+    _db_status    :: String,
+    _db_fantasy   :: Maybe String, -- ^ Nobody knows what this is.
+    _db_injured     :: Bool,
+    _db_type :: String }
+  deriving ( GHC.Generic )
+
+-- | For 'H.cons', 'H.tail', etc.
+--
+instance H.HVector InjuriesDetailListingPlayerListing

 
 
 instance ToDb InjuriesDetailListingPlayerListingXml where
 
 
 instance ToDb InjuriesDetailListingPlayerListingXml where


@@ -270,18 +278,12 @@ instance FromXmlFk InjuriesDetailListingPlayerListingXml where
   --   'InjuriesDetailListingPlayerListingXml' we need to supply a
   --   foreign key to an 'InjuriesDetailListing'.
   --
   --   'InjuriesDetailListingPlayerListingXml' we need to supply a
   --   foreign key to an 'InjuriesDetailListing'.
   --

-  from_xml_fk fk InjuriesDetailListingPlayerListingXml{..} =
-    InjuriesDetailListingPlayerListing {
-      db_injuries_detail_listings_id = fk,
-      db_player_id = xml_player_id,
-      db_date = xml_date,
-      db_pos = xml_pos,
-      db_name = xml_name,
-      db_injury = xml_injury,
-      db_status = xml_status,
-      db_fantasy = xml_fantasy,
-      db_injured = xml_injured,
-      db_type = xml_type }
+  from_xml_fk fk = (H.cons fk) . asCont . H.tail
+    where
+      -- Should be in the library soon.
+      asCont :: H.ContVec a -> H.ContVec a
+      asCont = id
+

 
 -- | This lets us insert the XML representation
 --   'InjuriesDetailListingPlayerListingXml' directly.
 
 -- | This lets us insert the XML representation
 --   'InjuriesDetailListingPlayerListingXml' directly.


@@ -339,7 +341,7 @@ mkPersist tsn_codegen_config [groundhog|
   constructors:
     - name: InjuriesDetailListingPlayerListing
       fields:
   constructors:
     - name: InjuriesDetailListingPlayerListing
       fields:

-        - name: db_injuries_detail_listings_id
+        - name: _db_injuries_detail_listings_id

           reference:
             onDelete: cascade
 |]
           reference:
             onDelete: cascade
 |]


@@ -355,7 +357,7 @@ mkPersist tsn_codegen_config [groundhog|
 pickle_player_listing :: PU InjuriesDetailListingPlayerListingXml
 pickle_player_listing =
   xpElem "PlayerListing" $
 pickle_player_listing :: PU InjuriesDetailListingPlayerListingXml
 pickle_player_listing =
   xpElem "PlayerListing" $

-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, H.convert) $

     xp10Tuple (xpElem "TeamID" xpText)
               (xpElem "PlayerID" xpInt)
               (xpElem "Date" xp_date)
     xp10Tuple (xpElem "TeamID" xpText)
               (xpElem "PlayerID" xpInt)
               (xpElem "Date" xp_date)


@@ -375,7 +377,7 @@ pickle_player_listing =
 pickle_listing :: PU InjuriesDetailListingXml
 pickle_listing =
   xpElem "Listing" $
 pickle_listing :: PU InjuriesDetailListingXml
 pickle_listing =
   xpElem "Listing" $

-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, H.convert) $

     xpTriple (xpElem "TeamID" xpText)
              (xpElem "FullName" xpText)
              (xpList pickle_player_listing)
     xpTriple (xpElem "TeamID" xpText)
              (xpElem "FullName" xpText)
              (xpList pickle_player_listing)


@@ -388,7 +390,7 @@ pickle_listing =
 pickle_message :: PU Message
 pickle_message =
   xpElem "message" $
 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)
     xp6Tuple (xpElem "XML_File_ID" xpInt)
              (xpElem "heading" xpText)
              (xpElem "category" xpText)