X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FDbImport.hs;h=e0dd1349a1469cc7ead734923a2a5d027aea9007;hb=ce9fabd584f2e8844b8b1ede9b29bb573e2033f7;hp=83092558bef6c2b52bd9bad479c02677c1b9bf51;hpb=e46de7e95112d4e35219b74c0b3efffe99c69c6a;p=dead%2Fhtsn-import.git diff --git a/src/TSN/DbImport.hs b/src/TSN/DbImport.hs index 8309255..e0dd134 100644 --- a/src/TSN/DbImport.hs +++ b/src/TSN/DbImport.hs @@ -2,46 +2,33 @@ module TSN.DbImport where -import Control.Monad.IO.Class ( MonadIO, liftIO ) -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 ) +import Control.Monad.IO.Class ( MonadIO ) +import Database.Groundhog.Core ( PersistBackend ) + +import TSN.XmlImport ( XmlImport(..) ) + +-- | The type that will be returned from every file import attempt. +-- +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 -- ^ We did import records. + | 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) + -- | Import an instance of type @a@. + dbimport :: (PersistBackend m) => a -> m ImportResult + -- | This must migrate *all* stuffs that can potentially be + -- created/used by the type @a@. + dbmigrate :: (MonadIO m, PersistBackend m) => a -> m () --- | We put the 'Configuration' and 'XmlTree' arguments last so that --- it's easy to eta reduce all of the import_foo functions that call --- this. --- -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. -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 - Just elt -> do - ids <- mapM insert (g elt) - return $ Just (length ids) +dbimport_generic :: (XmlImport a, MonadIO m, PersistBackend m) + => a + -> m ImportResult +dbimport_generic x = insert_xml x >> return ImportSucceeded