DbImport.hs

-- | Definition of the DbImport typeclass.
--
--   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(..),
  dbimport_generic,
  run_dbmigrate )
where

-- System imports
import Control.Monad.IO.Class ( MonadIO )
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.


-- | 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@.
  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 ++ ";")