diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,9 @@ +# v0.1.1.0 + +- Added `Hasql.Mapping.IsTransaction` and `Hasql.Mapping.IsSession`, completing the class family alongside `IsScalar` and `IsStatement`. +- Added `IsStatement.toSession`, `IsStatement.toPipeline`, `IsStatement.toTransaction`, `IsTransaction.toSessionWithUnboundedRetries` and `IsTransaction.toSessionWithoutRetries` runners. +- New dependency: `hasql-transaction ^>=1.2.3`. + # v0.1.0.2 - Added support for Hasql 2.0. diff --git a/hasql-mapping.cabal b/hasql-mapping.cabal --- a/hasql-mapping.cabal +++ b/hasql-mapping.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: hasql-mapping -version: 0.1.0.2 +version: 0.1.1.0 synopsis: SDK for defining modular mappings to databases on top of Hasql description: SDK for defining mappings to databases using Hasql that promotes modular design. @@ -26,6 +26,7 @@ common base default-language: Haskell2010 default-extensions: + AllowAmbiguousTypes ApplicativeDo BlockArguments DefaultSignatures @@ -51,13 +52,16 @@ exposed-modules: Hasql.Mapping Hasql.Mapping.IsScalar + Hasql.Mapping.IsSession Hasql.Mapping.IsStatement + Hasql.Mapping.IsTransaction build-depends: aeson >=2.0 && <3, base >=4.12 && <5, bytestring >=0.10 && <0.13, hasql ^>=1.10.3 || ^>=2.0, + hasql-transaction ^>=1.2.3, iproute >=1.7 && <2, scientific >=0.3 && <0.4, text >=1.2 && <3, diff --git a/src/library/Hasql/Mapping.hs b/src/library/Hasql/Mapping.hs --- a/src/library/Hasql/Mapping.hs +++ b/src/library/Hasql/Mapping.hs @@ -4,8 +4,12 @@ module Hasql.Mapping ( IsScalar, IsStatement, + IsTransaction, + IsSession, ) where import Hasql.Mapping.IsScalar (IsScalar) +import Hasql.Mapping.IsSession (IsSession) import Hasql.Mapping.IsStatement (IsStatement) +import Hasql.Mapping.IsTransaction (IsTransaction) diff --git a/src/library/Hasql/Mapping/IsSession.hs b/src/library/Hasql/Mapping/IsSession.hs new file mode 100644 --- /dev/null +++ b/src/library/Hasql/Mapping/IsSession.hs @@ -0,0 +1,50 @@ +module Hasql.Mapping.IsSession where + +import Hasql.Session (Session) + +-- | +-- Evidence that a data-structure determines a top-level database operation: one with its own +-- error channel and 'System.IO' capability, the two things a bare 'Hasql.Transaction.Transaction' +-- cannot have. +-- +-- A single 'Result' rather than separate success/error associated types. An operation with a +-- domain failure expresses it as @type XResult = Either XError A@, which names the outcome once +-- at the definition rather than in every signature. Separate error/success types would +-- additionally force infallible sessions — bulk loads via 'Hasql.Session.onLibpqConnection', +-- @LISTEN@\/@NOTIFY@, batching through 'Hasql.Session.pipeline' — to write @Error X = Void@ and +-- their callers to match an impossible 'Left'. +-- +-- Unlike 'Hasql.Mapping.IsTransaction.IsTransaction', this class needs no runner: 'session' +-- already produces a 'Session'. +-- +-- ==== __Example: insert-and-catch__ +-- +-- Insert-and-catch is preferable to check-then-insert: the latter needs 'Serializable' to be +-- correct and costs an extra round trip, while the former is correct at any isolation level in +-- one. Catching above 'Hasql.Mapping.IsTransaction.toSessionWithoutRetries' is safe because by +-- the time an error escapes the runner, the transaction has already been rolled back: +-- +-- > module MusicCatalogueDb.Sessions.RegisterAlbum where +-- > +-- > import Hasql.Mapping.IsSession +-- > import qualified Hasql.Mapping.IsTransaction as IsTransaction +-- > import Prelude +-- > +-- > data RegisterAlbum = RegisterAlbum { ... } +-- > +-- > data RegisterAlbumError = AlbumAlreadyExists +-- > +-- > type RegisterAlbumResult = Either RegisterAlbumError AlbumId +-- > +-- > instance IsSession RegisterAlbum where +-- > type Result RegisterAlbum = RegisterAlbumResult +-- > session params = +-- > catchingSqlState (\case "23505" -> Just AlbumAlreadyExists; _ -> Nothing) +-- > $ IsTransaction.toSessionWithoutRetries (InsertAlbumWithTracks params.album params.tracks) +-- +-- (@catchingSqlState@ is proposed upstream at +-- and is not yet +-- part of @hasql@; the shape above is illustrative of how it will compose over this class.) +class IsSession a where + type Result a + session :: a -> Session (Result a) diff --git a/src/library/Hasql/Mapping/IsStatement.hs b/src/library/Hasql/Mapping/IsStatement.hs --- a/src/library/Hasql/Mapping/IsStatement.hs +++ b/src/library/Hasql/Mapping/IsStatement.hs @@ -1,6 +1,9 @@ module Hasql.Mapping.IsStatement where +import qualified Hasql.Pipeline as Pipeline +import qualified Hasql.Session as Session import qualified Hasql.Statement as Statement +import qualified Hasql.Transaction as Transaction -- | -- Evidence that a data-structure models statement parameters determining the statement and its result type. @@ -53,3 +56,21 @@ class IsStatement a where type Result a statement :: Statement.Statement a (Result a) + +-- | +-- Runs the statement as a session, the construct one level up the capability ladder. Statements +-- have no retry axis, unlike 'Hasql.Mapping.IsTransaction.IsTransaction's runners, so this is the +-- one bare form. +toSession :: (IsStatement a) => a -> Session.Session (Result a) +toSession a = Session.statement a statement + +-- | +-- Runs the statement as a step of a 'Hasql.Mapping.IsTransaction.IsTransaction's 'Transaction.Transaction'. +toTransaction :: (IsStatement a) => a -> Transaction.Transaction (Result a) +toTransaction a = Transaction.statement a statement + +-- | +-- Runs the statement as a step of a 'Hasql.Session.Session's 'Pipeline.Pipeline', batching it +-- with the other statements pipelined alongside it instead of round-tripping for each. +toPipeline :: (IsStatement a) => a -> Pipeline.Pipeline (Result a) +toPipeline a = Pipeline.statement a statement diff --git a/src/library/Hasql/Mapping/IsTransaction.hs b/src/library/Hasql/Mapping/IsTransaction.hs new file mode 100644 --- /dev/null +++ b/src/library/Hasql/Mapping/IsTransaction.hs @@ -0,0 +1,104 @@ +-- | An explicit export list is required here (unlike this package's other modules) purely +-- mechanically: a module with no export list only exports entities it defines, not ones it +-- merely imports, so 'IsolationLevel' and 'Mode' would otherwise stay invisible to any instance +-- that imports only this module. +module Hasql.Mapping.IsTransaction + ( IsTransaction (..), + IsolationLevel (..), + Mode (..), + toSessionWithUnboundedRetries, + toSessionWithoutRetries, + ) +where + +import qualified Hasql.Session as Session +import Hasql.Transaction (Transaction) +import Hasql.Transaction.Sessions (IsolationLevel (..), Mode (..)) +import qualified Hasql.Transaction.Sessions as Sessions + +-- | +-- Evidence that a data-structure determines an atomic, retryable database transaction. +-- +-- 'isolation' and 'mode' are properties of the transaction, not of the call site: whether an +-- operation needs 'Serializable' is a fact about what it does, and a caller reaching for +-- 'toSessionWithUnboundedRetries' or 'toSessionWithoutRetries' cannot override or forget them. +-- +-- The defaults are the conservative ones ('Serializable' and 'Write'), so the safe case is free +-- and every relaxation is explicit and reviewable in the instance. The opposite defaults would +-- make an under-isolated transaction invisible. +-- +-- A composite transaction declares the join of its components by hand, using 'Sessions.IsolationLevel' +-- and 'Sessions.Mode'\'s 'Semigroup' instances: +-- +-- > instance IsTransaction Composite where +-- > isolation = isolation \@Part1 <> isolation \@Part2 +-- > mode = mode \@Part1 <> mode \@Part2 +-- +-- The two identities are deliberately opposite, because a reader who learns one will guess the +-- other wrong: +-- +-- * @mempty@ is @minBound@ ('ReadCommitted' and 'Read'), so that a component with no opinion +-- never downgrades a component that has one. +-- * An /omitted/ class method defaults to 'Serializable' and 'Write', so that an author who never +-- considered the question gets the safe answer. +-- +-- Both are conservative, by opposite rules. The join is declared explicitly rather than derived, +-- so changing which components make up a composite requires updating these declarations as well. +-- +-- ==== __Example of such a module__ +-- +-- > module MusicCatalogueDb.Transactions.InsertAlbumWithTracks where +-- > +-- > import Hasql.Mapping.IsTransaction +-- > import qualified Hasql.Transaction as Transaction +-- > import qualified MusicCatalogueDb.Statements.InsertAlbum as InsertAlbum +-- > import qualified MusicCatalogueDb.Statements.InsertTrack as InsertTrack +-- > import Prelude +-- > +-- > data InsertAlbumWithTracks = InsertAlbumWithTracks +-- > { album :: InsertAlbum.InsertAlbum, +-- > tracks :: [InsertTrack.InsertTrack] +-- > } +-- > +-- > type InsertAlbumWithTracksResult = InsertAlbum.InsertAlbumResult +-- > +-- > instance IsTransaction InsertAlbumWithTracks where +-- > type Result InsertAlbumWithTracks = InsertAlbumWithTracksResult +-- > isolation = ReadCommitted -- inserts only fresh rows, so no anomaly exposure +-- > transaction params = do +-- > albumId <- Transaction.statement params.album InsertAlbum.statement +-- > for_ params.tracks \track -> +-- > Transaction.statement track InsertTrack.statement +-- > pure albumId +class IsTransaction a where + type Result a + + -- | + -- Defaults to 'Serializable', the conservative choice. + isolation :: IsolationLevel + isolation = Serializable + + -- | + -- Defaults to 'Write', the conservative choice. + mode :: Mode + mode = Write + + transaction :: a -> Transaction (Result a) + +-- | +-- Runs the transaction with its declared 'isolation' and 'mode', retrying it indefinitely on +-- serialization failures and deadlocks. +-- +-- @hasql-transaction@'s retry is a @fix@ loop with no backoff and no cap: a 'Serializable' +-- transaction under sustained contention can spin indefinitely, holding a connection and never +-- surfacing an error. Prefer 'toSessionWithoutRetries' with your own bounded retry loop unless +-- that is an acceptable risk for the operation. +toSessionWithUnboundedRetries :: forall a. (IsTransaction a) => a -> Session.Session (Result a) +toSessionWithUnboundedRetries a = + Sessions.transaction (isolation @a) (mode @a) (transaction a) + +-- | +-- Runs the transaction with its declared 'isolation' and 'mode', without retrying it on failure. +toSessionWithoutRetries :: forall a. (IsTransaction a) => a -> Session.Session (Result a) +toSessionWithoutRetries a = + Sessions.transactionNoRetry (isolation @a) (mode @a) (transaction a)