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