From a913a63f7679b59f9b650619e8fbfc6e81f3f8d3 Mon Sep 17 00:00:00 2001
From: Michael Orlitzky <michael@orlitzky.com>
Date: Sat, 11 Jan 2014 18:33:23 -0500
Subject: [PATCH] Add run_dbmigrate to TSN.DbImport.

---
 src/TSN/DbImport.hs | 42 +++++++++++++++++++++++++++++++++++-------
 1 file changed, 35 insertions(+), 7 deletions(-)

diff --git a/src/TSN/DbImport.hs b/src/TSN/DbImport.hs
index e0dd134..8884a9e 100644
--- a/src/TSN/DbImport.hs
+++ b/src/TSN/DbImport.hs
@@ -1,21 +1,35 @@
 -- | Definition of the DbImport typeclass.
-module TSN.DbImport
+module TSN.DbImport (
+  DbImport(..),
+  ImportResult(..),
+  dbimport_generic,
+  run_dbmigrate )
 where
 
+-- System imports
 import Control.Monad.IO.Class ( MonadIO )
-import Database.Groundhog.Core ( PersistBackend )
+import Database.Groundhog (
+  runMigration )
+import Database.Groundhog.Core ( Migration, PersistBackend )
+import Network.Services.TSN.Report ( report_info )
 
+-- Local imports
 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.
+
+  | 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.
@@ -28,7 +42,21 @@ class DbImport a where
   -- created/used by the type @a@.
   dbmigrate :: (MonadIO m, PersistBackend m) => a -> m ()
 
+
+-- | The simplest possible implementation of 'dbimport', for types
+--   which happen to be members of the XmlImport typeclass.
+--
 dbimport_generic :: (XmlImport a, MonadIO m, PersistBackend m)
                  => a
                  -> m ImportResult
 dbimport_generic x = insert_xml x >> return ImportSucceeded
+
+
+-- | A migration runner that will use our normal info reporting
+--   mechanism.
+run_dbmigrate :: (MonadIO m, PersistBackend m) => Migration m -> m ()
+run_dbmigrate =
+  runMigration pretty_migration_logger
+  where
+    pretty_migration_logger x =
+      report_info ("Migration: " ++ x ++ ";")
-- 
2.44.2