src/TSN/XmlImport.hs

   1 {-# LANGUAGE FlexibleContexts #-}
   2 {-# LANGUAGE GADTs #-}
   3
   4 module TSN.XmlImport (
   5   XmlImport(..) )
   6 where
   7
   8 import Database.Groundhog (
   9   AutoKey,
  10   insert,
  11   insertByAll )
  12 import Database.Groundhog.Core ( PersistBackend, PersistEntity )
  13
  14 import Xml ( FromXml(..) )
  15
  16
  17 class (FromXml a, PersistEntity (Db a)) => XmlImport a where
  18   -- | This is similar to the signature for Groundhog's 'insert'
  19   --   function, except the 'AutoKey' we return is for our 'Db'
  20   --   counterpart.
  21   insert_xml :: (PersistBackend m) => a ->  m (AutoKey (Db a))
  22   insert_xml x = insert (from_xml x)
  23
  24   -- | Same rationale as 'insert_xml', except it uses 'insertByAll'.
  25   insertByAll_xml :: (PersistBackend m)
  26                   => a
  27                   -> m ( Either (AutoKey (Db a)) (AutoKey (Db a)) )
  28   insertByAll_xml x = insertByAll (from_xml x)
  29
  30
  31   -- | Try to insert the given object and get its primary key
  32   --   back. Or, if there's a unique constraint violation, get the
  33   --   primary key of the unique thing already present.
  34   --
  35   --   Note: we can switch to using fmap here as soon as Functor is a
  36   --   superclass of Monad (PersistBackend is a Monad).
  37   --
  38   insert_xml_or_select :: (PersistBackend m)
  39                        => a
  40                        -> m (AutoKey (Db a))
  41   insert_xml_or_select x = do
  42     tmp <- insertByAll_xml x
  43     return $ (either id id) tmp