X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FDbImport.hs;h=3646d7c34b7fce77583bac18fbf21bb36d55742a;hb=da0885d061b23f99a6c9d24b6b823c4654893d9c;hp=83092558bef6c2b52bd9bad479c02677c1b9bf51;hpb=0e37f70a58d512858b38e1458c6d83bc1727269c;p=dead%2Fhtsn-import.git diff --git a/src/TSN/DbImport.hs b/src/TSN/DbImport.hs index 8309255..3646d7c 100644 --- a/src/TSN/DbImport.hs +++ b/src/TSN/DbImport.hs @@ -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)