From 12a8d95e873234893066e9422e0ce731e0e3e6ac Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Mon, 13 Jan 2014 18:59:38 -0500 Subject: [PATCH] Finish documenting TSN.XML.News and fix all compiler warnings therein. --- src/TSN/XML/News.hs | 139 ++++++++++++++++++++++++++++++++++---------- 1 file changed, 107 insertions(+), 32 deletions(-) diff --git a/src/TSN/XML/News.hs b/src/TSN/XML/News.hs index a388415..a630ef7 100644 --- a/src/TSN/XML/News.hs +++ b/src/TSN/XML/News.hs @@ -12,9 +12,16 @@ -- module TSN.XML.News ( news_tests, - pickle_message ) + pickle_message, + -- * WARNING: these are private but exported to silence warnings + News_NewsLocationConstructor(..), + News_NewsTeamConstructor(..), + NewsConstructor(..), + NewsLocationConstructor(..), + NewsTeamConstructor(..) ) where +-- System imports. import Data.Data ( Data, constrFields, dataTypeConstrs, dataTypeOf ) import Data.List.Utils ( join, split ) import Data.Tuple.Curry ( uncurryN ) @@ -42,6 +49,7 @@ import Text.XML.HXT.Core ( xpTriple, xpWrap ) +-- Local imports. import TSN.Codegen ( tsn_codegen_config, tsn_db_field_namer ) -- Used in a test @@ -52,26 +60,35 @@ import Xml ( FromXml(..), pickle_unpickle, unpickleable ) -- | The database type for teams as they show up in the news. +-- data NewsTeam = NewsTeam { team_name :: String } deriving (Eq, Show) +-- | This is needed to define the XmlImport instance for NewsTeam; it +-- basically says that the DB representation is the same as the XML +-- representation. +-- instance FromXml NewsTeam where type Db NewsTeam = NewsTeam from_xml = id +-- | Allow us to call 'insert_xml' on the XML representation of +-- NewsTeams. +-- instance XmlImport NewsTeam -- | Mapping between News records and NewsTeam records in the --- database. We name the fields (even though they're never used) for --- Groundhog's benefit. -data News_NewsTeam = - News_NewsTeam { - nnt_news_id :: DefaultKey News, - nnt_news_team_id :: DefaultKey NewsTeam } +-- database. +-- +data News_NewsTeam = News_NewsTeam + (DefaultKey News) + (DefaultKey NewsTeam) + -- | The database type for locations as they show up in the news. +-- data NewsLocation = NewsLocation { city :: Maybe String, @@ -79,26 +96,32 @@ data NewsLocation = country :: String } deriving (Eq, Show) +-- | This is needed to define the XmlImport instance for NewsLocation; it +-- basically says that the DB representation is the same as the XML +-- representation. +-- instance FromXml NewsLocation where type Db NewsLocation = NewsLocation from_xml = id +-- | Allow us to call 'insert_xml' on the XML representation of +-- NewsLocations. +-- instance XmlImport NewsLocation -- | Mapping between News records and NewsLocation records in the --- database. We name the fields (even though they're never used) for --- Groundhog's benefit. -data News_NewsLocation = - News_NewsLocation { - nnl_news_id :: DefaultKey News, - nnl_news_location_id :: DefaultKey NewsLocation } +-- database. +-- +data News_NewsLocation = News_NewsLocation + (DefaultKey News) + (DefaultKey NewsLocation) -- | The msg_id child of contains an event_id attribute; we -- embed it into the 'News' type. We (pointlessly) use the "db_" --- prefix here so that the two names collide on "id" when Groundhog --- is creating its fields using our field namer. +-- prefix here so that the two names don't collide on "id" when +-- Groundhog is creating its fields using our field namer. data MsgId = MsgId { db_msg_id :: Int, @@ -106,6 +129,8 @@ data MsgId = deriving (Data, Eq, Show, Typeable) +-- | The XML representation of a news item (message). +-- data Message = Message { xml_xml_file_id :: Int, @@ -123,6 +148,11 @@ data Message = xml_time_stamp :: String } deriving (Eq, Show) + +-- | The database representation of a news item. We drop several +-- uninteresting fields from 'Message', and omit the list fields which +-- will be represented as join tables. +-- data News = News { db_mid :: MsgId, @@ -134,16 +164,32 @@ data News = db_continue :: Maybe String } deriving (Data, Eq, Show, Typeable) + +-- | Convert the XML representation 'Message' to the database +-- representation 'News'. +-- instance FromXml Message where type Db Message = News - -- We don't need the key argument (from_xml_fk) since the XML type - -- contains more information in this case. - from_xml (Message _ _ c _ e f _ _ i j k l _) = - News c e f i j k l - + -- | We use a record wildcard so GHC doesn't complain that we never + -- used the field names. + -- + from_xml Message{..} = News { db_mid = xml_mid, + db_sport = xml_sport, + db_url = xml_url, + db_sms = xml_sms, + db_editor = xml_editor, + db_text = xml_text, + db_continue = xml_continue } + +-- | This lets us call 'insert_xml' on a 'Message'. +-- instance XmlImport Message +-- | Define 'dbmigrate' and 'dbimport' for 'Message's. The import is +-- slightly non-generic because of our 'News_NewsTeam' and +-- 'News_NewsLocation' join tables. +-- instance DbImport Message where dbmigrate _ = run_dbmigrate $ do @@ -176,9 +222,9 @@ instance DbImport Message where return ImportSucceeded --- These types don't have special XML representations or field name --- collisions so we use the defaultCodegenConfig and give their fields --- nice simple names. +-- | These types don't have special XML representations or field name +-- collisions so we use the defaultCodegenConfig and give their +-- fields nice simple names. mkPersist defaultCodegenConfig [groundhog| - entity: NewsTeam dbName: news_teams @@ -200,6 +246,10 @@ mkPersist defaultCodegenConfig [groundhog| |] + +-- | These types have fields with e.g. db_ and xml_ prefixes, so we +-- use our own codegen to peel those off before naming the columns. +-- mkPersist tsn_codegen_config [groundhog| - entity: News dbName: news @@ -220,11 +270,28 @@ mkPersist tsn_codegen_config [groundhog| - entity: News_NewsTeam dbName: news__news_teams + constructors: + - name: News_NewsTeam + fields: + - name: news_NewsTeam0 + dbName: news_id + - name: news_NewsTeam1 + dbName: news_teams_id - entity: News_NewsLocation dbName: news__news_locations + constructors: + - name: News_NewsLocation + fields: + - name: news_NewsLocation0 + dbName: news_id + - name: news_NewsLocation1 + dbName: news_locations_id |] + +-- | Convert a 'NewsTeam' to/from XML. +-- pickle_news_team :: PU NewsTeam pickle_news_team = xpElem "team" $ @@ -237,6 +304,8 @@ pickle_news_team = from_string = NewsTeam +-- | Convert a 'MsgId' to/from XML. +-- pickle_msg_id :: PU MsgId pickle_msg_id = xpElem "msg_id" $ @@ -247,6 +316,8 @@ pickle_msg_id = to_tuple m = (db_msg_id m, db_event_id m) +-- | Convert a 'NewsLocation' to/from XML. +-- pickle_location :: PU NewsLocation pickle_location = xpElem "location" $ @@ -260,7 +331,8 @@ pickle_location = to_tuple l = (city l, state l, country l) - +-- | Convert a 'Message' to/from XML. +-- pickle_message :: PU Message pickle_message = xpElem "message" $ @@ -280,20 +352,23 @@ pickle_message = (xpElem "time_stamp" xpText) where from_tuple = uncurryN Message - to_tuple m = (xml_xml_file_id m, - xml_heading m, - xml_mid m, - xml_category m, - xml_sport m, - xml_url m, - xml_teams m, - xml_locations m, + 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 \ elements into one 'String' + -- while unpickling and do the reverse while pickling. + -- pickle_continue :: PU (Maybe String) pickle_continue = xpOption $ -- 2.44.2