]> gitweb.michael.orlitzky.com - dead/htsn-import.git/blob - src/TSN/InjuriesDetail.hs
Make it really import the XML files from the command line.
[dead/htsn-import.git] / src / TSN / InjuriesDetail.hs
1 {-# LANGUAGE FlexibleInstances #-}
2 {-# LANGUAGE GADTs #-}
3 {-# LANGUAGE QuasiQuotes #-}
4 {-# LANGUAGE StandaloneDeriving #-}
5 {-# LANGUAGE TemplateHaskell #-}
6 {-# LANGUAGE TypeFamilies #-}
7
8 -- | Parse TSN XML for the DTD "Injuries_Detail_XML.dtd". Each
9 -- document contains a root element \<message\> that in turn
10 -- contains zero or more \<Listing\>s (note: capitalization). The
11 -- \<Listing\>s contain \<PlayerListing\>s then contain the real
12 -- meat; everything contained in the parent \<Listing\> can also be
13 -- found within the \<PlayerListing\>s.
14 --
15 -- The player listings will be mapped to a database table called
16 -- "injuries_detail" automatically. The root "message" and "listing"
17 -- are not retained.
18 --
19 module TSN.InjuriesDetail (
20 Listing ( player_listings ),
21 Message ( listings ),
22 PlayerListing )
23 where
24
25 import Data.Time ( UTCTime )
26 import Data.Tuple.Curry ( uncurryN )
27 import Database.Groundhog()
28 import Database.Groundhog.TH
29 import Text.XML.HXT.Core (
30 PU,
31 XmlPickler(..),
32 xpTriple,
33 xp6Tuple,
34 xp10Tuple,
35 xpElem,
36 xpList,
37 xpPrim,
38 xpText,
39 xpText0,
40 xpWrap )
41
42 import TSN.Picklers( xp_date )
43
44 data PlayerListing =
45 PlayerListing {
46 team_id :: Int,
47 player_id :: Int,
48 date :: UTCTime,
49 pos :: String,
50 name :: String,
51 injury :: String,
52 status :: String,
53 fantasy :: String, -- ^ Nobody knows what this is.
54 injured :: Bool,
55 injury_type :: String -- ^ "type" is a reserved keyword so we can't use it
56 }
57 deriving (Show)
58
59 data Listing =
60 Listing {
61 listing_team_id :: Int -- ^ Avoid conflict with PlayerListing's team_id
62 , full_name :: String, -- ^ Team full name
63 player_listings :: [PlayerListing] }
64 deriving (Show)
65
66 data Message =
67 Message {
68 xml_file_id :: Int,
69 heading :: String,
70 category :: String,
71 sport :: String,
72 listings :: [Listing],
73 time_stamp :: String }
74 deriving (Show)
75
76
77 mkPersist defaultCodegenConfig [groundhog|
78 - entity: PlayerListing
79 dbName: injuries_detail
80 |]
81
82
83 pickle_player_listing :: PU PlayerListing
84 pickle_player_listing =
85 xpElem "PlayerListing" $
86 xpWrap (from_tuple, to_tuple) $
87 xp10Tuple (xpElem "TeamID" xpPrim)
88 (xpElem "PlayerID" xpPrim)
89 (xpElem "Date" xp_date)
90 (xpElem "Pos" xpText)
91 (xpElem "Name" xpText)
92 (xpElem "Injury" xpText)
93 (xpElem "Status" xpText)
94 (xpElem "Fantasy" xpText0)
95 (xpElem "Injured" xpickle)
96 (xpElem "Type" xpText)
97 where
98 from_tuple = uncurryN PlayerListing
99 to_tuple pl = (team_id pl,
100 player_id pl,
101 date pl,
102 pos pl,
103 name pl,
104 injury pl,
105 status pl,
106 fantasy pl,
107 injured pl,
108 injury_type pl)
109
110 instance XmlPickler PlayerListing where
111 xpickle = pickle_player_listing
112
113 pickle_listing :: PU Listing
114 pickle_listing =
115 xpElem "Listing" $
116 xpWrap (from_tuple, to_tuple) $
117 xpTriple (xpElem "TeamID" xpPrim)
118 (xpElem "FullName" xpText)
119 (xpList pickle_player_listing)
120 where
121 from_tuple = uncurryN Listing
122 to_tuple l = (listing_team_id l, full_name l, player_listings l)
123
124 instance XmlPickler Listing where
125 xpickle = pickle_listing
126
127
128 pickle_message :: PU Message
129 pickle_message =
130 xpElem "message" $
131 xpWrap (from_tuple, to_tuple) $
132 xp6Tuple (xpElem "XML_File_ID" xpPrim)
133 (xpElem "heading" xpText)
134 (xpElem "category" xpText)
135 (xpElem "sport" xpText)
136 (xpList pickle_listing)
137 (xpElem "time_stamp" xpText)
138 where
139 from_tuple = uncurryN Message
140 to_tuple m = (xml_file_id m,
141 heading m,
142 category m,
143 sport m,
144 listings m,
145 time_stamp m)
146
147 instance XmlPickler Message where
148 xpickle = pickle_message