git.iko.soy/typeable/postgresql-simple
on master help sign in
Implement default instances for {To,From}Row using Generic
943b534Alexey Khudyakov
postgresql-simple.cabal+1−1
compare with master
unifiedsplit
@@ -53,7 +53,7 @@ Library
53 Build-depends:
53 Build-depends:
54 aeson >= 0.6,
54 aeson >= 0.6,
55 attoparsec >= 0.10.3,
55 attoparsec >= 0.10.3,
56− base < 5,
56+ base >= 4.4 && < 5,
57 bytestring >= 0.9,
57 bytestring >= 0.9,
58 bytestring-builder,
58 bytestring-builder,
59 case-insensitive,
59 case-insensitive,
src/Database/PostgreSQL/Simple/FromRow.hs+27−2
@@ -1,4 +1,6 @@
1+{-# LANGUAGE FlexibleContexts #-}
1−{-# LANGUAGE RecordWildCards, FlexibleInstances #-}
2+{-# LANGUAGE RecordWildCards, FlexibleInstances, DefaultSignatures #-}
3+
2
4
3------------------------------------------------------------------------------
5------------------------------------------------------------------------------
4-- |
6-- |
@@ -27,7 +29,7 @@ module Database.PostgreSQL.Simple.FromRow
27 ) where
29 ) where
28
30
29import Prelude hiding (null)
31import Prelude hiding (null)
30−import Control.Applicative (Applicative(..), (<$>), (<|>), (*>))
32+import Control.Applicative (Applicative(..), (<$>), (<|>), (*>), liftA2)
31import Control.Monad (replicateM, replicateM_)
33import Control.Monad (replicateM, replicateM_)
32import Control.Monad.Trans.State.Strict
34import Control.Monad.Trans.State.Strict
33import Control.Monad.Trans.Reader
35import Control.Monad.Trans.Reader
@@ -45,6 +47,9 @@ import Database.PostgreSQL.Simple.Ok
45import Database.PostgreSQL.Simple.Types ((:.)(..), Null)
47import Database.PostgreSQL.Simple.Types ((:.)(..), Null)
46import Database.PostgreSQL.Simple.TypeInfo
48import Database.PostgreSQL.Simple.TypeInfo
47
49
50+import GHC.Generics
51+
52+
48-- | A collection type that can be converted from a sequence of fields.
53-- | A collection type that can be converted from a sequence of fields.
49-- Instances are provided for tuples up to 10 elements and lists of any length.
54-- Instances are provided for tuples up to 10 elements and lists of any length.
50--
55--
@@ -68,6 +73,8 @@ import Database.PostgreSQL.Simple.TypeInfo
68
73
69class FromRow a where
74class FromRow a where
70 fromRow :: RowParser a
75 fromRow :: RowParser a
76+ default fromRow :: (Generic a, GFromRow (Rep a)) => RowParser a
77+ fromRow = to <$> gfromRow
71
78
72getvalue :: PQ.Result -> PQ.Row -> PQ.Column -> Maybe ByteString
79getvalue :: PQ.Result -> PQ.Row -> PQ.Column -> Maybe ByteString
73getvalue result row col = unsafeDupablePerformIO (PQ.getvalue' result row col)
80getvalue result row col = unsafeDupablePerformIO (PQ.getvalue' result row col)
@@ -252,3 +259,21 @@ instance FromField a => FromRow (Maybe (Vector a)) where
252
259
253instance (FromRow a, FromRow b) => FromRow (a :. b) where
260instance (FromRow a, FromRow b) => FromRow (a :. b) where
254 fromRow = (:.) <$> fromRow <*> fromRow
261 fromRow = (:.) <$> fromRow <*> fromRow
262+
263+
264+
265+-- Type class for default implementation of FromRow using generics
266+class GFromRow f where
267+ gfromRow :: RowParser (f p)
268+
269+instance GFromRow f => GFromRow (M1 c i f) where
270+ gfromRow = M1 <$> gfromRow
271+
272+instance (GFromRow f, GFromRow g) => GFromRow (f :*: g) where
273+ gfromRow = liftA2 (:*:) gfromRow gfromRow
274+
275+instance (FromField a) => GFromRow (K1 R a) where
276+ gfromRow = K1 <$> field
277+
278+instance GFromRow U1 where
279+ gfromRow = pure U1
src/Database/PostgreSQL/Simple/ToRow.hs+21
@@ -1,3 +1,4 @@
1+{-# LANGUAGE DefaultSignatures, FlexibleInstances, FlexibleContexts #-}
1------------------------------------------------------------------------------
2------------------------------------------------------------------------------
2-- |
3-- |
3-- Module: Database.PostgreSQL.Simple.ToRow
4-- Module: Database.PostgreSQL.Simple.ToRow
@@ -22,6 +23,7 @@ module Database.PostgreSQL.Simple.ToRow
22
23
23import Database.PostgreSQL.Simple.ToField (Action(..), ToField(..))
24import Database.PostgreSQL.Simple.ToField (Action(..), ToField(..))
24import Database.PostgreSQL.Simple.Types (Only(..), (:.)(..))
25import Database.PostgreSQL.Simple.Types (Only(..), (:.)(..))
26+import GHC.Generics
25
27
26-- | A collection type that can be turned into a list of rendering
28-- | A collection type that can be turned into a list of rendering
27-- 'Action's.
29-- 'Action's.
@@ -30,6 +32,8 @@ import Database.PostgreSQL.Simple.Types (Only(..), (:.)(..))
30-- to perform conversion of each element of the collection.
32-- to perform conversion of each element of the collection.
31class ToRow a where
33class ToRow a where
32 toRow :: a -> [Action]
34 toRow :: a -> [Action]
35+ default toRow :: (Generic a, GToRow (Rep a)) => a -> [Action]
36+ toRow = gtoRow . from
33 -- ^ ToField a collection of values.
37 -- ^ ToField a collection of values.
34
38
35instance ToRow () where
39instance ToRow () where
@@ -90,3 +94,20 @@ instance (ToField a) => ToRow [a] where
90
94
91instance (ToRow a, ToRow b) => ToRow (a :. b) where
95instance (ToRow a, ToRow b) => ToRow (a :. b) where
92 toRow (a :. b) = toRow a ++ toRow b
96 toRow (a :. b) = toRow a ++ toRow b
97+
98+
99+-- Type class for default implementation of ToRow using generics
100+class GToRow f where
101+ gtoRow :: f p -> [Action]
102+
103+instance GToRow f => GToRow (M1 c i f) where
104+ gtoRow (M1 x) = gtoRow x
105+
106+instance (GToRow f, GToRow g) => GToRow (f :*: g) where
107+ gtoRow (f :*: g) = gtoRow f ++ gtoRow g
108+
109+instance (ToField a) => GToRow (K1 R a) where
110+ gtoRow (K1 a) = [toField a]
111+
112+instance GToRow U1 where
113+ gtoRow _ = []
src/Database/PostgreSQL/Simple/ToRow.hs-boot+10−1
@@ -1,9 +1,18 @@
1+{-# LANGUAGE DefaultSignatures, FlexibleInstances, FlexibleContexts #-}
1−module Database.PostgreSQL.Simple.ToRow where
2+module Database.PostgreSQL.Simple.ToRow (
3+ ToRow(..)
4+ ) where
2
5
3import Database.PostgreSQL.Simple.Types
6import Database.PostgreSQL.Simple.Types
4import {-# SOURCE #-} Database.PostgreSQL.Simple.ToField
7import {-# SOURCE #-} Database.PostgreSQL.Simple.ToField
8+import GHC.Generics
5
9
6class ToRow a where
10class ToRow a where
7 toRow :: a -> [Action]
11 toRow :: a -> [Action]
12+ default toRow :: (Generic a, GToRow (Rep a)) => a -> [Action]
13+ toRow = gtoRow . from
14+
15+class GToRow f where
16+ gtoRow :: f p -> [Action]
8
17
9instance ToField a => ToRow (Only a)
18instance ToField a => ToRow (Only a)