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

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

diff --git a/src/TSN/XML/News.hs b/src/TSN/XML/News.hs
index 021d49a..3828800 100644
--- a/src/TSN/XML/News.hs
+++ b/src/TSN/XML/News.hs
@@ -28,6 +28,7 @@ import Data.Time.Clock ( UTCTime )
 import Data.List.Utils ( join, split )
 import Data.Tuple.Curry ( uncurryN )
 import Data.Typeable ( Typeable )
+import qualified Data.Vector.HFixed as H ( HVector, convert )
 import Database.Groundhog (
   countAll,
   deleteAll,
@@ -67,7 +68,6 @@ import Text.XML.HXT.Core (
   xpWrap )
 
 -- Local imports.
-import Generics ( Generic(..), to_tuple )
 import TSN.Codegen (
   tsn_codegen_config,
   tsn_db_field_namer ) -- Used in a test
@@ -103,11 +103,17 @@ dtd = "newsxml.dtd"
 --   prefix here so that the two names don't collide on \"id\" when
 --   Groundhog is creating its fields using our field namer.
 --
+--   The leading underscores prevent unused field warnings.
+--
 data MsgId =
   MsgId {
-    db_msg_id       :: Int,
-    db_event_id     :: Maybe Int }
-  deriving (Data, Eq, Show, Typeable)
+    _db_msg_id       :: Int,
+    _db_event_id     :: Maybe Int }
+  deriving (Data, Eq, GHC.Generic, Show, Typeable)
+
+-- | For 'H.convert'.
+--
+instance H.HVector MsgId
 
 
 -- | The XML representation of a news item (\<message\>).
@@ -130,9 +136,9 @@ data Message =
   deriving (Eq, GHC.Generic, Show)
 
 
--- | For 'Generics.to_tuple'.
+-- | For 'H.convert'.
 --
-instance Generic Message
+instance H.HVector Message
 
 
 -- | The database representation of a news item. We drop several
@@ -165,6 +171,8 @@ instance FromXml Message where
   -- | We use a record wildcard so GHC doesn't complain that we never
   --   used the field names.
   --
+  --   To convert, we drop some fields.
+  --
   from_xml Message{..} = News { db_xml_file_id = xml_xml_file_id,
                                 db_mid = xml_mid,
                                 db_sport = xml_sport,
@@ -192,9 +200,9 @@ data NewsTeamXml =
   deriving (Eq, GHC.Generic, Show)
 
 
--- | For 'Generics.to_tuple'.
+-- | For 'H.convert'.
 --
-instance Generic NewsTeamXml
+instance H.HVector NewsTeamXml
 
 
 instance ToDb NewsTeamXml where
@@ -326,9 +334,9 @@ mkPersist tsn_codegen_config [groundhog|
 
 - embedded: MsgId
   fields:
-    - name: db_msg_id
+    - name: _db_msg_id
       dbName: msg_id
-    - name: db_event_id
+    - name: _db_event_id
       dbName: event_id
 
 - entity: News_Team
@@ -370,7 +378,7 @@ mkPersist tsn_codegen_config [groundhog|
 pickle_news_team :: PU NewsTeamXml
 pickle_news_team =
   xpElem "team" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, H.convert) $
       xpPair (xpAttr "id" xpText)
              xpText -- team name
   where
@@ -382,14 +390,11 @@ pickle_news_team =
 pickle_msg_id :: PU MsgId
 pickle_msg_id =
   xpElem "msg_id" $
-    xpWrap (from_tuple, to_tuple') $
+    xpWrap (from_tuple, H.convert) $
     xpPair xpInt (xpAttr "EventId" (xpOption xpInt))
   where
     from_tuple = uncurryN MsgId
 
-    -- Avoid unused field warnings.
-    to_tuple' m = (db_msg_id m, db_event_id m)
-
 
 
 -- | Convert a 'Message' to/from XML.
@@ -397,7 +402,7 @@ pickle_msg_id =
 pickle_message :: PU Message
 pickle_message =
   xpElem "message" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, H.convert) $
     xp13Tuple (xpElem "XML_File_ID" xpInt)
               (xpElem "heading" xpText)
               pickle_msg_id