postgresql-pure 0.2.1.0 → 0.2.2.0
raw patch · 8 files changed
+137/−26 lines, 8 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Database.PostgreSQL.Pure: fromRecord :: FromRecord a => StringDecoder -> [ColumnInfo] -> Parser a
+ Database.PostgreSQL.Pure: fromRecord :: (FromRecord a, Generic a, GFromRecord (Rep a)) => StringDecoder -> [ColumnInfo] -> Parser a
- Database.PostgreSQL.Pure: toRecord :: (ToRecord a, MonadFail m) => BackendParameters -> StringEncoder -> Maybe [Oid] -> [FormatCode] -> a -> m [Maybe ByteString]
+ Database.PostgreSQL.Pure: toRecord :: (ToRecord a, MonadFail m, Generic a, GToRecord (Rep a)) => BackendParameters -> StringEncoder -> Maybe [Oid] -> [FormatCode] -> a -> m [Maybe ByteString]
- Database.PostgreSQL.Pure.List: fromRecord :: FromRecord a => StringDecoder -> [ColumnInfo] -> Parser a
+ Database.PostgreSQL.Pure.List: fromRecord :: (FromRecord a, Generic a, GFromRecord (Rep a)) => StringDecoder -> [ColumnInfo] -> Parser a
- Database.PostgreSQL.Pure.List: toRecord :: (ToRecord a, MonadFail m) => BackendParameters -> StringEncoder -> Maybe [Oid] -> [FormatCode] -> a -> m [Maybe ByteString]
+ Database.PostgreSQL.Pure.List: toRecord :: (ToRecord a, MonadFail m, Generic a, GToRecord (Rep a)) => BackendParameters -> StringEncoder -> Maybe [Oid] -> [FormatCode] -> a -> m [Maybe ByteString]
Files
- ChangeLog.md +9/−3
- README.md +1/−1
- postgresql-pure.cabal +2/−2
- src/Database/PostgreSQL/Pure/Internal/Builder.hs +25/−5
- src/Database/PostgreSQL/Pure/Internal/Data.hs +31/−0
- src/Database/PostgreSQL/Pure/Internal/Parser.hs +22/−5
- template/Builder.hs +25/−5
- template/Parser.hs +22/−5
ChangeLog.md view
@@ -1,5 +1,11 @@ # Changelog for postgresql-pure +## 0.2.2.0++2020.07.19++- Default implementations get to be given for `FromRecord` and `ToRecord`.+ ## 0.2.1.0 2020.07.14@@ -12,11 +18,11 @@ ### Breaking changes -- Remove orphan `IsLabel` instance definitions; #2 thanks to @nakaji-dayo.+- Remove orphan `IsLabel` instance definitions; [#2](https://github.com/iij-ii/postgresql-pure/pull/2) thanks to [@nakaji-dayo](https://github.com/nakaji-dayo). ### Other changes -- Add cleartext password authentication; #1 thanks to @goodlyrottenapple.+- Add cleartext password authentication; [#1](https://github.com/iij-ii/postgresql-pure/pull/1) thanks to [@goodlyrottenapple](https://github.com/goodlyrottenapple). - Change the Haskell type corresponding to `timetz` from `(TimeOfDay, TimeZone)` to `TimeOfDayWithTimeZone`. - Not only tuples but also other types which have `Length` type function can be record. @@ -26,7 +32,7 @@ - Expose a function for type class instance implementations. - A new instance `FromField String`.-- New instances for `FromRecord`, `ToRecord`.+- New instances for `FromRecord` and `ToRecord`. ## 0.1.2.0
README.md view
@@ -1,6 +1,6 @@ # postgresql-pure -[](http://hackage.haskell.org/package/postgresql-pure) [](https://iij-ii.github.io/postgresql-pure/) [](https://github.com/iij-ii/postgresql-pure/actions?query=workflow%3Abuild) [](https://github.com/iij-ii/postgresql-pure/actions?query=workflow%3Atest)+[](http://hackage.haskell.org/package/postgresql-pure) [](https://iij-ii.github.io/postgresql-pure/) [](https://github.com/iij-ii/postgresql-pure/actions?query=workflow%3Abuild) [](https://github.com/iij-ii/postgresql-pure/actions?query=workflow%3Atest) ## Copyright
postgresql-pure.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: e4d2fa99f191645581a127977d9ca699f4f42439e9ca768d527f4a8c37823ce8+-- hash: 5f059edd27ff8ab95243b3a3495424fd88f57773838ad8494cfa4c4d1816aff7 name: postgresql-pure-version: 0.2.1.0+version: 0.2.2.0 synopsis: pure Haskell PostgreSQL driver description: pure Haskell PostgreSQL driver category: Database
src/Database/PostgreSQL/Pure/Internal/Builder.hs view
@@ -3,7 +3,9 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE UndecidableInstances #-} @@ -29,11 +31,13 @@ import Database.PostgreSQL.Pure.Internal.Data (BindParameterFormatCodes (BindParameterFormatCodesAll, BindParameterFormatCodesAllDefault, BindParameterFormatCodesEach), BindResultFormatCodes (BindResultFormatCodesAllDefault, BindResultFormatCodesEach, BindResultFormatCodesNothing),- FormatCode (BinaryFormat, TextFormat), Oid (Oid),+ FormatCode (BinaryFormat, TextFormat),+ GToRecord (gToRecord), Oid (Oid), PortalName (PortalName), PreparedStatementName (PreparedStatementName),- Query (Query), TimeOfDayWithTimeZone (TimeOfDayWithTimeZone), ToField (toField),- ToRecord (toRecord))+ Query (Query),+ TimeOfDayWithTimeZone (TimeOfDayWithTimeZone),+ ToField (toField), ToRecord (toRecord)) import Database.PostgreSQL.Pure.Internal.Exception (cantReachHere) import qualified Database.PostgreSQL.Pure.Internal.MonadFail as MonadFail import qualified Database.PostgreSQL.Pure.Oid as Oid@@ -51,10 +55,10 @@ import qualified Data.Map.Strict as M import Data.Scientific (FPFormat (Exponent), Scientific, formatScientific, scientific)-import Data.Time (Day, DiffTime, NominalDiffTime, TimeOfDay,- UTCTime)+import Data.Time (Day, DiffTime, NominalDiffTime, TimeOfDay, UTCTime) import Data.Time.LocalTime (LocalTime) import Data.Tuple.Single (Single, pattern Single)+import qualified GHC.Generics as Generics import qualified PostgreSQL.Binary.Encoding as BE startup@@ -1098,6 +1102,22 @@ sequence $ uncurry (toField backendParams encode Nothing) <$> zip fs vs toRecord backendParams encode (Just os) fs vs = assert (length os == length fs && length fs == length vs) $ sequence $ uncurry3 (toField backendParams encode) <$> zip3 (Just <$> os) fs vs++-- generics+instance GToRecord f => GToRecord (Generics.M1 i t f) where+ gToRecord backendParams encode os fs (Generics.M1 r) = gToRecord backendParams encode os fs r++instance ToField c => GToRecord (Generics.K1 i c) where+ gToRecord backendParams encode (Just (o:os)) (f:fs) (Generics.K1 v) = (, Just os, fs) . (:[]) <$> toField backendParams encode (Just o) f v+ gToRecord backendParams encode Nothing (f:fs) (Generics.K1 v) = (, Nothing, fs) . (:[]) <$> toField backendParams encode Nothing f v+ gToRecord _ _ (Just []) _ _ = fail "there are too few OIDs"+ gToRecord _ _ _ [] _ = fail "there are too few format codes"++instance (GToRecord f, GToRecord g) => GToRecord (f Generics.:*: g) where+ gToRecord backendParams encode os fs (f Generics.:*: g) = do+ (record, os', fs') <- gToRecord backendParams encode os fs f+ (record', os'', fs'') <- gToRecord backendParams encode os' fs' g+ pure (record ++ record', os'', fs'') uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d uncurry3 f (a, b, c) = f a b c
src/Database/PostgreSQL/Pure/Internal/Data.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-}@@ -67,8 +68,10 @@ , StringEncoder , FromField (..) , FromRecord (..)+ , GFromRecord (..) , ToField (..) , ToRecord (..)+ , GToRecord (..) , Pretty (..) ) where @@ -90,6 +93,8 @@ import Data.Time (TimeOfDay, TimeZone) import Data.Word (Word8) import Foreign (ForeignPtr)+import GHC.Generics (Generic (Rep))+import qualified GHC.Generics as Generics import Hexdump (prettyHex, simpleHex) import Network.Socket (Socket) import qualified Network.Socket as NS@@ -454,7 +459,16 @@ class FromRecord a where -- | Decoder of a record. fromRecord :: StringDecoder -> [ColumnInfo] -> AP.Parser a+ default fromRecord :: (Generic a, GFromRecord (Rep a)) => StringDecoder -> [ColumnInfo] -> AP.Parser a+ fromRecord decode infos = do+ (rep, infos') <- gFromRecord decode infos+ case infos' of+ [] -> pure $ Generics.to rep+ is -> fail $ "length mismatch: too many: actual: " <> show (length is) +class GFromRecord f where+ gFromRecord :: StringDecoder -> [ColumnInfo] -> AP.Parser ((f p), [ColumnInfo])+ -- | This means that @a@ can be encoded to a field. class ToField a where -- | Encoder of a field.@@ -464,6 +478,23 @@ class ToRecord a where -- | Encoder of a field. toRecord :: MonadFail m => BackendParameters -> StringEncoder -> Maybe [Oid] -> [FormatCode] -> a -> m [Maybe BS.ByteString]+ default toRecord :: (MonadFail m, Generic a, GToRecord (Rep a)) => BackendParameters -> StringEncoder -> Maybe [Oid] -> [FormatCode] -> a -> m [Maybe BS.ByteString]+ toRecord backendParams encode Nothing fs v = do+ (record, os, fs') <- gToRecord backendParams encode Nothing fs $ Generics.from v+ case (os, fs') of+ (Nothing, []) -> pure record+ (Nothing, _) -> fail "There are too many format codes"+ (_, _) -> error "can't reach here"+ toRecord backendParams encode os fs v = do+ (record, os', fs') <- gToRecord backendParams encode os fs $ Generics.from v+ case (os', fs') of+ (Just [], []) -> pure record+ (Just _, []) -> fail "There are too many OIDs"+ (Just _, _) -> fail "There are too many format codes"+ (_, _) -> error "can't reach here"++class GToRecord f where+ gToRecord :: (MonadFail m) => BackendParameters -> StringEncoder -> Maybe [Oid] -> [FormatCode] -> f p -> m ([Maybe BS.ByteString], Maybe [Oid], [FormatCode]) -- | Type of PostgreSQL @sql_identifier@ type. newtype SqlIdentifier = SqlIdentifier BS.ByteString deriving (Show, Read, Eq)
src/Database/PostgreSQL/Pure/Internal/Parser.hs view
@@ -5,8 +5,10 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE UndecidableInstances #-} @@ -42,7 +44,7 @@ , valueParser ) where -import Database.PostgreSQL.Pure.Internal.Data (AuthenticationMD5Password (AuthenticationMD5Password), AuthenticationResponse (AuthenticationMD5PasswordResponse, AuthenticationOkResponse, AuthenticationCleartextPasswordResponse),+import Database.PostgreSQL.Pure.Internal.Data (AuthenticationMD5Password (AuthenticationMD5Password), AuthenticationResponse (AuthenticationCleartextPasswordResponse, AuthenticationMD5PasswordResponse, AuthenticationOkResponse), BackendKeyData (BackendKeyData), ColumnInfo (ColumnInfo, typeOid), CommandComplete (CommandComplete),@@ -52,12 +54,13 @@ ErrorFields (ErrorFields), FormatCode (BinaryFormat, TextFormat), FromField (fromField), FromRecord (fromRecord),- Notice (Notice), Oid (Oid),+ GFromRecord (gFromRecord), Notice (Notice), Oid (Oid), ParameterDescription (ParameterDescription), ParameterStatus (ParameterStatus), Raw (Null, Value), ReadyForQuery (ReadyForQuery), Response (..), RowDescription (RowDescription),- SqlIdentifier (SqlIdentifier), StringDecoder, TimeOfDayWithTimeZone (TimeOfDayWithTimeZone),+ SqlIdentifier (SqlIdentifier), StringDecoder,+ TimeOfDayWithTimeZone (TimeOfDayWithTimeZone), TransactionState (Block, Failed, Idle), TypeLength (FixedLength, VariableLength)) import qualified Database.PostgreSQL.Pure.Internal.Data as Data@@ -86,12 +89,12 @@ import Data.Memory.Endian (BE, ByteSwap, fromBE) import Data.Scientific (Scientific, scientific) import qualified Data.Text as Text-import Data.Time (Day, DiffTime, LocalTime, TimeOfDay,- UTCTime, utc)+import Data.Time (Day, DiffTime, LocalTime, TimeOfDay, UTCTime, utc) import Data.Tuple.Single (Single, pattern Single) import Data.Word (Word16, Word32, Word64, Word8) import Foreign (withForeignPtr) import Foreign.Storable (Storable, peekByteOff, sizeOf)+import qualified GHC.Generics as Generics import GHC.Stack (HasCallStack, callStack, prettyCallStack) import qualified PostgreSQL.Binary.Decoding as BD import System.IO.Unsafe (unsafeDupablePerformIO)@@ -1057,6 +1060,20 @@ -- list instance {-# OVERLAPPABLE #-} FromField a => FromRecord [a] where fromRecord decode is = sequence $ column decode <$> is++-- generic+instance GFromRecord f => GFromRecord (Generics.M1 i t f) where+ gFromRecord decode infos = (\(r, is) -> (Generics.M1 r, is)) <$> gFromRecord decode infos++instance FromField c => GFromRecord (Generics.K1 i c) where+ gFromRecord decode (i:infos) = (, infos) . Generics.K1 <$> column decode i+ gFromRecord _ [] = fail "length mismatch: too few"++instance (GFromRecord f, GFromRecord g) => GFromRecord (f Generics.:*: g) where+ gFromRecord decode infos = do+ (rep, infos') <- gFromRecord decode infos+ (rep', infos'') <- gFromRecord decode infos'+ pure (rep Generics.:*: rep', infos'') -- | For implementing 'fromRecord'. column :: FromField a => StringDecoder -> ColumnInfo -> AP.Parser a
template/Builder.hs view
@@ -3,7 +3,9 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE UndecidableInstances #-} @@ -29,11 +31,13 @@ import Database.PostgreSQL.Pure.Internal.Data (BindParameterFormatCodes (BindParameterFormatCodesAll, BindParameterFormatCodesAllDefault, BindParameterFormatCodesEach), BindResultFormatCodes (BindResultFormatCodesAllDefault, BindResultFormatCodesEach, BindResultFormatCodesNothing),- FormatCode (BinaryFormat, TextFormat), Oid (Oid),+ FormatCode (BinaryFormat, TextFormat),+ GToRecord (gToRecord), Oid (Oid), PortalName (PortalName), PreparedStatementName (PreparedStatementName),- Query (Query), TimeOfDayWithTimeZone (TimeOfDayWithTimeZone), ToField (toField),- ToRecord (toRecord))+ Query (Query),+ TimeOfDayWithTimeZone (TimeOfDayWithTimeZone),+ ToField (toField), ToRecord (toRecord)) import Database.PostgreSQL.Pure.Internal.Exception (cantReachHere) import qualified Database.PostgreSQL.Pure.Internal.MonadFail as MonadFail import qualified Database.PostgreSQL.Pure.Oid as Oid@@ -51,10 +55,10 @@ import qualified Data.Map.Strict as M import Data.Scientific (FPFormat (Exponent), Scientific, formatScientific, scientific)-import Data.Time (Day, DiffTime, NominalDiffTime, TimeOfDay,- UTCTime)+import Data.Time (Day, DiffTime, NominalDiffTime, TimeOfDay, UTCTime) import Data.Time.LocalTime (LocalTime) import Data.Tuple.Single (Single, pattern Single)+import qualified GHC.Generics as Generics import qualified PostgreSQL.Binary.Encoding as BE startup@@ -549,6 +553,22 @@ sequence $ uncurry (toField backendParams encode Nothing) <$> zip fs vs toRecord backendParams encode (Just os) fs vs = assert (length os == length fs && length fs == length vs) $ sequence $ uncurry3 (toField backendParams encode) <$> zip3 (Just <$> os) fs vs++-- generics+instance GToRecord f => GToRecord (Generics.M1 i t f) where+ gToRecord backendParams encode os fs (Generics.M1 r) = gToRecord backendParams encode os fs r++instance ToField c => GToRecord (Generics.K1 i c) where+ gToRecord backendParams encode (Just (o:os)) (f:fs) (Generics.K1 v) = (, Just os, fs) . (:[]) <$> toField backendParams encode (Just o) f v+ gToRecord backendParams encode Nothing (f:fs) (Generics.K1 v) = (, Nothing, fs) . (:[]) <$> toField backendParams encode Nothing f v+ gToRecord _ _ (Just []) _ _ = fail "there are too few OIDs"+ gToRecord _ _ _ [] _ = fail "there are too few format codes"++instance (GToRecord f, GToRecord g) => GToRecord (f Generics.:*: g) where+ gToRecord backendParams encode os fs (f Generics.:*: g) = do+ (record, os', fs') <- gToRecord backendParams encode os fs f+ (record', os'', fs'') <- gToRecord backendParams encode os' fs' g+ pure (record ++ record', os'', fs'') uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d uncurry3 f (a, b, c) = f a b c
template/Parser.hs view
@@ -5,8 +5,10 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE UndecidableInstances #-} @@ -42,7 +44,7 @@ , valueParser ) where -import Database.PostgreSQL.Pure.Internal.Data (AuthenticationMD5Password (AuthenticationMD5Password), AuthenticationResponse (AuthenticationMD5PasswordResponse, AuthenticationOkResponse, AuthenticationCleartextPasswordResponse),+import Database.PostgreSQL.Pure.Internal.Data (AuthenticationMD5Password (AuthenticationMD5Password), AuthenticationResponse (AuthenticationCleartextPasswordResponse, AuthenticationMD5PasswordResponse, AuthenticationOkResponse), BackendKeyData (BackendKeyData), ColumnInfo (ColumnInfo, typeOid), CommandComplete (CommandComplete),@@ -52,12 +54,13 @@ ErrorFields (ErrorFields), FormatCode (BinaryFormat, TextFormat), FromField (fromField), FromRecord (fromRecord),- Notice (Notice), Oid (Oid),+ GFromRecord (gFromRecord), Notice (Notice), Oid (Oid), ParameterDescription (ParameterDescription), ParameterStatus (ParameterStatus), Raw (Null, Value), ReadyForQuery (ReadyForQuery), Response (..), RowDescription (RowDescription),- SqlIdentifier (SqlIdentifier), StringDecoder, TimeOfDayWithTimeZone (TimeOfDayWithTimeZone),+ SqlIdentifier (SqlIdentifier), StringDecoder,+ TimeOfDayWithTimeZone (TimeOfDayWithTimeZone), TransactionState (Block, Failed, Idle), TypeLength (FixedLength, VariableLength)) import qualified Database.PostgreSQL.Pure.Internal.Data as Data@@ -86,12 +89,12 @@ import Data.Memory.Endian (BE, ByteSwap, fromBE) import Data.Scientific (Scientific, scientific) import qualified Data.Text as Text-import Data.Time (Day, DiffTime, LocalTime, TimeOfDay,- UTCTime, utc)+import Data.Time (Day, DiffTime, LocalTime, TimeOfDay, UTCTime, utc) import Data.Tuple.Single (Single, pattern Single) import Data.Word (Word16, Word32, Word64, Word8) import Foreign (withForeignPtr) import Foreign.Storable (Storable, peekByteOff, sizeOf)+import qualified GHC.Generics as Generics import GHC.Stack (HasCallStack, callStack, prettyCallStack) import qualified PostgreSQL.Binary.Decoding as BD import System.IO.Unsafe (unsafeDupablePerformIO)@@ -813,6 +816,20 @@ -- list instance {-# OVERLAPPABLE #-} FromField a => FromRecord [a] where fromRecord decode is = sequence $ column decode <$> is++-- generic+instance GFromRecord f => GFromRecord (Generics.M1 i t f) where+ gFromRecord decode infos = (\(r, is) -> (Generics.M1 r, is)) <$> gFromRecord decode infos++instance FromField c => GFromRecord (Generics.K1 i c) where+ gFromRecord decode (i:infos) = (, infos) . Generics.K1 <$> column decode i+ gFromRecord _ [] = fail "length mismatch: too few"++instance (GFromRecord f, GFromRecord g) => GFromRecord (f Generics.:*: g) where+ gFromRecord decode infos = do+ (rep, infos') <- gFromRecord decode infos+ (rep', infos'') <- gFromRecord decode infos'+ pure (rep Generics.:*: rep', infos'') -- | For implementing 'fromRecord'. column :: FromField a => StringDecoder -> ColumnInfo -> AP.Parser a