-- | Definition of the DbImport typeclass.
-module TSN.DbImport
+--
+-- When we parse an XML tree, there are two functions that we would
+-- like to call on the result independent of its type. First, we
+-- would like to be able to run the database migrations for that
+-- type. The migrations are kept separate from insertion because, at
+-- some later point, it make make sense to disable automatic
+-- migrations.
+--
+-- Next we want to import the thing.
+--
+-- Neither of these should depend on the type -- we should just be
+-- able to call 'dbmigrate' followed by 'dbimport' on the
+-- datastructure and have the right thing happen. That is the
+-- purpose of the 'DbImport' typeclass. It allows the XML types to
+-- define their own \"migrate me\" and \"insert me\" functions that
+-- the rest of the application doesn't have to care about.
+--
+module TSN.DbImport (
+ DbImport(..),
+ ImportResult(..),
+ run_dbmigrate )
where
-import Control.Monad.IO.Class ( MonadIO )
-import Database.Groundhog.Core ( PersistBackend )
+-- System imports
+import Control.Monad ( forM_ )
+import Control.Monad.IO.Class ( MonadIO( liftIO ) )
+import qualified Data.Map as Map ( elems )
+import Database.Groundhog ( executeRaw )
+import Database.Groundhog.Generic (
+ createMigration,
+ getQueries,
+ mergeMigrations )
+import Database.Groundhog.Core ( Migration, NamedMigrations, PersistBackend )
+import Network.Services.TSN.Report ( report_info )
-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.
+
+ | 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 run their own database
+-- migrations and insert themselves into a database.
--
class DbImport a where
-- | 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@.
+ -- created/used by the type @a@.
dbmigrate :: (MonadIO m, PersistBackend m) => a -> m ()
-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. The top-level code was stolen from 'runMigration' in
+-- "Data.Groundhog.Generic" and the 'execute_pretty' code was stolen
+-- from 'executeMigration'' in the same module.
+--
+run_dbmigrate :: (MonadIO m, PersistBackend m) => Migration m -> m ()
+run_dbmigrate migration = createMigration migration >>= execute_pretty
+ where
+ execute_pretty :: (PersistBackend m, MonadIO m) => NamedMigrations -> m ()
+ execute_pretty m = do
+ let migs = getQueries False $ mergeMigrations $ Map.elems m
+ case migs of
+ Left errs -> fail $ unlines errs
+ Right qs -> forM_ qs $ \q -> do
+ liftIO $ report_info ("Migration: " ++ q ++ ";")
+ executeRaw False q []