1 {-# LANGUAGE FlexibleContexts #-}
4 -- | Definition of the XmlImport class.
10 import Database.Groundhog (
14 import Database.Groundhog.Core ( PersistBackend, PersistEntity )
16 import Xml ( FromXml(..) )
19 -- | In Groundhog, there is a typeclass of things you can insert into
20 -- the database. What we usually have, though, is an XML
21 -- representation of something that has a Groundhog analogue that we
22 -- could insert into the database. It would be real nice if we could
23 -- just insert the XML thing and not have to convert back and
24 -- forth. That's what the 'XmlImport' class lets you do.
26 -- Moreover, there is a contraint on the class that the type must
27 -- also be a member of the 'FromXml' class. This allows us to define
28 -- default implementations of \"insert me\" generically. Given any
29 -- XML thing that can be converted to a database thing, we just do
30 -- the conversion and then insert normally (however Groundhog would
33 class (FromXml a, PersistEntity (Db a)) => XmlImport a where
34 -- | This is similar to the signature for Groundhog's 'insert'
35 -- function, except the 'AutoKey' we return is for our 'Db'
37 insert_xml :: (PersistBackend m) => a -> m (AutoKey (Db a))
38 insert_xml x = insert (from_xml x)
40 -- | Same rationale as 'insert_xml', except it uses 'insertByAll'.
41 insertByAll_xml :: (PersistBackend m)
43 -> m ( Either (AutoKey (Db a)) (AutoKey (Db a)) )
44 insertByAll_xml x = insertByAll (from_xml x)
47 -- | Try to insert the given object and get its primary key
48 -- back. Or, if there's a unique constraint violation, get the
49 -- primary key of the unique thing already present.
51 -- Note: we can switch to using fmap here as soon as Functor is a
52 -- superclass of Monad (PersistBackend is a Monad).
54 insert_xml_or_select :: (PersistBackend m)
57 insert_xml_or_select x = do
58 tmp <- insertByAll_xml x
59 return $ (either id id) tmp