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

diff --git a/src/TSN/DbImport.hs b/src/TSN/DbImport.hs
index 3aeb29f..e0dd134 100644
--- a/src/TSN/DbImport.hs
+++ b/src/TSN/DbImport.hs
@@ -3,61 +3,32 @@ module TSN.DbImport
 where
 
 import Control.Monad.IO.Class ( MonadIO )
-import Database.Groundhog (
-  defaultMigrationLogger,
-  insert,
-  migrate,
-  runMigration )
-import Database.Groundhog.Core ( PersistBackend, PersistEntity )
-import Text.XML.HXT.Core (
-  XmlPickler,
-  XmlTree,
-  unpickleDoc,
-  xpickle )
+import Database.Groundhog.Core ( PersistBackend )
 
+import TSN.XmlImport ( XmlImport(..) )
 
--- | 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.
+-- | 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 Int  -- ^ We did import records, and here's how many.
+    | 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 ImportResult
+  -- | 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 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 -> return $
-                 ImportFailed "Could not unpickle document in import_generic."
-    Just elt  -> do
-      ids <- mapM insert (g elt)
-      return $ ImportSucceeded (length ids)
+dbimport_generic :: (XmlImport a, MonadIO m, PersistBackend m)
+                 => a
+                 -> m ImportResult
+dbimport_generic x = insert_xml x >> return ImportSucceeded