Commit persistent stuff.

[dead/htsn-import.git] / src / TSN / Injuries.hs

diff --git a/src/TSN/Injuries.hs b/src/TSN/Injuries.hs
index 7425ab5241025a6273ae9388710cf193ea00ed3b..956aa9d896e0ad8a12fc1f19a843c4f15526c88e 100644 (file)
--- a/src/TSN/Injuries.hs
+++ b/src/TSN/Injuries.hs
@@ -2,75 +2,88 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeSynonymInstances #-}
 module TSN.Injuries
 where
 
-import Generics.Regular
-import Database.Persist.TH
-import Text.XML.HXT.Core
+import Database.Persist.TH (
+  mkDeleteCascade,
+  mkMigrate,
+  mkPersist,
+  persistLowerCase,
+  share,
+  sqlOnlySettings )
+import Text.XML.HXT.Core (
+  PU,
+  XmlPickler(..),
+  xp4Tuple,
+  xp6Tuple,
+  xpElem,
+  xpList,
+  xpPrim,
+  xpText,
+  xpWrap )
 
-share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
-Listing
+import Uncurry (uncurry4, uncurry5, uncurry6)
+
+share [mkPersist sqlOnlySettings,
+       mkDeleteCascade sqlOnlySettings,
+       mkMigrate "migrate_injuries"] [persistLowerCase|
+InjuriesListing
   team String
   teamno Int
   injuries String
   updated Bool
   deriving Show
 
-Message
+InjuriesMessage
   xml_file_id Int
   heading String
   category String
   sport String
-  listings [Listing]
+  listings [InjuriesListing]
   time_stamp String
   deriving Show
 |]
 
-pickle_listing :: PU Listing
-pickle_listing =
+
+pickle_injurieslisting :: PU InjuriesListing
+pickle_injurieslisting =
   xpElem "listing" $
-    xpWrap (\(w,x,y,z) -> Listing w x y z,
-            \l -> (listingTeam l,
-                   listingTeamno l,
-                   listingInjuries l,
-                   listingUpdated l)) $
+    xpWrap (uncurry4 InjuriesListing,
+            \l -> (injuriesListingTeam l,
+                   injuriesListingTeamno l,
+                   injuriesListingInjuries l,
+                   injuriesListingUpdated l)) $
     xp4Tuple (xpElem "team" xpText)
              (xpElem "teamno" xpPrim)
              (xpElem "injuries" xpText)
              (xpElem "updated" xpPrim)
 
-instance XmlPickler Listing where
-  xpickle = pickle_listing
+instance XmlPickler InjuriesListing where
+  xpickle = pickle_injurieslisting
 
-$(deriveAll ''Listing "PFListing")
-type instance PF Listing = PFListing
 
-
-pickle_message :: PU Message
-pickle_message =
+pickle_injuriesmessage :: PU InjuriesMessage
+pickle_injuriesmessage =
   xpElem "message" $
-    xpWrap (\(u,v,w,x,y,z) -> Message u v w x y z,
-            \m -> (messageXml_file_id m,
-                   messageHeading m,
-                   messageCategory m,
-                   messageSport m,
-                   messageListings m,
-                   messageTime_stamp m)) $
+    xpWrap (uncurry6 InjuriesMessage,
+            \m -> (injuriesMessageXml_file_id m,
+                   injuriesMessageHeading m,
+                   injuriesMessageCategory m,
+                   injuriesMessageSport m,
+                   injuriesMessageListings m,
+                   injuriesMessageTime_stamp m)) $
     xp6Tuple (xpElem "XML_File_ID" xpPrim)
              (xpElem "heading" xpText)
              (xpElem "category" xpText)
              (xpElem "sport" xpText)
-             (xpList pickle_listing)
+             (xpList pickle_injurieslisting)
              (xpElem "time_stamp" xpText)
 
-instance XmlPickler Message where
-  xpickle = pickle_message
-
-$(deriveAll ''Message "PFMessage")
-type instance PF Message = PFMessage
+instance XmlPickler InjuriesMessage where
+  xpickle = pickle_injuriesmessage