src/TSN/DbImport.hs

   1 -- | Definition of the DbImport typeclass.
   2 module TSN.DbImport (
   3   DbImport(..),
   4   ImportResult(..),
   5   dbimport_generic,
   6   run_dbmigrate )
   7 where
   8
   9 -- System imports
  10 import Control.Monad.IO.Class ( MonadIO )
  11 import Database.Groundhog (
  12   runMigration )
  13 import Database.Groundhog.Core ( Migration, PersistBackend )
  14 import Network.Services.TSN.Report ( report_info )
  15
  16 -- Local imports
  17 import TSN.XmlImport ( XmlImport(..) )
  18
  19
  20 -- | The type that will be returned from every file import attempt.
  21 --
  22 data ImportResult =
  23   ImportFailed String -- ^ Failure with an error message.
  24
  25   | ImportSkipped String -- ^ We processed the file, but didn't import it.
  26                          --   The reason is contained in the second field.
  27
  28   | ImportSucceeded      -- ^ We did import records.
  29
  30   | ImportUnsupported String -- ^ We didn't know how to process this file.
  31                              --   The second field should contain info.
  32
  33
  34 -- | Instances of this type know how to insert themselves into a
  35 --   Groundhog database.
  36 --
  37 class DbImport a where
  38   -- | Import an instance of type @a@.
  39   dbimport :: (PersistBackend m) => a -> m ImportResult
  40
  41   -- | This must migrate *all* stuffs that can potentially be
  42   -- created/used by the type @a@.
  43   dbmigrate :: (MonadIO m, PersistBackend m) => a -> m ()
  44
  45
  46 -- | The simplest possible implementation of 'dbimport', for types
  47 --   which happen to be members of the XmlImport typeclass.
  48 --
  49 dbimport_generic :: (XmlImport a, MonadIO m, PersistBackend m)
  50                  => a
  51                  -> m ImportResult
  52 dbimport_generic x = insert_xml x >> return ImportSucceeded
  53
  54
  55 -- | A migration runner that will use our normal info reporting
  56 --   mechanism.
  57 run_dbmigrate :: (MonadIO m, PersistBackend m) => Migration m -> m ()
  58 run_dbmigrate =
  59   runMigration pretty_migration_logger
  60   where
  61     pretty_migration_logger x =
  62       report_info ("Migration: " ++ x ++ ";")