From: Michael Orlitzky Date: Sun, 1 Jun 2014 13:16:51 +0000 (-0400) Subject: Add initial database code for TSN.XML.GameInfo. X-Git-Tag: 0.0.6~249 X-Git-Url: https://gitweb.michael.orlitzky.com/?a=commitdiff_plain;h=d80ec9748b20888a1aae1828e1b622c6476e1992;p=dead%2Fhtsn-import.git Add initial database code for TSN.XML.GameInfo. --- diff --git a/src/TSN/XML/GameInfo.hs b/src/TSN/XML/GameInfo.hs index af622f0..375a77a 100644 --- a/src/TSN/XML/GameInfo.hs +++ b/src/TSN/XML/GameInfo.hs @@ -1,3 +1,10 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + -- | GameInfo represents a collection of DTDs that we don't really -- handle but want to make available. The raw XML gets stored in the -- database along with the XML_File_ID, but we don't parse any of it. @@ -6,17 +13,31 @@ -- module TSN.XML.GameInfo ( dtds, - from_xml ) + parse_xml, + -- * WARNING: these are private but exported to silence warnings + GameInfoConstructor(..) ) where +-- System imports. import Data.Time.Clock ( UTCTime ) +import Database.Groundhog ( migrate ) +import Database.Groundhog.TH ( + groundhog, + mkPersist ) import Text.XML.HXT.Core ( XmlTree ) import Text.XML.HXT.DOM.ShowXml ( xshow ) +-- Local imports. +import TSN.Codegen ( tsn_codegen_config ) +import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate ) import TSN.Parse ( parse_message, parse_xmlfid, parse_xml_time_stamp ) +import TSN.XmlImport ( XmlImport(..) ) +import Xml ( + FromXml(..), + ToDb(..) ) -- | The DTDs for everything that we consider "Game Info." -- @@ -28,16 +49,16 @@ dtds :: [String] dtds = [ "CBASK_Lineup_XML.dtd", "cbaskpreviewxml.dtd", - "cflpreviewxml.dtd", + "cflpreviewxml.dtd", -- missing DTD "Matchup_NBA_NHL_XML.dtd", "mlbpreviewxml.dtd", "MLB_Gaming_Matchup_XML.dtd", - "MLB.dtd", + "MLB.dtd", -- missing DTD "MLB_Lineup_XML.dtd", "MLB_Matchup_XML.dtd", "MLS_Preview_XML.dtd", "NBA_Gaming_Matchup_XML.dtd", - "NBA.dtd", + "NBA.dtd", -- missing DTD "NBA_Playoff_Matchup_XML.dtd", "NBALineupXML.dtd", "nbapreviewxml.dtd", @@ -46,25 +67,83 @@ dtds = "NFL_NCAA_FB_Matchup_XML.dtd", "nhlpreviewxml.dtd", "recapxml.dtd", - "WorldBaseballPreviewXML.dtd" ] + "WorldBaseballPreviewXML.dtd" -- missing DTD + ] --- | The data structure that holds the XML representation of a --- GameInfo message. +-- | XML representation of a GameInfo \. -- data Message = Message { - dtd :: String, - xml_file_id :: Int, - time_stamp :: UTCTime, - xml :: String } + xml_dtd :: String, + xml_xml_file_id :: Int, + xml_time_stamp :: UTCTime, + xml_xml :: String } deriving (Eq, Show) -from_xml :: String -> XmlTree -> Either String Message -from_xml dtdname xmltree = do +-- | Attempt to parse a 'Message' from an 'XmlTree'. If we cannot, +-- we fail with an error message. +-- +parse_xml :: String -> XmlTree -> Either String Message +parse_xml dtdname xmltree = do xmlfid <- parse_xmlfid xmltree timestamp <- parse_xml_time_stamp xmltree message <- parse_message xmltree return $ Message dtdname (fromInteger xmlfid) timestamp (xshow [message]) + +-- | Database representation of a 'Message'. +-- +data GameInfo = + GameInfo { + db_dtd :: String, + db_xml_file_id :: Int, + db_time_stamp :: UTCTime, + db_xml :: String } + + +instance ToDb Message where + -- | The database analogue of a 'Message' is an 'GameInfo'. + type Db Message = GameInfo + +instance FromXml Message where + -- | The XML to DB conversion is trivial here. + -- + from_xml Message{..} = GameInfo { + db_dtd = xml_dtd, + db_xml_file_id = xml_xml_file_id, + db_time_stamp = xml_time_stamp, + db_xml = xml_xml } + + +-- | This allows us to insert the XML representation 'Message' +-- directly. +-- +instance XmlImport Message + + +-- +-- Database code +-- + +instance DbImport Message where + dbmigrate _ = + run_dbmigrate $ migrate (undefined :: GameInfo) + + -- | We import a 'Message' by inserting the whole thing at + -- once. Nothing fancy going on here. + dbimport msg = do + insert_xml_ msg + return ImportSucceeded + +mkPersist tsn_codegen_config [groundhog| +- entity: GameInfo + constructors: + - name: GameInfo + uniques: + - name: unique_game_info + type: constraint + # Prevent multiple imports of the same message. + fields: [db_xml_file_id] +|]