1 {-# LANGUAGE FlexibleInstances #-}
3 {-# LANGUAGE QuasiQuotes #-}
4 {-# LANGUAGE RecordWildCards #-}
5 {-# LANGUAGE TemplateHaskell #-}
6 {-# LANGUAGE TypeFamilies #-}
8 module TSN.XML.EarlyLine (
11 -- * WARNING: these are private but exported to silence warnings
12 EarlyLineConstructor(..),
13 EarlyLineGameConstructor(..) )
17 import Data.Time ( UTCTime(..) )
18 import Data.Tuple.Curry ( uncurryN )
19 import Database.Groundhog.Core ( DefaultKey )
20 import Database.Groundhog.TH (
23 import Text.XML.HXT.Core (
37 import TSN.Codegen ( tsn_codegen_config )
38 import TSN.DbImport ( DbImport(..) )
43 import TSN.XmlImport ( XmlImport(..) )
49 -- | The DTD to which this module corresponds. Used to invoke dbimport.
52 dtd = "earlylineXML.dtd"
58 -- * EarlyLine/Message
60 -- | Database representation of a 'Message'. It lacks the \<date\>
61 -- elements since they're really properties of the games that they
66 db_xml_file_id :: Int,
68 db_category :: String,
71 db_time_stamp :: UTCTime }
76 -- | XML Representation of an 'EarlyLine'. It has the same
77 -- fields, but in addition contains the 'xml_dates'.
81 xml_xml_file_id :: Int,
82 xml_heading :: String,
83 xml_category :: String,
86 xml_dates :: [EarlyLineDateXml],
87 xml_time_stamp :: UTCTime }
91 instance ToDb Message where
92 -- | The database analogue of a 'Message' is an 'EarlyLine'.
94 type Db Message = EarlyLine
97 -- | The 'FromXml' instance for 'Message' is required for the
98 -- 'XmlImport' instance.
100 instance FromXml Message where
101 -- | To convert a 'Message' to an 'EarlyLine', we just drop
104 from_xml Message{..} =
106 db_xml_file_id = xml_xml_file_id,
107 db_heading = xml_heading,
108 db_category = xml_category,
109 db_sport = xml_sport,
110 db_title = xml_title,
111 db_time_stamp = xml_time_stamp }
114 -- | This allows us to insert the XML representation 'Message'
117 instance XmlImport Message
121 -- * EarlyLineDateXml
123 -- | XML representation of a \<date\>. It has a \"value\" attribute
124 -- containing the actual date string. As children it contains a
125 -- (non-optional) note, and a game. The note and date value are
126 -- properties of the game as far as I can tell.
128 data EarlyLineDateXml =
130 xml_date_value :: UTCTime,
132 xml_game :: EarlyLineGameXml }
137 -- * EarlyLineGame / EarlyLineGameXml
141 db_early_lines_id :: DefaultKey EarlyLine,
142 db_game_time :: UTCTime, -- ^ Combined date/time
143 db_note :: String, -- ^ Taken from the parent \<date\>
144 db_away_team :: EarlyLineGameTeam,
145 db_home_team :: EarlyLineGameTeam,
146 db_over_under :: String }
148 data EarlyLineGameXml =
150 xml_game_time :: UTCTime, -- ^ Only an ambiguous time string, e.g. \"8:30\"
151 xml_away_team :: EarlyLineGameTeam,
152 xml_home_team :: EarlyLineGameTeam,
153 xml_over_under :: String }
157 -- | XML representation of an earlyline team. It doubles as an
158 -- embedded type within the DB representation 'EarlyLineGame'.
160 data EarlyLineGameTeam =
162 db_rotation_number :: Int,
163 db_line :: Maybe String, -- ^ Can be blank, a Double, or \"off\".
164 db_team_name :: String }
172 instance DbImport Message where
173 dbmigrate = undefined
177 mkPersist tsn_codegen_config [groundhog|
184 - name: unique_early_lines
186 # Prevent multiple imports of the same message.
187 fields: [db_xml_file_id]
190 - entity: EarlyLineGame
191 dbName: early_lines_games
193 - name: EarlyLineGame
195 - name: db_early_lines_id
200 - {name: rotation_number, dbName: away_team_rotation_number}
201 - {name: line, dbName: away_team_line}
202 - {name: team_name, dbName: away_team_name}
205 - {name: rotation_number, dbName: home_team_rotation_number}
206 - {name: line, dbName: home_team_line}
207 - {name: team_name, dbName: home_team_name}
209 - embedded: EarlyLineGameTeam
211 - name: db_rotation_number
212 dbName: rotation_number
225 pickle_message :: PU Message
228 xpWrap (from_tuple, to_tuple) $
229 xp7Tuple (xpElem "XML_File_ID" xpInt)
230 (xpElem "heading" xpText)
231 (xpElem "category" xpText)
232 (xpElem "sport" xpText)
233 (xpElem "title" xpText)
235 (xpElem "time_stamp" xp_time_stamp)
237 from_tuple = uncurryN Message
238 to_tuple m = (xml_xml_file_id m,
246 pickle_date :: PU EarlyLineDateXml
249 xpWrap (from_tuple, to_tuple) $
250 xpTriple (xpAttr "value" xp_early_line_date)
251 (xpElem "note" xpText)
254 from_tuple = uncurryN EarlyLineDateXml
255 to_tuple m = (xml_date_value m, xml_note m, xml_game m)
258 pickle_game :: PU EarlyLineGameXml
261 xpWrap (from_tuple, to_tuple) $
262 xp4Tuple (xpElem "time" xp_ambiguous_time)
265 (xpElem "over_under" xpText)
267 from_tuple = uncurryN EarlyLineGameXml
268 to_tuple m = (xml_game_time m,
275 pickle_away_team :: PU EarlyLineGameTeam
276 pickle_away_team = xpElem "teamA" pickle_team
278 pickle_home_team :: PU EarlyLineGameTeam
279 pickle_home_team = xpElem "teamH" pickle_team
281 pickle_team :: PU EarlyLineGameTeam
283 xpWrap (from_tuple, to_tuple) $
284 xpTriple (xpAttr "rotation" xpInt)
285 (xpAttr "line" (xpOption xpText))
288 from_tuple = uncurryN EarlyLineGameTeam
289 to_tuple m = (db_rotation_number m, db_line m, db_team_name m)