Add direct codec interface to persistent core#1
Open
iand675 wants to merge 1 commit into02-19-rfc_direct_row_codecs_for_persistentfrom
Open
Conversation
New modules: - DirectDecode: RowReader, FieldDecode, FromRow with prepare-once via prepareRow/RowDecoder, DirectEntity for SqlBackend bridge - DirectEncode: FieldEncode, ParamBuilder (vector-builder monoid), ToRow - Sql.DirectRaw: HasDirectQuery, rawQueryDirect, rawSqlDirect, rawSqlDirectCompat (SqlBackend bridge) - Sql.Experimental: drop-in replacement for Sql that re-exports the direct codec API SqlBackend gains connDirectQueryCap (DirectQueryCap existential) for the Typeable-based SqlBackend bridge. ISRSingleCustom added to InsertSqlResult for UNNEST bulk inserts.
![github-actions[bot]](https://avatars.githubusercontent.com/in/15368?s=60&v=4){kind=small}
Comment on lines
+73
to
+74
| Database.Persist.DirectDecode | ||
| Database.Persist.DirectEncode |
There was a problem hiding this comment.
Restyled by cabal-fmt
Suggested change
| Database.Persist.DirectDecode | |
| Database.Persist.DirectEncode |
| -- Returns the 'FieldRunner' as a value so it can be captured in a | ||
| -- 'RowDecoder' closure and reused across rows. Used inside | ||
| -- 'prepareRow' implementations. | ||
| prepareNextField :: FieldDecode env a => FieldNameDB -> RowReader env (FieldRunner env a) |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| prepareNextField :: FieldDecode env a => FieldNameDB -> RowReader env (FieldRunner env a) | |
| prepareNextField | |
| :: (FieldDecode env a) => FieldNameDB -> RowReader env (FieldRunner env a) |
| import GHC.Exts (MutableByteArray#, RealWorld) | ||
| import GHC.IO (IO (..)) | ||
| import GHC.Int (Int (..)) | ||
| import GHC.Prim (readIntArray#, writeIntArray#, newByteArray#, (+#)) |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| import GHC.Prim (readIntArray#, writeIntArray#, newByteArray#, (+#)) | |
| import GHC.Prim (newByteArray#, readIntArray#, writeIntArray#, (+#)) |
Comment on lines
+61
to
+64
| a <> b = ParamBuilder | ||
| { pbLength = pbLength a + pbLength b | ||
| , pbWrite = \mv off -> pbWrite a mv off >> pbWrite b mv (off + pbLength a) | ||
| } |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| a <> b = ParamBuilder | |
| { pbLength = pbLength a + pbLength b | |
| , pbWrite = \mv off -> pbWrite a mv off >> pbWrite b mv (off + pbLength a) | |
| } | |
| a <> b = | |
| ParamBuilder | |
| { pbLength = pbLength a + pbLength b | |
| , pbWrite = \mv off -> pbWrite a mv off >> pbWrite b mv (off + pbLength a) | |
| } |
Comment on lines
+7
to
+11
| {-# LANGUAGE FlexibleInstances #-} | ||
| {-# LANGUAGE FlexibleContexts #-} | ||
| {-# LANGUAGE MultiParamTypeClasses #-} | ||
| {-# LANGUAGE FunctionalDependencies #-} | ||
| {-# LANGUAGE DefaultSignatures #-} |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| {-# LANGUAGE FlexibleInstances #-} | |
| {-# LANGUAGE FlexibleContexts #-} | |
| {-# LANGUAGE MultiParamTypeClasses #-} | |
| {-# LANGUAGE FunctionalDependencies #-} | |
| {-# LANGUAGE DefaultSignatures #-} |
Comment on lines
+164
to
+166
| :: env -> FieldNameDB -> Int | ||
| -> (Text -> IO r) -- ^ on error | ||
| -> (FieldRunner env a -> IO r) -- ^ on success (receives the runner) |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| :: env -> FieldNameDB -> Int | |
| -> (Text -> IO r) -- ^ on error | |
| -> (FieldRunner env a -> IO r) -- ^ on success (receives the runner) | |
| :: env | |
| -> FieldNameDB | |
| -> Int | |
| -> (Text -> IO r) | |
| -- ^ on error | |
| -> (FieldRunner env a -> IO r) | |
| -- ^ on success (receives the runner) |
Comment on lines
+114
to
+116
| :: RowReader env a -> env -> Counter | ||
| -> (Text -> IO r) -- ^ on error | ||
| -> (a -> IO r) -- ^ on success |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| :: RowReader env a -> env -> Counter | |
| -> (Text -> IO r) -- ^ on error | |
| -> (a -> IO r) -- ^ on success | |
| :: RowReader env a | |
| -> env | |
| -> Counter | |
| -> (Text -> IO r) | |
| -- ^ on error | |
| -> (a -> IO r) | |
| -- ^ on success |
| runRowDecoder dd env' onErr' $ \vd -> | ||
| onOk' (va, vb, vc, vd) | ||
|
|
||
| instance (FromRow env a, FromRow env b, FromRow env c, FromRow env d, FromRow env e) => FromRow env (a, b, c, d, e) where |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| instance (FromRow env a, FromRow env b, FromRow env c, FromRow env d, FromRow env e) => FromRow env (a, b, c, d, e) where | |
| instance | |
| (FromRow env a, FromRow env b, FromRow env c, FromRow env d, FromRow env e) | |
| => FromRow env (a, b, c, d, e) | |
| where |
| -- | ||
| -- Calls 'prepareField' and immediately applies the resulting 'FieldRunner'. | ||
| -- For the prepare-once path, use 'prepareRow' instead. | ||
| nextField :: FieldDecode env a => FieldNameDB -> RowReader env a |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| nextField :: FieldDecode env a => FieldNameDB -> RowReader env a | |
| nextField :: (FieldDecode env a) => FieldNameDB -> RowReader env a |
| runRowDecoder dc env' onErr' $ \vc -> | ||
| onOk' (va, vb, vc) | ||
|
|
||
| instance (FromRow env a, FromRow env b, FromRow env c, FromRow env d) => FromRow env (a, b, c, d) where |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| instance (FromRow env a, FromRow env b, FromRow env c, FromRow env d) => FromRow env (a, b, c, d) where | |
| instance | |
| (FromRow env a, FromRow env b, FromRow env c, FromRow env d) | |
| => FromRow env (a, b, c, d) | |
| where |
| -- one allocation (no intermediate list). | ||
| data ParamBuilder param = ParamBuilder | ||
| { pbLength :: {-# UNPACK #-} !Int | ||
| , pbWrite :: forall s. MV.MVector s param -> Int -> ST s () |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| , pbWrite :: forall s. MV.MVector s param -> Int -> ST s () | |
| , pbWrite :: forall s. MV.MVector s param -> Int -> ST s () |
| type Env backend | ||
| type Param backend | ||
| directQuerySource | ||
| :: MonadIO m |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| :: MonadIO m | |
| :: (MonadIO m) |
Comment on lines
+130
to
+135
| decoder <- liftIO $ prepareRow firstEnv ctr | ||
| (throwIO . PersistMarshalError) | ||
| pure | ||
| val <- liftIO $ runRowDecoderCPS decoder firstEnv | ||
| (throwIO . PersistMarshalError) | ||
| pure |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| decoder <- liftIO $ prepareRow firstEnv ctr | |
| (throwIO . PersistMarshalError) | |
| pure | |
| val <- liftIO $ runRowDecoderCPS decoder firstEnv | |
| (throwIO . PersistMarshalError) | |
| pure | |
| decoder <- | |
| liftIO $ | |
| prepareRow | |
| firstEnv | |
| ctr | |
| (throwIO . PersistMarshalError) | |
| pure | |
| val <- | |
| liftIO $ | |
| runRowDecoderCPS | |
| decoder | |
| firstEnv | |
| (throwIO . PersistMarshalError) | |
| pure |
Comment on lines
+199
to
+201
| :: forall r. env | ||
| -> (Text -> IO r) -- on error | ||
| -> (a -> IO r) -- on success |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| :: forall r. env | |
| -> (Text -> IO r) -- on error | |
| -> (a -> IO r) -- on success | |
| :: forall r | |
| . env | |
| -> (Text -> IO r) -- on error | |
| -> (a -> IO r) -- on success |
| -> ReaderT backend m1 (Acquire (ConduitM () a m2 ())) | ||
| rawQueryDirect sql paramBuilder = do | ||
| backend <- ask | ||
| let params = buildParams paramBuilder |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| let params = buildParams paramBuilder | |
| let | |
| params = buildParams paramBuilder |
| -> ReaderT backend m [a] | ||
| rawSqlDirect sql paramBuilder = do | ||
| backend <- ask | ||
| let params = buildParams paramBuilder |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| let params = buildParams paramBuilder | |
| let | |
| params = buildParams paramBuilder |
| rowReader :: RowReader env a | ||
|
|
||
| prepareRow | ||
| :: env -> Counter |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| :: env -> Counter | |
| :: env | |
| -> Counter |
Comment on lines
+101
to
+103
| :: forall r. env -> Counter | ||
| -> (Text -> IO r) -- on error | ||
| -> (a -> IO r) -- on success |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| :: forall r. env -> Counter | |
| -> (Text -> IO r) -- on error | |
| -> (a -> IO r) -- on success | |
| :: forall r | |
| . env | |
| -> Counter | |
| -> (Text -> IO r) -- on error | |
| -> (a -> IO r) -- on success |
Comment on lines
+138
to
+140
| v <- liftIO $ runRowDecoderCPS decoder env | ||
| (throwIO . PersistMarshalError) | ||
| pure |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| v <- liftIO $ runRowDecoderCPS decoder env | |
| (throwIO . PersistMarshalError) | |
| pure | |
| v <- | |
| liftIO $ | |
| runRowDecoderCPS | |
| decoder | |
| env | |
| (throwIO . PersistMarshalError) | |
| pure |
Comment on lines
+41
to
+44
| ( FromRow (..), DirectEntity (..), RowDecoder (..) | ||
| , newCounter, runRowReaderCPS, runRowDecoderCPS ) | ||
| import Database.Persist.DirectEncode (FieldEncode, ParamBuilder, buildParams, writeParam) | ||
| import Database.Persist.SqlBackend.Internal (SqlBackend (..), DirectQueryCap (..)) |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| ( FromRow (..), DirectEntity (..), RowDecoder (..) | |
| , newCounter, runRowReaderCPS, runRowDecoderCPS ) | |
| import Database.Persist.DirectEncode (FieldEncode, ParamBuilder, buildParams, writeParam) | |
| import Database.Persist.SqlBackend.Internal (SqlBackend (..), DirectQueryCap (..)) | |
| ( DirectEntity (..) | |
| , FromRow (..) | |
| , RowDecoder (..) | |
| , newCounter | |
| , runRowDecoderCPS | |
| , runRowReaderCPS | |
| ) | |
| import Database.Persist.DirectEncode | |
| ( FieldEncode | |
| , ParamBuilder | |
| , buildParams | |
| , writeParam | |
| ) | |
| import Database.Persist.SqlBackend.Internal | |
| ( DirectQueryCap (..) | |
| , SqlBackend (..) | |
| ) |
| {-# INLINE mempty #-} | ||
|
|
||
| -- | Encode a value and append it to the parameter builder. | ||
| writeParam :: FieldEncode param a => a -> ParamBuilder param |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| writeParam :: FieldEncode param a => a -> ParamBuilder param | |
| writeParam :: (FieldEncode param a) => a -> ParamBuilder param |
| , rawQueryDirect | ||
| , rawSqlDirect | ||
| , rawQueryDirectPV | ||
| , rawSqlDirectPV |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| , rawSqlDirectPV | |
| , rawSqlDirect |
| -- encoded via the backend's 'FieldEncode' instance for 'PersistValue'. | ||
| rawQueryDirectPV | ||
| :: forall a backend m1 m2 | ||
| . ( FromRow (Env backend) a, HasDirectQuery backend |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| . ( FromRow (Env backend) a, HasDirectQuery backend | |
| . ( FromRow (Env backend) a | |
| , HasDirectQuery backend |
| -- 'SqlBackend'). | ||
| class DirectEntity a where | ||
| lookupDirectDecoder | ||
| :: Typeable env |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| :: Typeable env | |
| :: (Typeable env) |
| acq = directQuerySource backend sql params | ||
| pure $ fmap (.| decodeWithPrepare) acq | ||
| where | ||
| decodeWithPrepare :: MonadIO m => ConduitM (Env backend) a m () |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| decodeWithPrepare :: MonadIO m => ConduitM (Env backend) a m () | |
| decodeWithPrepare :: (MonadIO m) => ConduitM (Env backend) a m () |
| ( FieldEncode (..) | ||
| , ParamBuilder (..) | ||
| , ToRow (..) | ||
| , writeParam |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| , writeParam |
Comment on lines
+10
to
+15
| | ISRSingleCustom Text [PersistValue] | ||
| -- ^ Like 'ISRSingle' but carries a custom parameter list instead of | ||
| -- using the default flattened row-major values. This allows backends | ||
| -- to rearrange parameters (e.g. column-major arrays for @UNNEST@). | ||
| -- | ||
| -- @since 2.18.2 |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| | ISRSingleCustom Text [PersistValue] | |
| -- ^ Like 'ISRSingle' but carries a custom parameter list instead of | |
| -- using the default flattened row-major values. This allows backends | |
| -- to rearrange parameters (e.g. column-major arrays for @UNNEST@). | |
| -- | |
| -- @since 2.18.2 | |
| | -- | Like 'ISRSingle' but carries a custom parameter list instead of | |
| -- using the default flattened row-major values. This allows backends | |
| -- to rearrange parameters (e.g. column-major arrays for @UNNEST@). | |
| -- | |
| -- @since 2.18.2 | |
| ISRSingleCustom Text [PersistValue] |
Comment on lines
+146
to
+148
| :: forall r. env | ||
| -> (Text -> IO r) -- on error | ||
| -> (a -> IO r) -- on success |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| :: forall r. env | |
| -> (Text -> IO r) -- on error | |
| -> (a -> IO r) -- on success | |
| :: forall r | |
| . env | |
| -> (Text -> IO r) -- on error | |
| -> (a -> IO r) -- on success |
| import Database.Persist.Sql.DirectRaw | ||
| ( HasDirectQuery (..) | ||
| , rawQueryDirect | ||
| , rawSqlDirect |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| , rawSqlDirect |
| , prepareNextField | ||
| , runRowReader | ||
| , runRowReaderCPS | ||
| , runRowDecoderCPS |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| , runRowDecoderCPS |
| ISRSingle sql -> rawSql sql (concat valss) | ||
| _ -> error "ISRSingle is expected from the connInsertManySql function" | ||
| ISRSingleCustom sql params -> rawSql sql params | ||
| _ -> error "ISRSingle or ISRSingleCustom is expected from the connInsertManySql function" |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| _ -> error "ISRSingle or ISRSingleCustom is expected from the connInsertManySql function" | |
| _ -> | |
| error | |
| "ISRSingle or ISRSingleCustom is expected from the connInsertManySql function" |
|
|
||
| -- | Run a 'RowDecoder' in CPS. | ||
| runRowDecoderCPS | ||
| :: RowDecoder env a -> env |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| :: RowDecoder env a -> env | |
| :: RowDecoder env a | |
| -> env |
Comment on lines
+79
to
+80
| , DirectEntity (..) | ||
| , Counter |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| , DirectEntity (..) | |
| , Counter | |
| , RowDecoder (..) | |
| , RowReader (..) |
Comment on lines
+96
to
+101
| decoder <- liftIO $ prepareRow firstEnv ctr | ||
| (throwIO . PersistMarshalError) | ||
| pure | ||
| val <- liftIO $ runRowDecoderCPS decoder firstEnv | ||
| (throwIO . PersistMarshalError) | ||
| pure |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| decoder <- liftIO $ prepareRow firstEnv ctr | |
| (throwIO . PersistMarshalError) | |
| pure | |
| val <- liftIO $ runRowDecoderCPS decoder firstEnv | |
| (throwIO . PersistMarshalError) | |
| pure | |
| decoder <- | |
| liftIO $ | |
| prepareRow | |
| firstEnv | |
| ctr | |
| (throwIO . PersistMarshalError) | |
| pure | |
| val <- | |
| liftIO $ | |
| runRowDecoderCPS | |
| decoder | |
| firstEnv | |
| (throwIO . PersistMarshalError) | |
| pure |
| -- encoded via the backend's 'FieldEncode' instance for 'PersistValue'. | ||
| rawSqlDirectPV | ||
| :: forall a backend m | ||
| . ( FromRow (Env backend) a, HasDirectQuery backend |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| . ( FromRow (Env backend) a, HasDirectQuery backend | |
| . ( FromRow (Env backend) a | |
| , HasDirectQuery backend |
Comment on lines
+104
to
+106
| v <- liftIO $ runRowDecoderCPS decoder env | ||
| (throwIO . PersistMarshalError) | ||
| pure |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| v <- liftIO $ runRowDecoderCPS decoder env | |
| (throwIO . PersistMarshalError) | |
| pure | |
| v <- | |
| liftIO $ | |
| runRowDecoderCPS | |
| decoder | |
| env | |
| (throwIO . PersistMarshalError) | |
| pure |
| -- decodes directly. Otherwise it returns 'Nothing' and the caller | ||
| -- should fall back to the 'PersistValue' path. | ||
| rawSqlDirectCompat | ||
| :: forall a m. (DirectEntity a, MonadIO m) |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| :: forall a m. (DirectEntity a, MonadIO m) | |
| :: forall a m | |
| . (DirectEntity a, MonadIO m) |
| :: forall a backend m1 m2 | ||
| . ( FromRow (Env backend) a, HasDirectQuery backend | ||
| , FieldEncode (Param backend) PersistValue | ||
| , MonadIO m1, MonadIO m2 ) |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| , MonadIO m1, MonadIO m2 ) | |
| , MonadIO m1 | |
| , MonadIO m2 | |
| ) |
| :: forall a backend m | ||
| . ( FromRow (Env backend) a, HasDirectQuery backend | ||
| , FieldEncode (Param backend) PersistValue | ||
| , MonadIO m ) |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| , MonadIO m ) | |
| , MonadIO m | |
| ) |
Comment on lines
+61
to
+62
| -> Text -- ^ SQL | ||
| -> V.Vector (Param backend) -- ^ Encoded parameters |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| -> Text -- ^ SQL | |
| -> V.Vector (Param backend) -- ^ Encoded parameters | |
| -> Text | |
| -- ^ SQL | |
| -> V.Vector (Param backend) | |
| -- ^ Encoded parameters |
Comment on lines
+74
to
+75
| ( RowReader (..) | ||
| , RowDecoder (..) |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| ( RowReader (..) | |
| , RowDecoder (..) | |
| ( Counter | |
| , DirectEntity (..) |
| -- 'Typeable' and @eqTypeRep@. | ||
| data DirectQueryCap where | ||
| MkDirectQueryCap | ||
| :: forall env. Typeable env |
There was a problem hiding this comment.
Restyled by fourmolu
Suggested change
| :: forall env. Typeable env | |
| :: forall env | |
| . (Typeable env) |
1 task
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
1 participant
Add this suggestion to a batch that can be applied as a single commit.This suggestion is invalid because no changes were made to the code.Suggestions cannot be applied while the pull request is closed.Suggestions cannot be applied while viewing a subset of changes.Only one suggestion per line can be applied in a batch.Add this suggestion to a batch that can be applied as a single commit.Applying suggestions on deleted lines is not supported.You must change the existing code in this line in order to create a valid suggestion.Outdated suggestions cannot be applied.This suggestion has been applied or marked resolved.Suggestions cannot be applied from pending reviews.Suggestions cannot be applied on multi-line comments.Suggestions cannot be applied while the pull request is queued to merge.Suggestion cannot be applied right now. Please check back later.
Summary
DirectDecodemodule:RowReader,FieldDecode,FromRowwith prepare-once viaprepareRow/RowDecoder,DirectEntityclass for SqlBackend bridgeDirectEncodemodule:FieldEncode,ParamBuilder(zero-copy vector-builder monoid),ToRowSql.DirectRaw:HasDirectQuery,rawQueryDirect,rawSqlDirect,rawSqlDirectCompatSql.Experimental: drop-in replacement forDatabase.Persist.Sqlthat re-exports the direct codec APIDirectQueryCapexistential toSqlBackendfor Typeable-basedSqlBackendbridgeISRSingleCustomtoInsertSqlResultfor UNNEST bulk inserts