@@ -1,4 +1,6 @@
1−{-# LANGUAGE RecordWildCards #-}
1+{-# LANGUAGE FlexibleContexts #-}
2+{-# LANGUAGE RecordWildCards, FlexibleInstances, DefaultSignatures #-}
3+
24
35------------------------------------------------------------------------------
46-- |
@@ -7,13 +9,15 @@
79-- License: BSD3
810-- Maintainer: Leon P Smith <leon@melding-monads.com>
911-- Stability: experimental
10−-- Portability: portable
1112--
1213-- The 'FromRow' typeclass, for converting a row of results
1314-- returned by a SQL query into a more useful Haskell representation.
1415--
1516-- Predefined instances are provided for tuples containing up to ten
16−-- elements.
17+-- elements. The instances for 'Maybe' types return 'Nothing' if all
18+-- the columns that would have been otherwise consumed are null, otherwise
19+-- it attempts a regular conversion.
20+--
1721------------------------------------------------------------------------------
1822
1923module Database.PostgreSQL.Simple.FromRow
@@ -24,32 +28,36 @@ module Database.PostgreSQL.Simple.FromRow
2428 , numFieldsRemaining
2529 ) where
2630
27−import Control.Applicative (Applicative(..), (<$>))
28−import Control.Monad (replicateM)
29−import Data.ByteString (ByteString)
31+import Prelude hiding (null)
32+import Control.Applicative (Applicative(..), (<$>), (<|>), (*>), liftA2)
33+import Control.Monad (replicateM, replicateM_)
34+import Control.Monad.Trans.State.Strict
35+import Control.Monad.Trans.Reader
36+import Control.Monad.Trans.Class
37+import Data.ByteString (ByteString)
3038import qualified Data.ByteString.Char8 as B
31−import Database.PostgreSQL.Simple.Types (Only(..))
39+import Data.Vector (Vector)
40+import qualified Data.Vector as V
41+import Database.PostgreSQL.Simple.Types (Only(..))
3242import qualified Database.PostgreSQL.LibPQ as PQ
3343import Database.PostgreSQL.Simple.Internal
3444import Database.PostgreSQL.Simple.Compat
3545import Database.PostgreSQL.Simple.FromField
3646import Database.PostgreSQL.Simple.Ok
37−import Database.PostgreSQL.Simple.Types ((:.)(..))
47+import Database.PostgreSQL.Simple.Types ((:.)(..), Null)
3848import Database.PostgreSQL.Simple.TypeInfo
3949
40−import Control.Monad.Trans.State.Strict
41−import Control.Monad.Trans.Reader
42−import Control.Monad.Trans.Class
50+import GHC.Generics
4351
44−import Data.Vector ((!))
4552
4653-- | A collection type that can be converted from a sequence of fields.
4754-- Instances are provided for tuples up to 10 elements and lists of any length.
4855--
49−-- Note that instances can defined outside of postgresql-simple, which is
56+-- Note that instances can be defined outside of postgresql-simple, which is
5057-- often useful. For example, here's an instance for a user-defined pair:
5158--
52−-- @data User = User { name :: String, fileQuota :: Int }
59+-- @
60+-- data User = User { name :: String, fileQuota :: Int }
5361--
5462-- instance 'FromRow' User where
5563-- fromRow = User \<$\> 'field' \<*\> 'field'
@@ -59,27 +67,47 @@ import Data.Vector ((!))
5967-- in a single row of the query result. Otherwise, a 'ConversionFailed'
6068-- exception will be thrown.
6169--
62−-- Note that 'field' evaluates it's result to WHNF, so the caveats listed in
63−-- previous versions of postgresql-simple no longer apply. Instead, look
64−-- at the caveats associated with user-defined implementations of 'fromRow'.
70+-- You can also derive 'FromRow' for your data type using GHC generics, like
71+-- this:
72+--
73+-- @
74+-- \{-# LANGUAGE DeriveAnyClass \#-}
75+-- \{-# LANGUAGE DeriveGeneric \#-}
76+--
77+-- import "GHC.Generics" ('GHC.Generics.Generic')
78+-- import "Database.PostgreSQL.Simple" ('FromRow')
79+--
80+-- data User = User { name :: String, fileQuota :: Int }
81+-- deriving ('GHC.Generics.Generic', 'FromRow')
82+-- @
83+--
84+-- Note that this only works for product types (e.g. records) and does not
85+-- support sum types or recursive types.
86+--
87+-- Note that 'field' evaluates its result to WHNF, so the caveats listed in
88+-- mysql-simple and very early versions of postgresql-simple no longer apply.
89+-- Instead, look at the caveats associated with user-defined implementations
90+-- of 'fromField'.
6591
6692class FromRow a where
6793 fromRow :: RowParser a
94+ default fromRow :: (Generic a, GFromRow (Rep a)) => RowParser a
95+ fromRow = to <$> gfromRow
6896
6997getvalue :: PQ.Result -> PQ.Row -> PQ.Column -> Maybe ByteString
70−getvalue result row col = unsafeDupablePerformIO (PQ.getvalue result row col)
98+getvalue result row col = unsafeDupablePerformIO (PQ.getvalue' result row col)
7199
72100nfields :: PQ.Result -> PQ.Column
73101nfields result = unsafeDupablePerformIO (PQ.nfields result)
74102
75103getTypeInfoByCol :: Row -> PQ.Column -> Conversion TypeInfo
76−getTypeInfoByCol Row{..} col =
104+getTypeInfoByCol Row{..} col =
77105 Conversion $ \conn -> do
78106 oid <- PQ.ftype rowresult col
79107 Ok <$> getTypeInfo conn oid
80108
81109getTypenameByCol :: Row -> PQ.Column -> Conversion ByteString
82−getTypenameByCol row col = typname . typ <$> getTypeInfoByCol row col
110+getTypenameByCol row col = typname <$> getTypeInfoByCol row col
83111
84112fieldWith :: FieldParser a -> RowParser a
85113fieldWith fieldP = RP $ do
@@ -103,8 +131,8 @@ fieldWith fieldP = RP $ do
103131 else do
104132 let !result = rowresult
105133 !typeOid = unsafeDupablePerformIO (PQ.ftype result column)
106− !field = Field{..}
107− lift (lift (fieldP field (getvalue result row column)))
134+ !field' = Field{..}
135+ lift (lift (fieldP field' (getvalue result row column)))
108136
109137field :: FromField a => RowParser a
110138field = fieldWith fromField
@@ -120,57 +148,340 @@ numFieldsRemaining = RP $ do
120148 column <- lift get
121149 return $! (\(PQ.Col x) -> fromIntegral x) (nfields rowresult - column)
122150
151+null :: RowParser Null
152+null = field
153+
123154instance (FromField a) => FromRow (Only a) where
124155 fromRow = Only <$> field
125156
157+instance (FromField a) => FromRow (Maybe (Only a)) where
158+ fromRow = (null *> pure Nothing)
159+ <|> (Just <$> fromRow)
160+
126161instance (FromField a, FromField b) => FromRow (a,b) where
127162 fromRow = (,) <$> field <*> field
128163
164+instance (FromField a, FromField b) => FromRow (Maybe (a,b)) where
165+ fromRow = (null *> null *> pure Nothing)
166+ <|> (Just <$> fromRow)
167+
129168instance (FromField a, FromField b, FromField c) => FromRow (a,b,c) where
130169 fromRow = (,,) <$> field <*> field <*> field
131170
171+instance (FromField a, FromField b, FromField c) => FromRow (Maybe (a,b,c)) where
172+ fromRow = (null *> null *> null *> pure Nothing)
173+ <|> (Just <$> fromRow)
174+
132175instance (FromField a, FromField b, FromField c, FromField d) =>
133176 FromRow (a,b,c,d) where
134177 fromRow = (,,,) <$> field <*> field <*> field <*> field
135178
179+instance (FromField a, FromField b, FromField c, FromField d) =>
180+ FromRow (Maybe (a,b,c,d)) where
181+ fromRow = (null *> null *> null *> null *> pure Nothing)
182+ <|> (Just <$> fromRow)
183+
136184instance (FromField a, FromField b, FromField c, FromField d, FromField e) =>
137185 FromRow (a,b,c,d,e) where
138186 fromRow = (,,,,) <$> field <*> field <*> field <*> field <*> field
139187
188+instance (FromField a, FromField b, FromField c, FromField d, FromField e) =>
189+ FromRow (Maybe (a,b,c,d,e)) where
190+ fromRow = (null *> null *> null *> null *> null *> pure Nothing)
191+ <|> (Just <$> fromRow)
192+
140193instance (FromField a, FromField b, FromField c, FromField d, FromField e,
141194 FromField f) =>
142195 FromRow (a,b,c,d,e,f) where
143196 fromRow = (,,,,,) <$> field <*> field <*> field <*> field <*> field
144197 <*> field
145198
199+instance (FromField a, FromField b, FromField c, FromField d, FromField e,
200+ FromField f) =>
201+ FromRow (Maybe (a,b,c,d,e,f)) where
202+ fromRow = (null *> null *> null *> null *> null *>
203+ null *> pure Nothing)
204+ <|> (Just <$> fromRow)
205+
146206instance (FromField a, FromField b, FromField c, FromField d, FromField e,
147207 FromField f, FromField g) =>
148208 FromRow (a,b,c,d,e,f,g) where
149209 fromRow = (,,,,,,) <$> field <*> field <*> field <*> field <*> field
150210 <*> field <*> field
151211
212+instance (FromField a, FromField b, FromField c, FromField d, FromField e,
213+ FromField f, FromField g) =>
214+ FromRow (Maybe (a,b,c,d,e,f,g)) where
215+ fromRow = (null *> null *> null *> null *> null *>
216+ null *> null *> pure Nothing)
217+ <|> (Just <$> fromRow)
218+
152219instance (FromField a, FromField b, FromField c, FromField d, FromField e,
153220 FromField f, FromField g, FromField h) =>
154221 FromRow (a,b,c,d,e,f,g,h) where
155222 fromRow = (,,,,,,,) <$> field <*> field <*> field <*> field <*> field
156223 <*> field <*> field <*> field
157224
225+instance (FromField a, FromField b, FromField c, FromField d, FromField e,
226+ FromField f, FromField g, FromField h) =>
227+ FromRow (Maybe (a,b,c,d,e,f,g,h)) where
228+ fromRow = (null *> null *> null *> null *> null *>
229+ null *> null *> null *> pure Nothing)
230+ <|> (Just <$> fromRow)
231+
158232instance (FromField a, FromField b, FromField c, FromField d, FromField e,
159233 FromField f, FromField g, FromField h, FromField i) =>
160234 FromRow (a,b,c,d,e,f,g,h,i) where
161235 fromRow = (,,,,,,,,) <$> field <*> field <*> field <*> field <*> field
162236 <*> field <*> field <*> field <*> field
163237
238+instance (FromField a, FromField b, FromField c, FromField d, FromField e,
239+ FromField f, FromField g, FromField h, FromField i) =>
240+ FromRow (Maybe (a,b,c,d,e,f,g,h,i)) where
241+ fromRow = (null *> null *> null *> null *> null *>
242+ null *> null *> null *> null *> pure Nothing)
243+ <|> (Just <$> fromRow)
244+
164245instance (FromField a, FromField b, FromField c, FromField d, FromField e,
165246 FromField f, FromField g, FromField h, FromField i, FromField j) =>
166247 FromRow (a,b,c,d,e,f,g,h,i,j) where
167248 fromRow = (,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field
168249 <*> field <*> field <*> field <*> field <*> field
169250
251+instance (FromField a, FromField b, FromField c, FromField d, FromField e,
252+ FromField f, FromField g, FromField h, FromField i, FromField j) =>
253+ FromRow (Maybe (a,b,c,d,e,f,g,h,i,j)) where
254+ fromRow = (null *> null *> null *> null *> null *>
255+ null *> null *> null *> null *> null *> pure Nothing)
256+ <|> (Just <$> fromRow)
257+
258+instance (FromField a, FromField b, FromField c, FromField d, FromField e,
259+ FromField f, FromField g, FromField h, FromField i, FromField j,
260+ FromField k) =>
261+ FromRow (a,b,c,d,e,f,g,h,i,j,k) where
262+ fromRow = (,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field
263+ <*> field <*> field <*> field <*> field <*> field
264+ <*> field
265+
266+instance (FromField a, FromField b, FromField c, FromField d, FromField e,
267+ FromField f, FromField g, FromField h, FromField i, FromField j,
268+ FromField k) =>
269+ FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k)) where
270+ fromRow = (null *> null *> null *> null *> null *>
271+ null *> null *> null *> null *> null *>
272+ null *> pure Nothing)
273+ <|> (Just <$> fromRow)
274+
275+instance (FromField a, FromField b, FromField c, FromField d, FromField e,
276+ FromField f, FromField g, FromField h, FromField i, FromField j,
277+ FromField k, FromField l) =>
278+ FromRow (a,b,c,d,e,f,g,h,i,j,k,l) where
279+ fromRow = (,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field
280+ <*> field <*> field <*> field <*> field <*> field
281+ <*> field <*> field
282+
283+instance (FromField a, FromField b, FromField c, FromField d, FromField e,
284+ FromField f, FromField g, FromField h, FromField i, FromField j,
285+ FromField k, FromField l) =>
286+ FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l)) where
287+ fromRow = (null *> null *> null *> null *> null *>
288+ null *> null *> null *> null *> null *>
289+ null *> null *> pure Nothing)
290+ <|> (Just <$> fromRow)
291+
292+instance (FromField a, FromField b, FromField c, FromField d, FromField e,
293+ FromField f, FromField g, FromField h, FromField i, FromField j,
294+ FromField k, FromField l, FromField m) =>
295+ FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m) where
296+ fromRow = (,,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field
297+ <*> field <*> field <*> field <*> field <*> field
298+ <*> field <*> field <*> field
299+
300+instance (FromField a, FromField b, FromField c, FromField d, FromField e,
301+ FromField f, FromField g, FromField h, FromField i, FromField j,
302+ FromField k, FromField l, FromField m) =>
303+ FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m)) where
304+ fromRow = (null *> null *> null *> null *> null *>
305+ null *> null *> null *> null *> null *>
306+ null *> null *> null *> pure Nothing)
307+ <|> (Just <$> fromRow)
308+
309+instance (FromField a, FromField b, FromField c, FromField d, FromField e,
310+ FromField f, FromField g, FromField h, FromField i, FromField j,
311+ FromField k, FromField l, FromField m, FromField n) =>
312+ FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where
313+ fromRow = (,,,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field
314+ <*> field <*> field <*> field <*> field <*> field
315+ <*> field <*> field <*> field <*> field
316+
317+instance (FromField a, FromField b, FromField c, FromField d, FromField e,
318+ FromField f, FromField g, FromField h, FromField i, FromField j,
319+ FromField k, FromField l, FromField m, FromField n) =>
320+ FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m,n)) where
321+ fromRow = (null *> null *> null *> null *> null *>
322+ null *> null *> null *> null *> null *>
323+ null *> null *> null *> null *> pure Nothing)
324+ <|> (Just <$> fromRow)
325+
326+instance (FromField a, FromField b, FromField c, FromField d, FromField e,
327+ FromField f, FromField g, FromField h, FromField i, FromField j,
328+ FromField k, FromField l, FromField m, FromField n, FromField o) =>
329+ FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where
330+ fromRow = (,,,,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field
331+ <*> field <*> field <*> field <*> field <*> field
332+ <*> field <*> field <*> field <*> field <*> field
333+
334+instance (FromField a, FromField b, FromField c, FromField d, FromField e,
335+ FromField f, FromField g, FromField h, FromField i, FromField j,
336+ FromField k, FromField l, FromField m, FromField n, FromField o) =>
337+ FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o)) where
338+ fromRow = (null *> null *> null *> null *> null *>
339+ null *> null *> null *> null *> null *>
340+ null *> null *> null *> null *> null *> pure Nothing)
341+ <|> (Just <$> fromRow)
342+
343+instance (FromField a, FromField b, FromField c, FromField d, FromField e,
344+ FromField f, FromField g, FromField h, FromField i, FromField j,
345+ FromField k, FromField l, FromField m, FromField n, FromField o,
346+ FromField p) =>
347+ FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) where
348+ fromRow = (,,,,,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field
349+ <*> field <*> field <*> field <*> field <*> field
350+ <*> field <*> field <*> field <*> field <*> field
351+ <*> field
352+
353+instance (FromField a, FromField b, FromField c, FromField d, FromField e,
354+ FromField f, FromField g, FromField h, FromField i, FromField j,
355+ FromField k, FromField l, FromField m, FromField n, FromField o,
356+ FromField p) =>
357+ FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p)) where
358+ fromRow = (null *> null *> null *> null *> null *>
359+ null *> null *> null *> null *> null *>
360+ null *> null *> null *> null *> null *>
361+ null *> pure Nothing)
362+ <|> (Just <$> fromRow)
363+
364+instance (FromField a, FromField b, FromField c, FromField d, FromField e,
365+ FromField f, FromField g, FromField h, FromField i, FromField j,
366+ FromField k, FromField l, FromField m, FromField n, FromField o,
367+ FromField p, FromField q) =>
368+ FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q) where
369+ fromRow = (,,,,,,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field
370+ <*> field <*> field <*> field <*> field <*> field
371+ <*> field <*> field <*> field <*> field <*> field
372+ <*> field <*> field
373+
374+instance (FromField a, FromField b, FromField c, FromField d, FromField e,
375+ FromField f, FromField g, FromField h, FromField i, FromField j,
376+ FromField k, FromField l, FromField m, FromField n, FromField o,
377+ FromField p, FromField q) =>
378+ FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q)) where
379+ fromRow = (null *> null *> null *> null *> null *>
380+ null *> null *> null *> null *> null *>
381+ null *> null *> null *> null *> null *>
382+ null *> null *> pure Nothing)
383+ <|> (Just <$> fromRow)
384+
385+instance (FromField a, FromField b, FromField c, FromField d, FromField e,
386+ FromField f, FromField g, FromField h, FromField i, FromField j,
387+ FromField k, FromField l, FromField m, FromField n, FromField o,
388+ FromField p, FromField q, FromField r) =>
389+ FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r) where
390+ fromRow = (,,,,,,,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field
391+ <*> field <*> field <*> field <*> field <*> field
392+ <*> field <*> field <*> field <*> field <*> field
393+ <*> field <*> field <*> field
394+
395+instance (FromField a, FromField b, FromField c, FromField d, FromField e,
396+ FromField f, FromField g, FromField h, FromField i, FromField j,
397+ FromField k, FromField l, FromField m, FromField n, FromField o,
398+ FromField p, FromField q, FromField r) =>
399+ FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r)) where
400+ fromRow = (null *> null *> null *> null *> null *>
401+ null *> null *> null *> null *> null *>
402+ null *> null *> null *> null *> null *>
403+ null *> null *> null *> pure Nothing)
404+ <|> (Just <$> fromRow)
405+
406+instance (FromField a, FromField b, FromField c, FromField d, FromField e,
407+ FromField f, FromField g, FromField h, FromField i, FromField j,
408+ FromField k, FromField l, FromField m, FromField n, FromField o,
409+ FromField p, FromField q, FromField r, FromField s) =>
410+ FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s) where
411+ fromRow = (,,,,,,,,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field
412+ <*> field <*> field <*> field <*> field <*> field
413+ <*> field <*> field <*> field <*> field <*> field
414+ <*> field <*> field <*> field <*> field
415+
416+instance (FromField a, FromField b, FromField c, FromField d, FromField e,
417+ FromField f, FromField g, FromField h, FromField i, FromField j,
418+ FromField k, FromField l, FromField m, FromField n, FromField o,
419+ FromField p, FromField q, FromField r, FromField s) =>
420+ FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s)) where
421+ fromRow = (null *> null *> null *> null *> null *>
422+ null *> null *> null *> null *> null *>
423+ null *> null *> null *> null *> null *>
424+ null *> null *> null *> null *> pure Nothing)
425+ <|> (Just <$> fromRow)
426+
427+instance (FromField a, FromField b, FromField c, FromField d, FromField e,
428+ FromField f, FromField g, FromField h, FromField i, FromField j,
429+ FromField k, FromField l, FromField m, FromField n, FromField o,
430+ FromField p, FromField q, FromField r, FromField s, FromField t) =>
431+ FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t) where
432+ fromRow = (,,,,,,,,,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field
433+ <*> field <*> field <*> field <*> field <*> field
434+ <*> field <*> field <*> field <*> field <*> field
435+ <*> field <*> field <*> field <*> field <*> field
436+
437+instance (FromField a, FromField b, FromField c, FromField d, FromField e,
438+ FromField f, FromField g, FromField h, FromField i, FromField j,
439+ FromField k, FromField l, FromField m, FromField n, FromField o,
440+ FromField p, FromField q, FromField r, FromField s, FromField t) =>
441+ FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t)) where
442+ fromRow = (null *> null *> null *> null *> null *>
443+ null *> null *> null *> null *> null *>
444+ null *> null *> null *> null *> null *>
445+ null *> null *> null *> null *> null *> pure Nothing)
446+ <|> (Just <$> fromRow)
447+
170448instance FromField a => FromRow [a] where
171449 fromRow = do
172450 n <- numFieldsRemaining
173451 replicateM n field
174452
453+instance FromField a => FromRow (Maybe [a]) where
454+ fromRow = do
455+ n <- numFieldsRemaining
456+ (replicateM_ n null *> pure Nothing) <|> (Just <$> replicateM n field)
457+
458+instance FromField a => FromRow (Vector a) where
459+ fromRow = do
460+ n <- numFieldsRemaining
461+ V.replicateM n field
462+
463+instance FromField a => FromRow (Maybe (Vector a)) where
464+ fromRow = do
465+ n <- numFieldsRemaining
466+ (replicateM_ n null *> pure Nothing) <|> (Just <$> V.replicateM n field)
467+
175468instance (FromRow a, FromRow b) => FromRow (a :. b) where
176469 fromRow = (:.) <$> fromRow <*> fromRow
470+
471+
472+
473+-- Type class for default implementation of FromRow using generics
474+class GFromRow f where
475+ gfromRow :: RowParser (f p)
476+
477+instance GFromRow f => GFromRow (M1 c i f) where
478+ gfromRow = M1 <$> gfromRow
479+
480+instance (GFromRow f, GFromRow g) => GFromRow (f :*: g) where
481+ gfromRow = liftA2 (:*:) gfromRow gfromRow
482+
483+instance (FromField a) => GFromRow (K1 R a) where
484+ gfromRow = K1 <$> field
485+
486+instance GFromRow U1 where
487+ gfromRow = pure U1