src/TSN/Injuries.hs

   1 {-# LANGUAGE EmptyDataDecls #-}
   2 {-# LANGUAGE FlexibleContexts #-}
   3 {-# LANGUAGE FlexibleInstances #-}
   4 {-# LANGUAGE GADTs #-}
   5 {-# LANGUAGE OverloadedStrings #-}
   6 {-# LANGUAGE QuasiQuotes #-}
   7 {-# LANGUAGE TemplateHaskell #-}
   8 {-# LANGUAGE TypeFamilies #-}
   9 {-# LANGUAGE TypeSynonymInstances #-}
  10 module TSN.Injuries
  11 where
  12
  13 import Generics.Regular
  14 import Database.Persist.TH
  15 import Text.XML.HXT.Core
  16
  17 share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
  18 Listing
  19   team String
  20   teamno Int
  21   injuries String
  22   updated Bool
  23   deriving Show
  24
  25 Message
  26   xml_file_id Int
  27   heading String
  28   category String
  29   sport String
  30   listings [Listing]
  31   time_stamp String
  32   deriving Show
  33 |]
  34
  35 pickle_listing :: PU Listing
  36 pickle_listing =
  37   xpElem "listing" $
  38     xpWrap (\(w,x,y,z) -> Listing w x y z,
  39             \l -> (listingTeam l,
  40                    listingTeamno l,
  41                    listingInjuries l,
  42                    listingUpdated l)) $
  43     xp4Tuple (xpElem "team" xpText)
  44              (xpElem "teamno" xpPrim)
  45              (xpElem "injuries" xpText)
  46              (xpElem "updated" xpPrim)
  47
  48 instance XmlPickler Listing where
  49   xpickle = pickle_listing
  50
  51 $(deriveAll ''Listing "PFListing")
  52 type instance PF Listing = PFListing
  53
  54
  55 pickle_message :: PU Message
  56 pickle_message =
  57   xpElem "message" $
  58     xpWrap (\(u,v,w,x,y,z) -> Message u v w x y z,
  59             \m -> (messageXml_file_id m,
  60                    messageHeading m,
  61                    messageCategory m,
  62                    messageSport m,
  63                    messageListings m,
  64                    messageTime_stamp m)) $
  65     xp6Tuple (xpElem "XML_File_ID" xpPrim)
  66              (xpElem "heading" xpText)
  67              (xpElem "category" xpText)
  68              (xpElem "sport" xpText)
  69              (xpList pickle_listing)
  70              (xpElem "time_stamp" xpText)
  71
  72 instance XmlPickler Message where
  73   xpickle = pickle_message
  74
  75 $(deriveAll ''Message "PFMessage")
  76 type instance PF Message = PFMessage