Remove the XmlPickler instance for Bool.

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

diff --git a/src/TSN/XML/News.hs b/src/TSN/XML/News.hs
index 5782d2412e2f38820724de05195bf60986572cc7..31587a35b0435ca6665c82b8e3a905ccbaa07855 100644 (file)
--- a/src/TSN/XML/News.hs
+++ b/src/TSN/XML/News.hs
@@ -17,7 +17,6 @@ module TSN.XML.News (
   news_tests )
 where
 
-import Control.Monad.IO.Class ( MonadIO, liftIO )
 import Data.Data ( Data, constrFields, dataTypeConstrs, dataTypeOf )
 import Data.List.Utils ( join, split )
 import Data.Tuple.Curry ( uncurryN )
@@ -40,20 +39,18 @@ import Text.XML.HXT.Core (
   xp12Tuple,
   xpAttr,
   xpElem,
+  xpInt,
   xpList,
   xpOption,
   xpPair,
-  xpPrim,
   xpText,
   xpTriple,
   xpWrap )
 
-import Network.Services.TSN.Report ( report_error )
 import TSN.Codegen (
   tsn_codegen_config,
-  tsn_db_field_namer -- Used in a test.
-  )
-import TSN.DbImport ( DbImport(..) )
+  tsn_db_field_namer ) -- Used in a test
+import TSN.DbImport ( DbImport(..), ImportResult(..) )
 import Xml ( ToFromXml(..), pickle_unpickle )
 
 
@@ -86,7 +83,7 @@ instance ToFromXml NewsTeam where
   -- used our named fields.
   to_xml (NewsTeam {..}) = NewsTeamXml db_team_name
   -- We can't create a DefaultKey Message...
-  from_xml = error "Called from_xml on a NewsTeam"
+  from_xml = error "Called from_xml on a NewsTeam."
   -- unless we're handed one.
   from_xml_fk key = (NewsTeam key) . xml_team_name
 
@@ -124,7 +121,7 @@ instance ToFromXml NewsLocation where
   -- used our named fields.
   to_xml (NewsLocation {..}) = NewsLocationXml db_city db_state db_country
   -- We can't create a DefaultKey Message...
-  from_xml = error "Called from_xml on a NewsLocation"
+  from_xml = error "Called from_xml on a NewsLocation."
   -- unless we're given one.
   from_xml_fk key (NewsLocationXml x y z) = NewsLocation key x y z
 
@@ -235,7 +232,7 @@ pickle_msg_id :: PU MsgId
 pickle_msg_id =
   xpElem "msg_id" $
     xpWrap (from_tuple, to_tuple) $
-    xpPair xpPrim (xpAttr "EventId" (xpOption xpPrim))
+    xpPair xpInt (xpAttr "EventId" (xpOption xpInt))
   where
     from_tuple = uncurryN MsgId
     to_tuple m = (db_msg_id m, db_event_id m)
@@ -263,7 +260,7 @@ pickle_message :: PU MessageXml
 pickle_message =
   xpElem "message" $
     xpWrap (from_tuple, to_tuple) $
-    xp12Tuple (xpElem "XML_File_ID" xpPrim)
+    xp12Tuple (xpElem "XML_File_ID" xpInt)
               (xpElem "heading" xpText)
               pickle_msg_id
               (xpElem "category" xpText)
@@ -317,8 +314,7 @@ instance DbImport Message where
     case root_element of
       Nothing -> do
         let errmsg = "Could not unpickle News message in dbimport."
-        liftIO $ report_error errmsg
-        return Nothing
+        return $ ImportFailed errmsg
       Just message  -> do
         news_id <- insert (from_xml message :: Message)
         let nts :: [NewsTeam] = map (from_xml_fk news_id)
@@ -328,7 +324,7 @@ instance DbImport Message where
         nt_ids <- mapM insert nts
         loc_ids <- mapM insert nlocs
 
-        return $ Just (1 + (length nt_ids) + (length loc_ids))
+        return $ ImportSucceeded (1 + (length nt_ids) + (length loc_ids))
 
 
 -- * Tasty Tests