1 {-# LANGUAGE FlexibleContexts #-}
4 -- | Definition of the XmlImport class.
13 import Database.Groundhog (
19 import Database.Groundhog.Core ( PersistBackend, PersistEntity )
23 import TSN.Team ( Team(..) )
32 -- | In Groundhog, there is a typeclass of things you can insert into
33 -- the database. What we usually have, though, is an XML
34 -- representation of something that has a Groundhog analogue that we
35 -- could insert into the database. It would be real nice if we could
36 -- just insert the XML thing and not have to convert back and
37 -- forth. That's what the 'XmlImport' class lets you do.
39 -- Moreover, there is a contraint on the class that the type must
40 -- also be a member of the 'FromXml' class. This allows us to define
41 -- default implementations of \"insert me\" generically. Given any
42 -- XML thing that can be converted to a database thing, we just do
43 -- the conversion and then insert normally (however Groundhog would
46 class (FromXml a, PersistEntity (Db a)) => XmlImport a where
47 -- | This is similar to the signature for Groundhog's 'insert'
48 -- function, except the 'AutoKey' we return is for our 'Db'
50 insert_xml :: (PersistBackend m) => a -> m (AutoKey (Db a))
51 insert_xml = insert . from_xml
53 -- | Identical to 'insert_xml', except it doesn't return anything.
54 insert_xml_ :: (PersistBackend m) => a -> m ()
55 insert_xml_ = insert_ . from_xml
57 -- | Same rationale as 'insert_xml', except it uses 'insertByAll'.
58 insertByAll_xml :: (PersistBackend m)
60 -> m ( Either (AutoKey (Db a)) (AutoKey (Db a)) )
61 insertByAll_xml = insertByAll . from_xml
64 -- | Try to insert the given object and get its primary key
65 -- back. Or, if there's a unique constraint violation, get the
66 -- primary key of the unique thing already present.
68 -- Note: we can switch to using fmap here as soon as Functor is a
69 -- superclass of Monad (PersistBackend is a Monad).
71 insert_xml_or_select :: (PersistBackend m)
74 insert_xml_or_select x = do
75 tmp <- insertByAll_xml x
76 return $ (either id id) tmp
80 -- | A total copy of 'XmlImport' for instances of 'FromXmlFk'.
82 class (Child a, FromXmlFk a, PersistEntity (Db a)) => XmlImportFk a where
83 insert_xml_fk :: (PersistBackend m)
84 => DefaultKey (Parent a)
87 insert_xml_fk fk x = insert $ from_xml_fk fk x
89 insert_xml_fk_ :: (PersistBackend m) => DefaultKey (Parent a) -> a -> m ()
90 insert_xml_fk_ fk x = insert_ $ from_xml_fk fk x
92 insertByAll_xml_fk :: (PersistBackend m)
93 => DefaultKey (Parent a)
95 -> m ( Either (AutoKey (Db a)) (AutoKey (Db a)) )
96 insertByAll_xml_fk fk x = insertByAll $ from_xml_fk fk x
98 insert_xml_or_select_fk :: (PersistBackend m)
99 => DefaultKey (Parent a)
101 -> m (AutoKey (Db a))
102 insert_xml_or_select_fk fk x = do
103 tmp <- insertByAll_xml_fk fk x
104 return $ (either id id) tmp
107 -- | A total copy of 'XmlImport' for instances of 'FromXmlFkTeams'.
108 -- This is a lot of duplicated boilerplate, but you don't have to
109 -- think about it usually. What you're really worried about is that
110 -- the dbimport code is understandable, and having these convenience
111 -- classes makes the import much simpler since you don't have to do
112 -- these conversions on-the-fly.
116 PersistEntity (Db a))
117 => XmlImportFkTeams a where
118 insert_xml_fk_teams :: (PersistBackend m)
119 => DefaultKey (Parent a)
120 -> DefaultKey Team -- ^ Away team FK
121 -> DefaultKey Team -- ^ Home team FK
123 -> m (AutoKey (Db a))
124 insert_xml_fk_teams fk fk_away fk_home x =
125 insert $ from_xml_fk_teams fk fk_away fk_home x
127 insert_xml_fk_teams_ :: (PersistBackend m)
128 => DefaultKey (Parent a)
133 insert_xml_fk_teams_ fk fk_away fk_home x =
134 insert_ $ from_xml_fk_teams fk fk_away fk_home x
136 insertByAll_xml_fk_teams :: (PersistBackend m)
137 => DefaultKey (Parent a)
141 -> m ( Either (AutoKey (Db a)) (AutoKey (Db a)) )
142 insertByAll_xml_fk_teams fk fk_away fk_home x =
143 insertByAll $ from_xml_fk_teams fk fk_away fk_home x
145 insert_xml_or_select_fk_teams :: (PersistBackend m)
146 => DefaultKey (Parent a)
150 -> m (AutoKey (Db a))
151 insert_xml_or_select_fk_teams fk fk_away fk_home x = do
152 tmp <- insertByAll_xml_fk_teams fk fk_away fk_home x
153 return $ (either id id) tmp