943b534 · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

Implement default instances for {To,From}Row using Generic

commit943b534eb04f1b2c642b59793dae1c25bd9560de authorAlexey Khudyakov <alexey.skladnoy@gmail.com> dateWed 3 Jun 2015, 20:09 (11 years ago) parent13e8ea6

4 files changed+59−4

compare with master

unifiedsplit

postgresql-simple.cabal+1−1 src/Database/PostgreSQL/Simple/FromRow.hs+27−2 src/Database/PostgreSQL/Simple/ToRow.hs+21 src/Database/PostgreSQL/Simple/ToRow.hs-boot+10−1

postgresql-simple.cabal+1−1

@@ -53,7 +53,7 @@ Library

5353 Build-depends:

5454 aeson >= 0.6,

5555 attoparsec >= 0.10.3,

56− base < 5,

56+ base >= 4.4 && < 5,

5757 bytestring >= 0.9,

5858 bytestring-builder,

5959 case-insensitive,

src/Database/PostgreSQL/Simple/FromRow.hs+27−2

@@ -1,4 +1,6 @@

1−{-# LANGUAGE RecordWildCards, FlexibleInstances #-}

1+{-# LANGUAGE FlexibleContexts #-}

2+{-# LANGUAGE RecordWildCards, FlexibleInstances, DefaultSignatures #-}

35------------------------------------------------------------------------------

46-- |

@@ -27,7 +29,7 @@ module Database.PostgreSQL.Simple.FromRow

2729 ) where

2830

2931import Prelude hiding (null)

30−import Control.Applicative (Applicative(..), (<$>), (<|>), (*>))

32+import Control.Applicative (Applicative(..), (<$>), (<|>), (*>), liftA2)

3133import Control.Monad (replicateM, replicateM_)

3234import Control.Monad.Trans.State.Strict

3335import Control.Monad.Trans.Reader

@@ -45,6 +47,9 @@ import Database.PostgreSQL.Simple.Ok

4547import Database.PostgreSQL.Simple.Types ((:.)(..), Null)

4648import Database.PostgreSQL.Simple.TypeInfo

4749

50+import GHC.Generics

51+

52+

4853-- | A collection type that can be converted from a sequence of fields.

4954-- Instances are provided for tuples up to 10 elements and lists of any length.

5055--

@@ -68,6 +73,8 @@ import Database.PostgreSQL.Simple.TypeInfo

6873

6974class FromRow a where

7075 fromRow :: RowParser a

76+ default fromRow :: (Generic a, GFromRow (Rep a)) => RowParser a

77+ fromRow = to <$> gfromRow

7178

7279getvalue :: PQ.Result -> PQ.Row -> PQ.Column -> Maybe ByteString

7380getvalue result row col = unsafeDupablePerformIO (PQ.getvalue' result row col)

@@ -252,3 +259,21 @@ instance FromField a => FromRow (Maybe (Vector a)) where

252259

253260instance (FromRow a, FromRow b) => FromRow (a :. b) where

254261 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 #-}

12------------------------------------------------------------------------------

23-- |

34-- Module: Database.PostgreSQL.Simple.ToRow

@@ -22,6 +23,7 @@ module Database.PostgreSQL.Simple.ToRow

2223

2324import Database.PostgreSQL.Simple.ToField (Action(..), ToField(..))

2425import Database.PostgreSQL.Simple.Types (Only(..), (:.)(..))

26+import GHC.Generics

2527

2628-- | A collection type that can be turned into a list of rendering

2729-- 'Action's.

@@ -30,6 +32,8 @@ import Database.PostgreSQL.Simple.Types (Only(..), (:.)(..))

3032-- to perform conversion of each element of the collection.

3133class ToRow a where

3234 toRow :: a -> [Action]

35+ default toRow :: (Generic a, GToRow (Rep a)) => a -> [Action]

36+ toRow = gtoRow . from

3337 -- ^ ToField a collection of values.

3438

3539instance ToRow () where

@@ -90,3 +94,20 @@ instance (ToField a) => ToRow [a] where

9094

9195instance (ToRow a, ToRow b) => ToRow (a :. b) where

9296 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−module Database.PostgreSQL.Simple.ToRow where

1+{-# LANGUAGE DefaultSignatures, FlexibleInstances, FlexibleContexts #-}

2+module Database.PostgreSQL.Simple.ToRow (

3+ ToRow(..)

4+ ) where

36import Database.PostgreSQL.Simple.Types

47import {-# SOURCE #-} Database.PostgreSQL.Simple.ToField

8+import GHC.Generics

610class ToRow a where

711 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]

817

918instance ToField a => ToRow (Only a)