+{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
import Database.Groundhog.TH (
groundhog,
mkPersist )
+import qualified GHC.Generics as GHC ( Generic )
import Test.Tasty ( TestTree, testGroup )
import Test.Tasty.HUnit ( (@?=), testCase )
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
xml_text :: Maybe String, -- Text and continue seem to show up in pairs,
xml_continue :: Maybe String, -- either both present or both missing.
xml_time_stamp :: UTCTime }
- deriving (Eq, Show)
+ deriving (Eq, GHC.Generic, Show)
+
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic Message
-- | The database representation of a news item. We drop several
data NewsTeamXml =
NewsTeamXml { xml_team_id :: String,
xml_team_name :: String }
- deriving (Eq, Show)
+ deriving (Eq, GHC.Generic, Show)
+
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic NewsTeamXml
+
instance ToDb NewsTeamXml where
-- | The database representation of 'NewsTeamXml' is 'Team'.
pickle_news_team :: PU NewsTeamXml
pickle_news_team =
xpElem "team" $
- xpWrap (from_pair, to_pair) $
+ xpWrap (from_tuple, to_tuple) $
xpPair (xpAttr "id" xpText)
xpText -- team name
where
- from_pair :: (String, String) -> NewsTeamXml
- from_pair = uncurry NewsTeamXml
-
- to_pair :: NewsTeamXml -> (String, String)
- to_pair (NewsTeamXml x y) = (x,y)
+ from_tuple = uncurry NewsTeamXml
-- | Convert a 'MsgId' to/from XML.
pickle_msg_id :: PU MsgId
pickle_msg_id =
xpElem "msg_id" $
- xpWrap (from_tuple, to_tuple) $
+ xpWrap (from_tuple, to_tuple') $
xpPair xpInt (xpAttr "EventId" (xpOption xpInt))
where
from_tuple = uncurryN MsgId
- to_tuple m = (db_msg_id m, db_event_id m)
+
+ -- Avoid unused field warnings.
+ to_tuple' m = (db_msg_id m, db_event_id m)
(xpElem "time_stamp" xp_time_stamp)
where
from_tuple = uncurryN Message
- to_tuple m = (xml_xml_file_id m, -- Verbose,
- xml_heading m, -- but
- xml_mid m, -- eliminates
- xml_category m, -- GHC
- xml_sport m, -- warnings
- xml_url m, -- .
- xml_teams m, -- .
- xml_locations m, -- .
- xml_sms m,
- xml_editor m,
- xml_text m,
- xml_continue m,
- xml_time_stamp m)
+
-- | We combine all of the \<continue\> elements into one 'String'
-- while unpickling and do the reverse while pickling.