From 0565f201345151c25b241587115a0d400da7d54f Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Fri, 2 Jan 2015 17:22:20 -0500 Subject: [PATCH] Migrate TSN.XML.News to fixed-vector-hetero. --- src/TSN/XML/News.hs | 37 +++++++++++++++++++++---------------- 1 file changed, 21 insertions(+), 16 deletions(-) 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 (\). @@ -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 -- 2.43.2