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 -- Local imports
  32 import TSN.XmlImport ( XmlImport(..) )
  33
  34
  35 -- | The type that will be returned from every file import attempt.
  36 --
  37 data ImportResult =
  38   ImportFailed String -- ^ Failure with an error message.
  39
  40   | ImportSkipped String -- ^ We processed the file, but didn't import it.
  41                          --   The reason is contained in the second field.
  42
  43   | ImportSucceeded      -- ^ We did import records.
  44
  45   | ImportUnsupported String -- ^ We didn't know how to process this file.
  46                              --   The second field should contain info.
  47
  48
  49 -- | Instances of this type know how to run their own database
  50 --   migrations and insert themselves into a database.
  51 --
  52 class DbImport a where
  53   -- | Import an instance of type @a@.
  54   dbimport :: (PersistBackend m) => a -> m ImportResult
  55
  56   -- | This must migrate *all* stuffs that can potentially be
  57   --   created/used by the type @a@.
  58   dbmigrate :: (MonadIO m, PersistBackend m) => a -> m ()
  59
  60
  61 -- | A migration runner that will use our normal info reporting
  62 --   mechanism.
  63 --
  64 run_dbmigrate :: (MonadIO m, PersistBackend m) => Migration m -> m ()
  65 run_dbmigrate =
  66   runMigration pretty_migration_logger
  67   where
  68     pretty_migration_logger x =
  69       report_info ("Migration: " ++ x ++ ";")