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   dbimport_generic,
  23   run_dbmigrate )
  24 where
  25
  26 -- System imports
  27 import Control.Monad.IO.Class ( MonadIO )
  28 import Database.Groundhog (
  29   runMigration )
  30 import Database.Groundhog.Core ( Migration, PersistBackend )
  31 import Network.Services.TSN.Report ( report_info )
  32
  33 -- Local imports
  34 import TSN.XmlImport ( XmlImport(..) )
  35
  36
  37 -- | The type that will be returned from every file import attempt.
  38 --
  39 data ImportResult =
  40   ImportFailed String -- ^ Failure with an error message.
  41
  42   | ImportSkipped String -- ^ We processed the file, but didn't import it.
  43                          --   The reason is contained in the second field.
  44
  45   | ImportSucceeded      -- ^ We did import records.
  46
  47   | ImportUnsupported String -- ^ We didn't know how to process this file.
  48                              --   The second field should contain info.
  49
  50
  51 -- | Instances of this type know how to run their own database
  52 --   migrations and insert themselves into a database.
  53 --
  54 class DbImport a where
  55   -- | Import an instance of type @a@.
  56   dbimport :: (PersistBackend m) => a -> m ImportResult
  57
  58   -- | This must migrate *all* stuffs that can potentially be
  59   --   created/used by the type @a@.
  60   dbmigrate :: (MonadIO m, PersistBackend m) => a -> m ()
  61
  62
  63 -- | The simplest possible implementation of 'dbimport', for types
  64 --   which happen to be members of the 'XmlImport' typeclass.
  65 --
  66 dbimport_generic :: (XmlImport a, MonadIO m, PersistBackend m)
  67                  => a
  68                  -> m ImportResult
  69 dbimport_generic x = insert_xml x >> return ImportSucceeded
  70
  71
  72 -- | A migration runner that will use our normal info reporting
  73 --   mechanism.
  74 --
  75 run_dbmigrate :: (MonadIO m, PersistBackend m) => Migration m -> m ()
  76 run_dbmigrate =
  77   runMigration pretty_migration_logger
  78   where
  79     pretty_migration_logger x =
  80       report_info ("Migration: " ++ x ++ ";")