import Data.Time ( UTCTime(..) )
import Data.Tuple.Curry ( uncurryN )
import Data.Typeable ( Typeable )
+import qualified Data.Vector.HFixed as H ( HVector, cons, convert )
import Database.Groundhog (
countAll,
deleteAll,
xpWrap )
-- Local imports.
-import Generics ( Generic(..), prepend, to_tuple )
import TSN.Codegen ( tsn_codegen_config )
import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
import TSN.Picklers (
xml_time_stamp :: UTCTime }
deriving (Eq, GHC.Generic, Show)
--- | For 'Generics.to_tuple'.
+-- | For 'H.convert'.
--
-instance Generic Message
+instance H.HVector Message
instance ToDb Message where
-- * AutoRacingResultsListing/AutoRacingResultsListingXml
-- | Database representation of a \<Listing\> contained within a
--- \<message\>.
+-- \<message\>. The leading underscores prevent unused field
+-- warnings.
--
data AutoRacingResultsListing =
AutoRacingResultsListing {
- db_auto_racing_results_id :: DefaultKey AutoRacingResults,
- db_finish_position :: Int,
- db_starting_position :: Int,
- db_car_number :: Int,
- db_driver_id :: Int,
- db_driver :: String,
- db_car_make :: String,
- db_points :: Int,
- db_laps_completed :: Int,
- db_laps_leading :: Int,
- db_status :: Maybe String,
- db_dnf :: Maybe Bool,
- db_nc :: Maybe Bool,
- db_earnings :: Maybe Int }
+ _db_auto_racing_results_id :: DefaultKey AutoRacingResults,
+ _db_finish_position :: Int,
+ _db_starting_position :: Int,
+ _db_car_number :: Int,
+ _db_driver_id :: Int,
+ _db_driver :: String,
+ _db_car_make :: String,
+ _db_points :: Int,
+ _db_laps_completed :: Int,
+ _db_laps_leading :: Int,
+ _db_status :: Maybe String,
+ _db_dnf :: Maybe Bool,
+ _db_nc :: Maybe Bool,
+ _db_earnings :: Maybe Int }
deriving ( GHC.Generic )
--- | For 'Generics.prepend'.
+-- | For 'H.convert' and 'H.cons'.
--
-instance Generic AutoRacingResultsListing
+instance H.HVector AutoRacingResultsListing
-- | XML representation of a \<Listing\> contained within a
--- \<message\>.
+-- \<message\>. The leading underscores prevent unused field
+-- warnings.
--
data AutoRacingResultsListingXml =
AutoRacingResultsListingXml {
- xml_finish_position :: Int,
- xml_starting_position :: Int,
- xml_car_number :: Int,
- xml_driver_id :: Int,
- xml_driver :: String,
- xml_car_make :: String,
- xml_points :: Int,
- xml_laps_completed :: Int,
- xml_laps_leading :: Int,
- xml_status :: Maybe String,
- xml_dnf :: Maybe Bool,
- xml_nc :: Maybe Bool,
- xml_earnings :: Maybe Int }
+ _xml_finish_position :: Int,
+ _xml_starting_position :: Int,
+ _xml_car_number :: Int,
+ _xml_driver_id :: Int,
+ _xml_driver :: String,
+ _xml_car_make :: String,
+ _xml_points :: Int,
+ _xml_laps_completed :: Int,
+ _xml_laps_leading :: Int,
+ _xml_status :: Maybe String,
+ _xml_dnf :: Maybe Bool,
+ _xml_nc :: Maybe Bool,
+ _xml_earnings :: Maybe Int }
deriving (Eq, GHC.Generic, Show)
--- | For 'Generics.to_tuple'.
+-- | For 'H.convert'.
--
-instance Generic AutoRacingResultsListingXml
+instance H.HVector AutoRacingResultsListingXml
instance ToDb AutoRacingResultsListingXml where
-- | The database analogue of an 'AutoRacingResultsListingXml' is
-- 'AutoRacingResultsListing', we add the foreign key and copy
-- everything else verbatim.
--
- from_xml_fk = prepend
+ from_xml_fk = H.cons
-- | This allows us to insert the XML representation
constructors:
- name: AutoRacingResultsListing
fields:
- - name: db_auto_racing_results_id
+ - name: _db_auto_racing_results_id
reference:
onDelete: cascade
pickle_listing :: PU AutoRacingResultsListingXml
pickle_listing =
xpElem "Listing" $
- xpWrap (from_tuple, to_tuple) $
+ xpWrap (from_tuple, H.convert) $
xp13Tuple (xpElem "FinishPosition" xpInt)
(xpElem "StartingPosition" xpInt)
(xpElem "CarNumber" xpInt)
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)
(xpElem "category" xpText)