-- | Definition of the DbImport typeclass.
module TSN.DbImport
where

import Control.Monad.IO.Class ( MonadIO )
import Database.Groundhog (
  defaultMigrationLogger,
  insert,
  migrate,
  runMigration )
import Database.Groundhog.Core ( PersistBackend, PersistEntity )
import Text.XML.HXT.Core (
  XmlPickler,
  XmlTree,
  unpickleDoc,
  xpickle )


-- | The type that will be returned from every file import attempt. If
--   there was an error, its description will be wrapped in an Err. If
--   we successfully imported records, the number of records imported
--   will be wrapped in a Succ.
--
--   Anything else will be wrapped in a "Info" constructor;
--   i.e. somewhere between success and failure. This is like an
--   'Either' with three choices. A "Info" return value means that
--   the XML document *was* processed, so it should be removed.
--
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 Int  -- ^ We did import records, and here's how many.
    | ImportUnsupported String -- ^ We didn't know how to process this file.
                               --   The second field should contain info.

-- | Instances of this type know how to insert themselves into a
--   Groundhog database.
class DbImport a where
  dbimport :: (MonadIO m, PersistBackend m)
           => a
           -> XmlTree
           -> m ImportResult


-- | We put the 'Configuration' and 'XmlTree' arguments last so that
-- it's easy to eta reduce all of the import_foo functions that call
-- this.
--
import_generic :: (XmlPickler a, MonadIO m, PersistEntity b, PersistBackend m)
               => (a -> [b]) -- ^ listings getter
               -> b          -- ^ Dummy Listing instance needed for 'migrate'
               -> XmlTree
               -> m ImportResult -- ^ Return the number of records inserted.
import_generic g dummy xml = do
  runMigration defaultMigrationLogger $ migrate dummy
  let root_element = unpickleDoc xpickle xml
  case root_element of
    Nothing -> return $
                 ImportFailed "Could not unpickle document in import_generic."
    Just elt  -> do
      ids <- mapM insert (g elt)
      return $ ImportSucceeded (length ids)