-- System imports.
import Data.Data ( Data, constrFields, dataTypeConstrs, dataTypeOf )
+import Data.Time.Clock ( UTCTime )
import Data.List.Utils ( join, split )
import Data.Tuple.Curry ( uncurryN )
import Data.Typeable ( Typeable )
tsn_codegen_config,
tsn_db_field_namer ) -- Used in a test
import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
+import TSN.Picklers ( xp_time_stamp )
import TSN.XmlImport ( XmlImport(..) )
-import Xml ( FromXml(..), pickle_unpickle, unpickleable )
+import Xml ( FromXml(..), ToDb(..), 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 don't name the fields because we don't use the names
--- explicitly; that means we have to give them nice database names
--- via groundhog.
---
-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,
- state :: Maybe String,
- 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 don't name the fields because we don't use the names
--- explicitly; that means we have to give them nice database names
--- via groundhog.
+-- DB/XML Data types
--
-data News_NewsLocation = News_NewsLocation
- (DefaultKey News)
- (DefaultKey NewsLocation)
+-- * News/Message
-- | The msg_id child of <message> contains an event_id attribute; we
-- embed it into the 'News' type. We (pointlessly) use the "db_"
xml_editor :: Maybe String,
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 :: String }
+ xml_time_stamp :: UTCTime }
deriving (Eq, Show)
--
data News =
News {
+ db_xml_file_id :: Int,
db_mid :: MsgId,
db_sport :: String,
db_url :: Maybe String,
db_sms :: String,
db_editor :: Maybe String,
db_text :: Maybe String,
- db_continue :: Maybe String }
+ db_continue :: Maybe String,
+ db_time_stamp :: UTCTime }
deriving (Data, Eq, Show, Typeable)
+
+instance ToDb Message where
+ type Db Message = News
+
-- | Convert the XML representation 'Message' to the database
-- representation 'News'.
--
instance FromXml Message where
- type Db Message = News
-
-- | 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,
+ from_xml Message{..} = News { db_xml_file_id = xml_xml_file_id,
+ 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 }
+ db_continue = xml_continue,
+ db_time_stamp = xml_time_stamp }
-- | This lets us call 'insert_xml' on a 'Message'.
--
instance XmlImport Message
+
+-- * NewsTeam
+
+-- | The database type for teams as they show up in the news.
+--
+data NewsTeam =
+ NewsTeam { team_name :: String }
+ deriving (Eq, Show)
+
+
+instance ToDb NewsTeam where
+ -- | The database representaion of a 'NewsTeam' is itself.
+ type Db NewsTeam = NewsTeam
+
+-- | This is needed to define the XmlImport instance for NewsTeam.
+--
+instance FromXml NewsTeam where
+ -- | How to we get a 'NewsTeam' from itself?
+ from_xml = id
+
+-- | Allow us to call 'insert_xml' on the XML representation of
+-- NewsTeams.
+--
+instance XmlImport NewsTeam
+
+
+
+-- * News_NewsTeam
+
+-- | Mapping between News records and NewsTeam records in the
+-- database. We don't name the fields because we don't use the names
+-- explicitly; that means we have to give them nice database names
+-- via groundhog.
+--
+data News_NewsTeam = News_NewsTeam
+ (DefaultKey News)
+ (DefaultKey NewsTeam)
+
+
+-- * NewsLocation
+
+-- | The database type for locations as they show up in the news.
+--
+data NewsLocation =
+ NewsLocation {
+ city :: Maybe String,
+ state :: Maybe String,
+ country :: String }
+ deriving (Eq, Show)
+
+instance ToDb NewsLocation where
+ -- | The database representation of a 'NewsLocation' is itself.
+ type Db NewsLocation = NewsLocation
+
+-- | This is needed to define the XmlImport instance for NewsLocation.
+--
+instance FromXml NewsLocation where
+ -- | How to we get a 'NewsLocation' from itself?
+ from_xml = id
+
+-- | Allow us to call 'insert_xml' on the XML representation of
+-- NewsLocations.
+--
+instance XmlImport NewsLocation
+
+
+-- * News_NewsLocation
+
+-- | Mapping between News records and NewsLocation records in the
+-- database. We don't name the fields because we don't use the names
+-- explicitly; that means we have to give them nice database names
+-- via groundhog.
+--
+data News_NewsLocation = News_NewsLocation
+ (DefaultKey News)
+ (DefaultKey NewsLocation)
+
+
+
+--
+-- Database code
+--
+
-- | Define 'dbmigrate' and 'dbimport' for 'Message's. The import is
-- slightly non-generic because of our 'News_NewsTeam' and
-- 'News_NewsLocation' join tables.
dbName: news
constructors:
- name: News
+ uniques:
+ - name: unique_news
+ type: constraint
+ # Prevent multiple imports of the same message.
+ fields: [db_xml_file_id]
fields:
- name: db_mid
embeddedType:
- {name: msg_id, dbName: msg_id}
- {name: event_id, dbName: event_id}
+
- embedded: MsgId
fields:
- name: db_msg_id
- name: db_event_id
dbName: event_id
-
- entity: News_NewsTeam
dbName: news__news_teams
constructors:
fields:
- name: news_NewsTeam0 # Default created by mkNormalFieldName
dbName: news_id
+ reference:
+ onDelete: cascade
- name: news_NewsTeam1 # Default created by mkNormalFieldName
dbName: news_teams_id
+ reference:
+ onDelete: cascade
- entity: News_NewsLocation
dbName: news__news_locations
fields:
- name: news_NewsLocation0 # Default created by mkNormalFieldName
dbName: news_id
+ reference:
+ onDelete: cascade
- name: news_NewsLocation1 # Default created by mkNormalFieldName
dbName: news_locations_id
+ reference:
+ onDelete: cascade
|]
+--
+-- XML Picklers
+--
-- | Convert a 'NewsTeam' to/from XML.
--
(xpOption (xpElem "Editor" xpText))
(xpOption (xpElem "text" xpText))
pickle_continue
- (xpElem "time_stamp" xpText)
+ (xpElem "time_stamp" xp_time_stamp)
where
from_tuple = uncurryN Message
to_tuple m = (xml_xml_file_id m, -- Verbose,
projects / dead / htsn-import.git / blobdiff