]> gitweb.michael.orlitzky.com - dead/htsn-import.git/blobdiff - src/TSN/DbImport.hs
Create an ImportResult type and refactor things around it.
[dead/htsn-import.git] / src / TSN / DbImport.hs
index 83092558bef6c2b52bd9bad479c02677c1b9bf51..3646d7c34b7fce77583bac18fbf21bb36d55742a 100644 (file)
@@ -2,27 +2,39 @@
 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 = Err String | Info String | Succ Int
+
 -- | 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 +45,12 @@ 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 $ Err "Could not unpickle document in import_generic."
     Just elt  -> do
       ids <- mapM insert (g elt)
-      return $ Just (length ids)
+      return $ Succ (length ids)