X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FDbImport.hs;h=3aeb29f26a87756e51a49f0773bf1fd53b5b499e;hb=a163a47ab0aed0072f7868d4b2b28aa4c326e5e1;hp=83092558bef6c2b52bd9bad479c02677c1b9bf51;hpb=e46de7e95112d4e35219b74c0b3efffe99c69c6a;p=dead%2Fhtsn-import.git

diff --git a/src/TSN/DbImport.hs b/src/TSN/DbImport.hs
index 8309255..3aeb29f 100644
--- a/src/TSN/DbImport.hs
+++ b/src/TSN/DbImport.hs
@@ -2,27 +2,45 @@
 module TSN.DbImport
 where
 
-import Control.Monad.IO.Class ( MonadIO, liftIO )
+import Control.Monad.IO.Class ( MonadIO )
 import Database.Groundhog (
   defaultMigrationLogger,
   insert,
   migrate,
   runMigration )
 import Database.Groundhog.Core ( PersistBackend, PersistEntity )
-import Network.Services.TSN.Report ( report_error )
 import Text.XML.HXT.Core (
   XmlPickler,
   XmlTree,
   unpickleDoc,
   xpickle )
 
+
+-- | The type that will be returned from every file import attempt. If
+--   there was an error, its description will be wrapped in an Err. If
+--   we successfully imported records, the number of records imported
+--   will be wrapped in a Succ.
+--
+--   Anything else will be wrapped in a "Info" constructor;
+--   i.e. somewhere between success and failure. This is like an
+--   'Either' with three choices. A "Info" return value means that
+--   the XML document *was* processed, so it should be removed.
+--
+data ImportResult =
+  ImportFailed String -- ^ Failure with an error message.
+    | ImportSkipped String -- ^ We processed the file, but didn't import it.
+                           --   The reason is contained in the second field.
+    | ImportSucceeded Int  -- ^ We did import records, and here's how many.
+    | ImportUnsupported String -- ^ We didn't know how to process this file.
+                               --   The second field should contain info.
+
 -- | Instances of this type know how to insert themselves into a
 --   Groundhog database.
 class DbImport a where
   dbimport :: (MonadIO m, PersistBackend m)
            => a
            -> XmlTree
-           -> m (Maybe Int)
+           -> m ImportResult
 
 
 -- | We put the 'Configuration' and 'XmlTree' arguments last so that
@@ -33,15 +51,13 @@ import_generic :: (XmlPickler a, MonadIO m, PersistEntity b, PersistBackend m)
                => (a -> [b]) -- ^ listings getter
                -> b          -- ^ Dummy Listing instance needed for 'migrate'
                -> XmlTree
-               -> m (Maybe Int) -- ^ Return the number of records inserted.
+               -> m ImportResult -- ^ Return the number of records inserted.
 import_generic g dummy xml = do
   runMigration defaultMigrationLogger $ migrate dummy
   let root_element = unpickleDoc xpickle xml
   case root_element of
-    Nothing -> do
-      let msg = "Could not unpickle document in import_generic."
-      liftIO $ report_error msg
-      return Nothing
+    Nothing -> return $
+                 ImportFailed "Could not unpickle document in import_generic."
     Just elt  -> do
       ids <- mapM insert (g elt)
-      return $ Just (length ids)
+      return $ ImportSucceeded (length ids)