src/TSN/XML/Odds.hs

   1 {-# LANGUAGE BangPatterns #-}
   2 {-# LANGUAGE DeriveDataTypeable #-}
   3 {-# LANGUAGE FlexibleInstances #-}
   4 {-# LANGUAGE GADTs #-}
   5 {-# LANGUAGE QuasiQuotes #-}
   6 {-# LANGUAGE RecordWildCards #-}
   7 {-# LANGUAGE ScopedTypeVariables #-}
   8 {-# LANGUAGE StandaloneDeriving #-}
   9 {-# LANGUAGE TemplateHaskell #-}
  10 {-# LANGUAGE TypeFamilies #-}
  11
  12 module TSN.XML.Odds (
  13   Message )
  14 where
  15
  16
  17 -- | Parse TSN XML for the DTD "Odds_XML.dtd". Each document contains
  18 --   a root element \<message\> that contains a bunch of other
  19 --   unorganized crap.
  20 --
  21
  22 import Data.Data ( Data, constrFields, dataTypeConstrs, dataTypeOf )
  23 import Data.List.Utils ( join, split )
  24 import Data.Tuple.Curry ( uncurryN )
  25 import Data.Typeable ( Typeable )
  26 import Database.Groundhog (
  27   defaultMigrationLogger,
  28   insert,
  29   migrate,
  30   runMigration )
  31 import Database.Groundhog.Core ( DefaultKey )
  32 import Database.Groundhog.TH (
  33   groundhog,
  34   mkPersist )
  35 import Test.Tasty ( TestTree, testGroup )
  36 import Test.Tasty.HUnit ( (@?=), testCase )
  37 import Text.XML.HXT.Core (
  38   PU,
  39   XmlPickler(..),
  40   unpickleDoc,
  41   xp5Tuple,
  42   xp6Tuple,
  43   xp11Tuple,
  44   xpAttr,
  45   xpElem,
  46   xpInt,
  47   xpList,
  48   xpOption,
  49   xpPair,
  50   xpPrim,
  51   xpText,
  52   xpText0,
  53   xpTriple,
  54   xpWrap )
  55
  56 import TSN.Codegen (
  57   tsn_codegen_config,
  58   tsn_db_field_namer )
  59 import TSN.DbImport ( DbImport(..), ImportResult(..) )
  60 import Xml ( ToFromXml(..), pickle_unpickle )
  61
  62
  63
  64 data OddsCasino =
  65   OddsCasino {
  66     xml_casino_client_id :: Int,
  67     xml_casino_name      :: String,
  68     xml_casino_line      :: Maybe Float }
  69   deriving (Eq, Show)
  70
  71 data OddsHomeTeam =
  72   OddsHomeTeam {
  73     xml_home_team_id         :: Int,
  74     xml_home_rotation_number :: Int,
  75     xml_home_abbr            :: String,
  76     xml_home_team_name       :: String,
  77     xml_home_casinos         :: [OddsCasino] }
  78   deriving (Eq, Show)
  79
  80 data OddsAwayTeam =
  81   OddsAwayTeam {
  82     xml_away_team_id         :: Int,
  83     xml_away_rotation_number :: Int,
  84     xml_away_abbr            :: String,
  85     xml_away_team_name       :: String,
  86     xml_away_casinos         :: [OddsCasino] }
  87   deriving (Eq, Show)
  88
  89 -- | Can't use a newtype with Groundhog.
  90 data OddsOverUnder =
  91   OddsOverUnder [OddsCasino]
  92   deriving (Eq, Show)
  93
  94 data OddsGame =
  95   OddsGame {
  96     xml_game_id         :: Int,
  97     xml_game_date       :: String, -- TODO
  98     xml_game_time       :: String, -- TODO
  99     xml_game_away_team  :: OddsAwayTeam,
 100     xml_game_home_team  :: OddsHomeTeam,
 101     xml_game_over_under :: OddsOverUnder }
 102   deriving (Eq, Show)
 103
 104 data Message = Message
 105
 106 data MessageXml =
 107   MessageXml {
 108     xml_xml_file_id :: Int,
 109     xml_heading :: String,
 110     xml_category :: String,
 111     xml_sport :: String,
 112     xml_title :: String,
 113     xml_line_time :: String, -- The DTD goes crazy here.
 114     xml_notes1 :: String,
 115     xml_games1 :: [OddsGame],
 116     xml_notes2 :: String,
 117     xml_games2 :: [OddsGame],
 118     xml_time_stamp :: String }
 119   deriving (Eq, Show)
 120
 121
 122 pickle_casino :: PU OddsCasino
 123 pickle_casino =
 124   xpElem "Casino" $
 125   xpWrap (from_tuple, to_tuple) $
 126   xpTriple
 127     (xpAttr "ClientID" xpInt)
 128     (xpAttr "Name" xpText)
 129     (xpOption xpPrim)
 130   where
 131     from_tuple = uncurryN OddsCasino
 132     to_tuple (OddsCasino x y z) = (x, y, z)
 133
 134 instance XmlPickler OddsCasino where
 135   xpickle = pickle_casino
 136
 137
 138 pickle_home_team :: PU OddsHomeTeam
 139 pickle_home_team =
 140   xpElem "HomeTeam" $
 141   xpWrap (from_tuple, to_tuple) $
 142   xp5Tuple
 143     (xpElem "HomeTeamID" xpPrim)
 144     (xpElem "HomeRotationNumber" xpPrim)
 145     (xpElem "HomeAbbr" xpText)
 146     (xpElem "HomeTeamName" xpText)
 147     (xpList pickle_casino)
 148   where
 149     from_tuple = uncurryN OddsHomeTeam
 150     to_tuple (OddsHomeTeam v w x y z) = (v, w, x, y, z)
 151
 152
 153 instance XmlPickler OddsHomeTeam where
 154   xpickle = pickle_home_team
 155
 156
 157 pickle_away_team :: PU OddsAwayTeam
 158 pickle_away_team =
 159   xpElem "AwayTeam" $
 160   xpWrap (from_tuple, to_tuple) $
 161   xp5Tuple
 162     (xpElem "AwayTeamID" xpPrim)
 163     (xpElem "AwayRotationNumber" xpPrim)
 164     (xpElem "AwayAbbr" xpText)
 165     (xpElem "AwayTeamName" xpText)
 166     (xpList pickle_casino)
 167   where
 168     from_tuple = uncurryN OddsAwayTeam
 169     to_tuple (OddsAwayTeam v w x y z) = (v, w, x, y, z)
 170
 171
 172 instance XmlPickler OddsAwayTeam where
 173   xpickle = pickle_away_team
 174
 175
 176 pickle_over_under :: PU OddsOverUnder
 177 pickle_over_under =
 178   xpElem "Over_Under" $
 179   xpWrap (to_newtype, from_newtype) $
 180     xpList pickle_casino
 181   where
 182     from_newtype (OddsOverUnder cs) = cs
 183     to_newtype = OddsOverUnder
 184
 185 instance XmlPickler OddsOverUnder where
 186   xpickle = pickle_over_under
 187
 188
 189 pickle_game :: PU OddsGame
 190 pickle_game =
 191   xpElem "Game" $
 192   xpWrap (from_tuple, to_tuple) $
 193   xp6Tuple
 194     (xpElem "GameID" xpPrim)
 195     (xpElem "Game_Date" xpText)
 196     (xpElem "Game_Time" xpText)
 197     pickle_away_team
 198     pickle_home_team
 199     pickle_over_under
 200   where
 201     from_tuple = uncurryN OddsGame
 202     to_tuple (OddsGame u v w x y z) = (u,v,w,x,y,z)
 203
 204 instance XmlPickler OddsGame where
 205   xpickle = pickle_game
 206
 207
 208 pickle_message :: PU MessageXml
 209 pickle_message =
 210   xpElem "message" $
 211     xpWrap (from_tuple, to_tuple) $
 212     xp11Tuple (xpElem "XML_File_ID" xpPrim)
 213               (xpElem "heading" xpText)
 214               (xpElem "category" xpText)
 215               (xpElem "sport" xpText)
 216               (xpElem "Title" xpText)
 217               (xpElem "Line_Time" xpText)
 218               pickle_notes
 219               (xpList $ pickle_game)
 220               pickle_notes
 221               (xpList $ pickle_game)
 222               (xpElem "time_stamp" xpText)
 223   where
 224     from_tuple = uncurryN MessageXml
 225     to_tuple m = undefined
 226
 227     pickle_notes :: PU String
 228     pickle_notes =
 229       xpWrap (to_string, from_string) $
 230           (xpList $ xpElem "Notes" xpText)
 231       where
 232         from_string :: String -> [String]
 233         from_string = split "\n"
 234
 235         to_string :: [String] -> String
 236         to_string = join "\n"
 237
 238 instance XmlPickler MessageXml where
 239   xpickle = pickle_message
 240