X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FXML%2FNews.hs;h=a388415ff7109264e418d3338a68faea77654ee1;hb=6ed05f33ffaa8b000d36ab3f5ab62eed4022d27a;hp=f962c9ca650dc18bd8e4145d8ce0a6e4c0660d43;hpb=59d56f0ae0da1d4b1898b3c7536ae38473306319;p=dead%2Fhtsn-import.git

diff --git a/src/TSN/XML/News.hs b/src/TSN/XML/News.hs
index f962c9c..a388415 100644
--- a/src/TSN/XML/News.hs
+++ b/src/TSN/XML/News.hs
@@ -3,7 +3,6 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -12,8 +11,8 @@
 --   root element \<message\> that contains an entire news item.
 --
 module TSN.XML.News (
-  Message,
-  news_tests )
+  news_tests,
+  pickle_message )
 where
 
 import Data.Data ( Data, constrFields, dataTypeConstrs, dataTypeOf )
@@ -21,10 +20,8 @@ import Data.List.Utils ( join, split )
 import Data.Tuple.Curry ( uncurryN )
 import Data.Typeable ( Typeable )
 import Database.Groundhog (
-  defaultMigrationLogger,
   insert_,
-  migrate,
-  runMigration )
+  migrate )
 import Database.Groundhog.Core ( DefaultKey )
 import Database.Groundhog.TH (
   defaultCodegenConfig,
@@ -34,7 +31,6 @@ import Test.Tasty ( TestTree, testGroup )
 import Test.Tasty.HUnit ( (@?=), testCase )
 import Text.XML.HXT.Core (
   PU,
-  XmlPickler(..),
   xp13Tuple,
   xpAttr,
   xpElem,
@@ -49,7 +45,7 @@ import Text.XML.HXT.Core (
 import TSN.Codegen (
   tsn_codegen_config,
   tsn_db_field_namer ) -- Used in a test
-import TSN.DbImport ( DbImport(..), ImportResult(..) )
+import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
 import TSN.XmlImport ( XmlImport(..) )
 import Xml ( FromXml(..), pickle_unpickle, unpickleable )
 
@@ -117,7 +113,7 @@ data Message =
     xml_mid :: MsgId,
     xml_category :: String,
     xml_sport :: String,
-    xml_url :: String,
+    xml_url :: Maybe String,
     xml_teams :: [NewsTeam],
     xml_locations :: [NewsLocation],
     xml_sms :: String,
@@ -131,7 +127,7 @@ data News =
   News {
     db_mid :: MsgId,
     db_sport :: String,
-    db_url :: String,
+    db_url :: Maybe String,
     db_sms :: String,
     db_editor :: Maybe String,
     db_text :: Maybe String,
@@ -150,7 +146,7 @@ instance XmlImport Message
 
 instance DbImport Message where
   dbmigrate _ =
-    runMigration defaultMigrationLogger $ do
+    run_dbmigrate $ do
       migrate (undefined :: NewsTeam)
       migrate (undefined :: NewsLocation)
       migrate (undefined :: News)
@@ -240,8 +236,6 @@ pickle_news_team =
     from_string :: String -> NewsTeam
     from_string = NewsTeam
 
-instance XmlPickler NewsTeam where
-  xpickle = pickle_news_team
 
 pickle_msg_id :: PU MsgId
 pickle_msg_id =
@@ -252,8 +246,6 @@ pickle_msg_id =
     from_tuple = uncurryN MsgId
     to_tuple m = (db_msg_id m, db_event_id m)
 
-instance XmlPickler MsgId where
-  xpickle = pickle_msg_id
 
 pickle_location :: PU NewsLocation
 pickle_location =
@@ -267,8 +259,6 @@ pickle_location =
       uncurryN NewsLocation
     to_tuple l = (city l, state l, country l)
 
-instance XmlPickler NewsLocation where
-  xpickle = pickle_location
 
 
 pickle_message :: PU Message
@@ -280,7 +270,7 @@ pickle_message =
               pickle_msg_id
               (xpElem "category" xpText)
               (xpElem "sport" xpText)
-              (xpElem "url" xpText)
+              (xpElem "url" $ xpOption xpText)
               (xpList pickle_news_team)
               (xpList pickle_location)
               (xpElem "SMS" xpText)
@@ -317,9 +307,6 @@ pickle_message =
         to_string :: [String] -> String
         to_string = join "\n"
 
-instance XmlPickler Message where
-  xpickle = pickle_message
-
 
 
 -- * Tasty Tests
@@ -364,7 +351,7 @@ test_pickle_of_unpickle_is_identity = testGroup "pickle-unpickle tests"
           "test/xml/newsxml-with-editor.xml" ]
   where
     check desc path = testCase desc $ do
-      (expected :: [Message], actual) <- pickle_unpickle "message" path
+      (expected, actual) <- pickle_unpickle pickle_message path
       actual @?= expected