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

[dead/htsn-import.git] / src / TSN / XML / JFile.hs

diff --git a/src/TSN/XML/JFile.hs b/src/TSN/XML/JFile.hs
index 84e6b66ebd642e148241a7d5acc042bb66dfa880..d434220a6ee8788e1b3c4a49249c8587b2e463c9 100644 (file)
--- a/src/TSN/XML/JFile.hs
+++ b/src/TSN/XML/JFile.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE QuasiQuotes #-}
@@ -27,6 +28,7 @@ import Data.List ( intercalate )
 import Data.String.Utils ( split )
 import Data.Time ( UTCTime(..) )
 import Data.Tuple.Curry ( uncurryN )
+import qualified Data.Vector.HFixed as H ( HVector, convert )
 import Database.Groundhog (
   countAll,
   deleteAll,
@@ -39,6 +41,7 @@ import Database.Groundhog.Sqlite ( withSqliteConn )
 import Database.Groundhog.TH (
   groundhog,
   mkPersist )
+import qualified GHC.Generics as GHC ( Generic )
 import Test.Tasty ( TestTree, testGroup )
 import Test.Tasty.HUnit ( (@?=), testCase )
 import Text.XML.HXT.Core (
@@ -121,7 +124,12 @@ data Message =
     xml_sport :: String,
     xml_gamelist :: JFileGameListXml,
     xml_time_stamp :: UTCTime }
-  deriving (Eq, Show)
+  deriving (Eq, GHC.Generic, Show)
+
+
+-- | For 'H.convert'.
+--
+instance H.HVector Message
 
 
 instance ToDb Message where
@@ -199,6 +207,7 @@ data JFileGameStatus =
   deriving (Eq, Show)
 
 
+
 -- | Database representation of a \<game\> contained within a
 --   \<message\>, and, implicitly, a \<gamelist\>.
 --
@@ -245,7 +254,12 @@ data JFileGameXml =
     xml_hscore :: Int,
     xml_time_remaining :: Maybe String,
     xml_game_status :: JFileGameStatus }
-  deriving (Eq, Show)
+  deriving (Eq, GHC.Generic, Show)
+
+
+-- | For 'H.convert'.
+--
+instance H.HVector JFileGameXml
 
 
 -- * JFileGameListXml
@@ -421,7 +435,7 @@ mkPersist tsn_codegen_config [groundhog|
 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)
@@ -430,12 +444,7 @@ pickle_message =
              (xpElem "time_stamp" xp_time_stamp)
   where
     from_tuple = uncurryN Message
-    to_tuple m = (xml_xml_file_id m,
-                  xml_heading m,
-                  xml_category m,
-                  xml_sport m,
-                  xml_gamelist m,
-                  xml_time_stamp m)
+
 
 pickle_gamelist :: PU JFileGameListXml
 pickle_gamelist =
@@ -451,7 +460,7 @@ pickle_gamelist =
 pickle_game :: PU JFileGameXml
 pickle_game =
   xpElem "game" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, H.convert) $
     xp14Tuple (xpElem "game_id" xpInt)
               (xpElem "schedule_id" xpInt)
               pickle_odds_info
@@ -468,25 +477,12 @@ pickle_game =
               pickle_status
   where
     from_tuple = uncurryN JFileGameXml
-    to_tuple m = (xml_game_id m,
-                  xml_schedule_id m,
-                  xml_odds_info m,
-                  xml_season_type m,
-                  xml_game_date m,
-                  xml_game_time m,
-                  xml_vteam m,
-                  xml_vleague m,
-                  xml_hteam m,
-                  xml_hleague m,
-                  xml_vscore m,
-                  xml_hscore m,
-                  xml_time_remaining m,
-                  xml_game_status m)
+
 
 pickle_odds_info :: PU JFileGameOddsInfo
 pickle_odds_info =
   xpElem "Odds_Info" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, to_tuple') $
     xp19Tuple (xpElem "ListDate" (xpOption xp_date))
               (xpElem "HomeTeamID" (xpOption xpText))
               (xpElem "AwayTeamID" (xpOption xpText))
@@ -512,21 +508,21 @@ pickle_odds_info =
       where
         notes = intercalate "\n" [n1,n2,n3,n4,n5]
 
-    to_tuple o = (db_list_date o,
-                  db_info_home_team_id o,
-                  db_info_away_team_id o,
-                  db_home_abbr o,
-                  db_away_abbr o,
-                  db_home_team_name o,
-                  db_away_team_name o,
-                  db_home_starter o,
-                  db_away_starter o,
-                  db_game_date o,
-                  db_home_game_key o,
-                  db_away_game_key o,
-                  db_current_timestamp o,
-                  db_live o,
-                  n1,n2,n3,n4,n5)
+    to_tuple' o = (db_list_date o,
+                   db_info_home_team_id o,
+                   db_info_away_team_id o,
+                   db_home_abbr o,
+                   db_away_abbr o,
+                   db_home_team_name o,
+                   db_away_team_name o,
+                   db_home_starter o,
+                   db_away_starter o,
+                   db_game_date o,
+                   db_home_game_key o,
+                   db_away_game_key o,
+                   db_current_timestamp o,
+                   db_live o,
+                   n1,n2,n3,n4,n5)
       where
         note_lines = split "\n" (db_notes o)
         n1 = case note_lines of
@@ -551,15 +547,13 @@ pickle_odds_info =
 pickle_home_team :: PU HTeam
 pickle_home_team =
   xpElem "hteam" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, to_tuple') $
     xpTriple (xpAttr "teamid" xpText) -- Yeah, they're text.
              (xpAttr "abbr" (xpOption xpText)) -- Some are blank
              (xpOption xpText) -- Yup, some are nameless
   where
     from_tuple = HTeam . (uncurryN Team)
-    to_tuple (HTeam t) = (team_id t,
-                          abbreviation t,
-                          name t)
+    to_tuple' (HTeam t) = H.convert t
 
 
 -- | (Un)pickle an away team to/from the dual XML/DB representation
@@ -568,28 +562,26 @@ pickle_home_team =
 pickle_away_team :: PU VTeam
 pickle_away_team =
   xpElem "vteam" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, to_tuple') $
     xpTriple (xpAttr "teamid" xpText) -- Yeah, they're text.
              (xpAttr "abbr" (xpOption xpText)) -- Some are blank
              (xpOption xpText) -- Yup, some are nameless
   where
     from_tuple = VTeam . (uncurryN Team)
-    to_tuple (VTeam t) = (team_id t,
-                          abbreviation t,
-                          name t)
+    to_tuple' (VTeam t) = H.convert t
 
 
 pickle_status :: PU JFileGameStatus
 pickle_status =
   xpElem "status" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, to_tuple') $
     xpPair (xpAttr "numeral" xpInt)
            (xpOption xpText)
   where
     from_tuple = uncurry JFileGameStatus
-    to_tuple s = (db_status_numeral s,
-                  db_status s)
 
+    -- Avoid unused field warnings.
+    to_tuple' JFileGameStatus{..} = (db_status_numeral, db_status)
 
 
 --