]> gitweb.michael.orlitzky.com - dead/htsn-import.git/blob - src/TSN/Injuries.hs
Make it really import the XML files from the command line.
[dead/htsn-import.git] / src / TSN / Injuries.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 "injuriesxml.dtd". Each document
9 -- contains a root element \<message\> that in turn contains zero or
10 -- more \<listing\>s.
11 --
12 -- The listings will be mapped to a database table called "injuries"
13 -- automatically. The root message is not retained.
14 --
15 module TSN.Injuries (
16 Listing,
17 Message( listings ) )
18 where
19
20 import Data.Tuple.Curry ( uncurryN )
21 import Database.Groundhog()
22 import Database.Groundhog.TH
23 import Text.XML.HXT.Core (
24 PU,
25 XmlPickler(..),
26 xp4Tuple,
27 xp6Tuple,
28 xpElem,
29 xpList,
30 xpPrim,
31 xpText,
32 xpWrap )
33
34
35 data Listing =
36 Listing {
37 team :: String,
38 teamno :: Int,
39 injuries :: String,
40 updated :: Bool }
41 deriving (Show)
42
43 data Message =
44 Message {
45 xml_file_id :: Int,
46 heading :: String,
47 category :: String,
48 sport :: String,
49 listings :: [Listing],
50 time_stamp :: String }
51 deriving (Show)
52
53
54 mkPersist defaultCodegenConfig [groundhog|
55 - entity: Listing
56 dbName: injuries
57 |]
58
59
60 pickle_listing :: PU Listing
61 pickle_listing =
62 xpElem "listing" $
63 xpWrap (from_tuple, to_tuple) $
64 xp4Tuple (xpElem "team" xpText)
65 (xpElem "teamno" xpPrim)
66 (xpElem "injuries" xpText)
67 (xpElem "updated" xpPrim)
68 where
69 from_tuple = uncurryN Listing
70 to_tuple l = (team l, teamno l, injuries l, updated l)
71
72 instance XmlPickler Listing where
73 xpickle = pickle_listing
74
75
76 pickle_message :: PU Message
77 pickle_message =
78 xpElem "message" $
79 xpWrap (from_tuple, to_tuple) $
80 xp6Tuple (xpElem "XML_File_ID" xpPrim)
81 (xpElem "heading" xpText)
82 (xpElem "category" xpText)
83 (xpElem "sport" xpText)
84 (xpList pickle_listing)
85 (xpElem "time_stamp" xpText)
86 where
87 from_tuple = uncurryN Message
88 to_tuple m = (xml_file_id m,
89 heading m,
90 category m,
91 sport m,
92 listings m,
93 time_stamp m)
94
95 instance XmlPickler Message where
96 xpickle = pickle_message