From: Michael Orlitzky Date: Tue, 22 Jul 2014 02:49:50 +0000 (-0400) Subject: Begin to add EarlyLine (earlylineXML) support. Still very incomplete. X-Git-Tag: 0.0.9~21 X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhtsn-import.git;a=commitdiff_plain;h=fbaea63ea21b5b35d22f43e096e09983b76dcef7 Begin to add EarlyLine (earlylineXML) support. Still very incomplete. --- diff --git a/.ghci b/.ghci index 4e0462c..0df75f1 100644 --- a/.ghci +++ b/.ghci @@ -19,6 +19,7 @@ src/TSN/XmlImport.hs src/TSN/XML/AutoRacingResults.hs src/TSN/XML/AutoRacingSchedule.hs + src/TSN/XML/EarlyLine.hs src/TSN/XML/GameInfo.hs src/TSN/XML/Heartbeat.hs src/TSN/XML/Injuries.hs @@ -49,6 +50,7 @@ import TSN.Team import TSN.XmlImport import TSN.XML.AutoRacingResults import TSN.XML.AutoRacingSchedule +import TSN.XML.EarlyLine import TSN.XML.GameInfo import TSN.XML.Heartbeat import TSN.XML.Injuries diff --git a/htsn-import.cabal b/htsn-import.cabal index b083704..d1e184c 100644 --- a/htsn-import.cabal +++ b/htsn-import.cabal @@ -48,6 +48,7 @@ extra-source-files: schemagen/Cbask_Tourn_MVP_XML/*.xml schemagen/Cbask_Tourn_Records_XML/*.xml schemagen/cflpreviewxml/*.xml + schemagen/earlylineXML/*.xml schemagen/Heartbeat/*.xml schemagen/Injuries_Detail_XML/*.xml schemagen/injuriesxml/*.xml @@ -273,6 +274,7 @@ executable htsn-import TSN.XmlImport TSN.XML.AutoRacingResults TSN.XML.AutoRacingSchedule + TSN.XML.EarlyLine TSN.XML.GameInfo TSN.XML.Heartbeat TSN.XML.Injuries diff --git a/src/Main.hs b/src/Main.hs index 492f0ce..63bde65 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -51,6 +51,9 @@ import qualified TSN.XML.AutoRacingResults as AutoRacingResults ( import qualified TSN.XML.AutoRacingSchedule as AutoRacingSchedule ( dtd, pickle_message ) +import qualified TSN.XML.EarlyLine as EarlyLine ( + dtd, + pickle_message ) import qualified TSN.XML.GameInfo as GameInfo ( dtds, parse_xml ) import qualified TSN.XML.Heartbeat as Heartbeat ( dtd, verify ) import qualified TSN.XML.Injuries as Injuries ( dtd, pickle_message ) @@ -194,6 +197,9 @@ import_file cfg path = do | dtd == AutoRacingSchedule.dtd = go AutoRacingSchedule.pickle_message + | dtd == EarlyLine.dtd = + go EarlyLine.pickle_message + -- GameInfo and SportInfo appear last in the guards | dtd == Injuries.dtd = go Injuries.pickle_message diff --git a/src/TSN/XML/EarlyLine.hs b/src/TSN/XML/EarlyLine.hs new file mode 100644 index 0000000..f4a24d8 --- /dev/null +++ b/src/TSN/XML/EarlyLine.hs @@ -0,0 +1,286 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module TSN.XML.EarlyLine ( + dtd, + pickle_message, + -- * WARNING: these are private but exported to silence warnings + EarlyLineConstructor(..), + EarlyLineGameConstructor(..) ) +where + +-- System imports. +import Data.Time ( UTCTime(..) ) +import Data.Tuple.Curry ( uncurryN ) +import Database.Groundhog.Core ( DefaultKey ) +import Database.Groundhog.TH ( + groundhog, + mkPersist ) +import Text.XML.HXT.Core ( + PU, + xp4Tuple, + xp7Tuple, + xpAttr, + xpElem, + xpInt, + xpList, + xpOption, + xpText, + xpTriple, + xpWrap ) + +-- Local imports. +import TSN.Codegen ( tsn_codegen_config ) +import TSN.DbImport ( DbImport(..) ) +import TSN.Picklers ( xp_time_stamp ) +import TSN.XmlImport ( XmlImport(..) ) +import Xml ( + FromXml(..), + ToDb(..) ) + + +-- | The DTD to which this module corresponds. Used to invoke dbimport. +-- +dtd :: String +dtd = "earlylineXML.dtd" + +-- +-- DB/XML data types +-- + +-- * EarlyLine/Message + +-- | Database representation of a 'Message'. It lacks the \ +-- elements since they're really properties of the games that they +-- contain. +-- +data EarlyLine = + EarlyLine { + db_xml_file_id :: Int, + db_heading :: String, + db_category :: String, + db_sport :: String, + db_title :: String, + db_time_stamp :: UTCTime } + deriving (Eq, Show) + + + +-- | XML Representation of an 'EarlyLine'. It has the same +-- fields, but in addition contains the 'xml_dates'. +-- +data Message = + Message { + xml_xml_file_id :: Int, + xml_heading :: String, + xml_category :: String, + xml_sport :: String, + xml_title :: String, + xml_dates :: [EarlyLineDateXml], + xml_time_stamp :: UTCTime } + deriving (Eq, Show) + + +instance ToDb Message where + -- | The database analogue of a 'Message' is an 'EarlyLine'. + -- + type Db Message = EarlyLine + + +-- | The 'FromXml' instance for 'Message' is required for the +-- 'XmlImport' instance. +-- +instance FromXml Message where + -- | To convert a 'Message' to an 'EarlyLine', we just drop + -- the 'xml_dates'. + -- + from_xml Message{..} = + EarlyLine { + db_xml_file_id = xml_xml_file_id, + db_heading = xml_heading, + db_category = xml_category, + db_sport = xml_sport, + db_title = xml_title, + db_time_stamp = xml_time_stamp } + + +-- | This allows us to insert the XML representation 'Message' +-- directly. +-- +instance XmlImport Message + + + +-- * EarlyLineDateXml + +-- | XML representation of a \. It has a \"value\" attribute +-- containing the actual date string. As children it contains a +-- (non-optional) note, and a game. The note and date value are +-- properties of the game as far as I can tell. +-- +data EarlyLineDateXml = + EarlyLineDateXml { + xml_date_value :: UTCTime, + xml_note :: String, + xml_game :: EarlyLineGameXml } + deriving (Eq, Show) + + + +-- * EarlyLineGame / EarlyLineGameXml + +data EarlyLineGame = + EarlyLineGame { + db_early_lines_id :: DefaultKey EarlyLine, + db_game_time :: UTCTime, -- ^ Combined date/time + db_note :: String, -- ^ Taken from the parent \ + db_away_team :: EarlyLineGameTeam, + db_home_team :: EarlyLineGameTeam, + db_over_under :: String } + +data EarlyLineGameXml = + EarlyLineGameXml { + xml_game_time :: UTCTime, -- ^ Only an ambiguous time string, e.g. \"8:30\" + xml_away_team :: EarlyLineGameTeam, + xml_home_team :: EarlyLineGameTeam, + xml_over_under :: String } + deriving (Eq, Show) + + +-- | XML representation of an earlyline team. It doubles as an +-- embedded type within the DB representation 'EarlyLineGame'. +-- +data EarlyLineGameTeam = + EarlyLineGameTeam { + db_rotation_number :: Int, + db_line :: Maybe String, -- ^ Can be blank, a Double, or \"off\". + db_team_name :: String } + deriving (Eq, Show) + + +-- +-- * Database stuff +-- + +instance DbImport Message where + dbmigrate = undefined + dbimport = undefined + + +mkPersist tsn_codegen_config [groundhog| + +- entity: EarlyLine + dbName: early_lines + constructors: + - name: EarlyLine + uniques: + - name: unique_early_lines + type: constraint + # Prevent multiple imports of the same message. + fields: [db_xml_file_id] + + +- entity: EarlyLineGame + dbName: early_lines_games + constructors: + - name: EarlyLineGame + fields: + - name: db_early_lines_id + reference: + onDelete: cascade + - name: db_away_team + embeddedType: + - {name: rotation_number, dbName: away_team_rotation_number} + - {name: line, dbName: away_team_line} + - {name: team_name, dbName: away_team_name} + - name: db_home_team + embeddedType: + - {name: rotation_number, dbName: home_team_rotation_number} + - {name: line, dbName: home_team_line} + - {name: team_name, dbName: home_team_name} + +- embedded: EarlyLineGameTeam + fields: + - name: db_rotation_number + dbName: rotation_number + - name: db_line + dbName: line + - name: db_team_name + dbName: team_name + +|] + + + +-- +-- * Pickling +-- +pickle_message :: PU Message +pickle_message = + xpElem "message" $ + xpWrap (from_tuple, to_tuple) $ + xp7Tuple (xpElem "XML_File_ID" xpInt) + (xpElem "heading" xpText) + (xpElem "category" xpText) + (xpElem "sport" xpText) + (xpElem "title" xpText) + (xpList pickle_date) + (xpElem "time_stamp" xp_time_stamp) + where + from_tuple = uncurryN Message + to_tuple m = (xml_xml_file_id m, + xml_heading m, + xml_category m, + xml_sport m, + xml_title m, + xml_dates m, + xml_time_stamp m) + +pickle_date :: PU EarlyLineDateXml +pickle_date = + xpElem "date" $ + xpWrap (from_tuple, to_tuple) $ + xpTriple (xpAttr "value" undefined) + (xpElem "note" xpText) + pickle_game + where + from_tuple = uncurryN EarlyLineDateXml + to_tuple m = (xml_date_value m, xml_note m, xml_game m) + + +pickle_game :: PU EarlyLineGameXml +pickle_game = + xpElem "game" $ + xpWrap (from_tuple, to_tuple) $ + xp4Tuple (xpElem "time" undefined) + pickle_away_team + pickle_home_team + (xpElem "over_under" xpText) + where + from_tuple = uncurryN EarlyLineGameXml + to_tuple m = (xml_game_time m, + xml_away_team m, + xml_home_team m, + xml_over_under m) + + + +pickle_away_team :: PU EarlyLineGameTeam +pickle_away_team = xpElem "teamA" $ pickle_team + +pickle_home_team :: PU EarlyLineGameTeam +pickle_home_team = xpElem "teamH" $ pickle_team + +pickle_team :: PU EarlyLineGameTeam +pickle_team = + xpWrap (from_tuple, to_tuple) $ + xpTriple (xpAttr "rotation" xpInt) + (xpAttr "line" (xpOption xpText)) + xpText + where + from_tuple = uncurryN EarlyLineGameTeam + to_tuple m = (db_rotation_number m, db_line m, db_team_name m)