X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhtsn-import.git;a=blobdiff_plain;f=src%2FTSN%2FXML%2FScheduleChanges.hs;h=f1cb90725b85c2234901c43371b0a5b6136ea0c9;hp=4d7730d5d3efb2625bfb4d678aed33e90d5eb747;hb=ee416db7c942b78e0336202b7567cd0fda7ccda5;hpb=251287a26728178919ca1ce0f7b308df8bd00760
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)