src/TSN/DbImport.hs

   1 -- | Definition of the DbImport typeclass.
   2 --
   3 --   When we parse an XML tree, there are two functions that we would
   4 --   like to call on the result independent of its type. First, we
   5 --   would like to be able to run the database migrations for that
   6 --   type. The migrations are kept separate from insertion because, at
   7 --   some later point, it make make sense to disable automatic
   8 --   migrations.
   9 --
  10 --   Next we want to import the thing.
  11 --
  12 --   Neither of these should depend on the type -- we should just be
  13 --   able to call 'dbmigrate' followed by 'dbimport' on the
  14 --   datastructure and have the right thing happen. That is the
  15 --   purpose of the 'DbImport' typeclass. It allows the XML types to
  16 --   define their own \"migrate me\" and \"insert me\" functions that
  17 --   the rest of the application doesn't have to care about.
  18 --
  19 module TSN.DbImport (
  20   DbImport(..),
  21   ImportResult(..),
  22   run_dbmigrate )
  23 where
  24
  25 -- System imports
  26 import Control.Monad.IO.Class ( MonadIO )
  27 import Database.Groundhog ( runMigration )
  28 import Database.Groundhog.Core ( Migration, PersistBackend )
  29 import Network.Services.TSN.Report ( report_info )
  30
  31
  32 -- | The type that will be returned from every file import attempt.
  33 --
  34 data ImportResult =
  35   ImportFailed String -- ^ Failure with an error message.
  36
  37   | ImportSkipped String -- ^ We processed the file, but didn't import it.
  38                          --   The reason is contained in the second field.
  39
  40   | ImportSucceeded      -- ^ We did import records.
  41
  42   | ImportUnsupported String -- ^ We didn't know how to process this file.
  43                              --   The second field should contain info.
  44
  45
  46 -- | Instances of this type know how to run their own database
  47 --   migrations and insert themselves into a database.
  48 --
  49 class DbImport a where
  50   -- | Import an instance of type @a@.
  51   dbimport :: (PersistBackend m) => a -> m ImportResult
  52
  53   -- | This must migrate *all* stuffs that can potentially be
  54   --   created/used by the type @a@.
  55   dbmigrate :: (MonadIO m, PersistBackend m) => a -> m ()
  56
  57
  58 -- | A migration runner that will use our normal info reporting
  59 --   mechanism.
  60 --
  61 run_dbmigrate :: (MonadIO m, PersistBackend m) => Migration m -> m ()
  62 run_dbmigrate =
  63   runMigration pretty_migration_logger
  64   where
  65     pretty_migration_logger x =
  66       report_info ("Migration: " ++ x ++ ";")