From: Michael Orlitzky Date: Sat, 11 Jan 2014 23:33:23 +0000 (-0500) Subject: Add run_dbmigrate to TSN.DbImport. X-Git-Tag: 0.0.1~97 X-Git-Url: https://gitweb.michael.orlitzky.com/?a=commitdiff_plain;h=a913a63f7679b59f9b650619e8fbfc6e81f3f8d3;p=dead%2Fhtsn-import.git Add run_dbmigrate to TSN.DbImport. --- 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 ++ ";")