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,
xpWrap )
-- Local imports.
-import Generics ( Generic(..), to_tuple )
import TSN.Codegen (
tsn_codegen_config,
tsn_db_field_namer ) -- Used in a test
-- 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\>).
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
-- | 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,
deriving (Eq, GHC.Generic, Show)
--- | For 'Generics.to_tuple'.
+-- | For 'H.convert'.
--
-instance Generic NewsTeamXml
+instance H.HVector NewsTeamXml
instance ToDb NewsTeamXml where
- 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
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
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.
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