From: Michael Orlitzky Date: Fri, 2 Jan 2015 22:23:22 +0000 (-0500) Subject: Migrate TSN.XML.ScheduleChanges to fixed-vector-hetero. X-Git-Tag: 0.2.1~14 X-Git-Url: https://gitweb.michael.orlitzky.com/?a=commitdiff_plain;h=ee416db7c942b78e0336202b7567cd0fda7ccda5;p=dead%2Fhtsn-import.git Migrate TSN.XML.ScheduleChanges to fixed-vector-hetero. --- diff --git a/src/TSN/XML/ScheduleChanges.hs b/src/TSN/XML/ScheduleChanges.hs index 4d7730d..f1cb907 100644 --- a/src/TSN/XML/ScheduleChanges.hs +++ b/src/TSN/XML/ScheduleChanges.hs @@ -26,6 +26,7 @@ where import Control.Monad ( forM_ ) import Data.Time ( UTCTime(..) ) import Data.Tuple.Curry ( uncurryN ) +import qualified Data.Vector.HFixed as H ( HVector, convert ) import Database.Groundhog ( countAll, deleteAll, @@ -56,7 +57,6 @@ import Text.XML.HXT.Core ( xpWrap ) -- Local imports. -import Generics ( Generic(..), to_tuple ) import TSN.Codegen ( tsn_codegen_config ) import TSN.Database ( insert_or_select ) import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate ) @@ -110,9 +110,9 @@ data ScheduleChangeXml = deriving (Eq, GHC.Generic, Show) --- | For 'Generics.to_tuple'. +-- | For 'H.convert'. -- -instance Generic ScheduleChangeXml +instance H.HVector ScheduleChangeXml -- | XML representation of a 'ScheduleChanges'. It has the same @@ -129,9 +129,9 @@ data Message = deriving (Eq, GHC.Generic, Show) --- | For 'Generics.to_tuple'. +-- | For 'H.convert'. -- -instance Generic Message +instance H.HVector Message instance ToDb Message where @@ -169,13 +169,19 @@ instance XmlImport Message -- like, \FINAL\ within the XML, -- but they're in one-to-one correspondence with the listings. -- +-- The leading underscores prevent unused field warnings. +-- data ScheduleChangesListingStatus = ScheduleChangesListingStatus { - db_status_numeral :: Int, - db_status :: Maybe String } -- Yes, they can be empty. - deriving (Eq, Show) + _db_status_numeral :: Int, + _db_status :: Maybe String } -- Yes, they can be empty. + deriving (Eq, GHC.Generic, Show) +-- | For 'H.convert'. +-- +instance H.HVector ScheduleChangesListingStatus + -- | Database representation of a \ contained within a -- \, within a \. During the transition @@ -222,9 +228,9 @@ data ScheduleChangesListingXml = deriving (Eq, GHC.Generic, Show) --- | For 'Generics.to_tuple'. +-- | For 'H.convert'. -- -instance Generic ScheduleChangesListingXml +instance H.HVector ScheduleChangesListingXml instance ToDb ScheduleChangesListingXml where @@ -345,9 +351,9 @@ mkPersist tsn_codegen_config [groundhog| - embedded: ScheduleChangesListingStatus fields: - - name: db_status_numeral + - name: _db_status_numeral dbName: status_numeral - - name: db_status + - name: _db_status dbName: status |] @@ -389,22 +395,19 @@ pickle_home_team = pickle_status :: PU ScheduleChangesListingStatus pickle_status = xpElem "status" $ - xpWrap (from_tuple, to_tuple') $ + xpWrap (from_tuple, H.convert) $ xpPair (xpAttr "numeral" xpInt) (xpOption xpText) where from_tuple = uncurry ScheduleChangesListingStatus - -- Avouid unused field warnings. - to_tuple' ScheduleChangesListingStatus{..} = - (db_status_numeral, db_status) -- | An (un)pickler for the \ elements. -- pickle_listing :: PU ScheduleChangesListingXml pickle_listing = xpElem "SC_Listing" $ - xpWrap (from_tuple, to_tuple) $ + xpWrap (from_tuple, H.convert) $ xp11Tuple (xpAttr "type" xpText) (xpElem "Schedule_ID" xpInt) (xpElem "Game_Date" xp_date_padded) @@ -425,7 +428,7 @@ pickle_listing = pickle_schedule_change :: PU ScheduleChangeXml pickle_schedule_change = xpElem "Schedule_Change" $ - xpWrap (from_tuple, to_tuple) $ + xpWrap (from_tuple, H.convert) $ xpPair (xpAttr "Sport" xpText) (xpList pickle_listing) where @@ -437,7 +440,7 @@ pickle_schedule_change = 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)