X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FNews.hs;h=74b48463edb071ceac391355247a7cf6556ee6bd;hb=04f468994697d4d983a09a8e612948b23a973848;hp=4e24c3ae0e89fa575dbc2d54e519645306d2e11c;hpb=3835f96aea2f383501071106be0a69abd1ef89d1;p=dead%2Fhtsn-import.git

diff --git a/src/TSN/News.hs b/src/TSN/News.hs
index 4e24c3a..74b4846 100644
--- a/src/TSN/News.hs
+++ b/src/TSN/News.hs
@@ -14,6 +14,7 @@ module TSN.News (
   news_tests )
 where
 
+import Data.List.Utils ( join, split )
 import Data.Tuple.Curry ( uncurryN )
 import Database.Groundhog()
 import Database.Groundhog.TH
@@ -37,14 +38,19 @@ import Text.XML.HXT.Core (
 import Xml ( pickle_unpickle )
 
 
+-- Can't use a newtype with groundhog.
+data NewsTeam =
+  NewsTeam { team_name :: String }
+  deriving (Eq, Show)
+
 data MsgId =
   MsgId {
-    msg_id_text   :: Int,
+    msg_id   :: Int,
     event_id :: String }
   deriving (Eq, Show)
 
-data Location =
-  Location {
+data NewsLocation =
+  NewsLocation {
     city :: String,
     state :: String,
     country :: String }
@@ -53,13 +59,13 @@ data Location =
 data Message =
   Message {
     xml_file_id :: Int,
-    msg_id :: MsgId,
     heading :: String,
+    mid :: MsgId,
     category :: String,
     sport :: String,
     url :: String,
-    teams :: [String],
-    location :: Location,
+    teams :: [NewsTeam],
+    locations :: [NewsLocation],
     sms :: String,
     text :: String,
     continue :: String,
@@ -67,11 +73,43 @@ data Message =
   deriving (Eq, Show)
 
 
--- mkPersist defaultCodegenConfig [groundhog|
--- - entity: Message
---   dbName: injuries
--- |]
+mkPersist defaultCodegenConfig [groundhog|
+- entity: NewsTeam
+  dbName: news_teams
+
+- entity: NewsLocation
+  dbName: news_locations
+
+- entity: Message
+  dbName: news
+  constructors:
+    - name: Message
+      fields:
+        - name: mid
+          embeddedType:
+            - {name: msg_id, dbName: msg_id}
+            - {name: event_id, dbName: event_id}
+
+- embedded: MsgId
+  fields:
+    - name: msg_id
+    - name: event_id
+|]
+
 
+pickle_news_team :: PU NewsTeam
+pickle_news_team =
+  xpElem "team" $
+    xpWrap (from_string, to_string) xpText
+  where
+    to_string :: NewsTeam -> String
+    to_string = team_name
+
+    from_string :: String -> NewsTeam
+    from_string = NewsTeam
+
+instance XmlPickler NewsTeam where
+  xpickle = pickle_news_team
 
 pickle_msg_id :: PU MsgId
 pickle_msg_id =
@@ -80,23 +118,23 @@ pickle_msg_id =
     xpPair xpPrim (xpAttr "EventId" xpText0)
   where
     from_tuple = uncurryN MsgId
-    to_tuple m = (msg_id_text m, event_id m)
+    to_tuple m = (msg_id m, event_id m)
 
 instance XmlPickler MsgId where
   xpickle = pickle_msg_id
 
-pickle_location :: PU Location
+pickle_location :: PU NewsLocation
 pickle_location =
-  xpElem "listing" $
+  xpElem "location" $
     xpWrap (from_tuple, to_tuple) $
     xpTriple (xpElem "city" xpText)
-             (xpElem "state" xpPrim)
-             (xpElem "location" xpText)
+             (xpElem "state" xpText)
+             (xpElem "country" xpText)
   where
-    from_tuple = uncurryN Location
+    from_tuple = uncurryN NewsLocation
     to_tuple l = (city l, state l, country l)
 
-instance XmlPickler Location where
+instance XmlPickler NewsLocation where
   xpickle = pickle_location
 
 
@@ -105,32 +143,44 @@ pickle_message =
   xpElem "message" $
     xpWrap (from_tuple, to_tuple) $
     xp12Tuple (xpElem "XML_File_ID" xpPrim)
-              pickle_msg_id
               (xpElem "heading" xpText)
+              pickle_msg_id
               (xpElem "category" xpText)
               (xpElem "sport" xpText)
               (xpElem "url" xpText)
-              (xpList $ xpElem "team" xpText)
-              (pickle_location)
-              (xpElem "sms" xpText)
+              (xpList $ pickle_news_team)
+              (xpList $ pickle_location)
+              (xpElem "SMS" xpText)
               (xpElem "text" xpText)
-              (xpElem "continue" xpText)
+              pickle_continue
               (xpElem "time_stamp" xpText)
   where
     from_tuple = uncurryN Message
     to_tuple m = (xml_file_id m,
-                  msg_id m,
                   heading m,
+                  mid m,
                   category m,
                   sport m,
                   url m,
                   teams m,
-                  location m,
+                  locations m,
                   sms m,
                   text m,
                   continue m,
                   time_stamp m)
 
+    pickle_continue :: PU String
+    pickle_continue =
+      xpWrap (to_string, from_string) $
+        xpElem "continue" $
+          (xpList $ xpElem "P" xpText)
+      where
+        from_string :: String -> [String]
+        from_string = split "\n"
+
+        to_string :: [String] -> String
+        to_string = join "\n"
+
 instance XmlPickler Message where
   xpickle = pickle_message