packages feed

hasql-transaction (empty) → 0.3.0.3

raw patch · 6 files changed

+297/−0 lines, 6 filesdep +base-preludedep +bytestringdep +bytestring-tree-buildersetup-changed

Dependencies added: base-prelude, bytestring, bytestring-tree-builder, contravariant, contravariant-extras, either, hasql, postgresql-error-codes, transformers

Files

+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (c) 2015, Nikita Volkov++Permission is hereby granted, free of charge, to any person+obtaining a copy of this software and associated documentation+files (the "Software"), to deal in the Software without+restriction, including without limitation the rights to use,+copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following+conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hasql-transaction.cabal view
@@ -0,0 +1,62 @@+name:+  hasql-transaction+version:+  0.3.0.3+category:+  Hasql, Database, PostgreSQL+synopsis:+  A composable abstraction over the retryable transactions for Hasql+homepage:+  https://github.com/nikita-volkov/hasql-transaction +bug-reports:+  https://github.com/nikita-volkov/hasql-transaction/issues +author:+  Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer:+  Nikita Volkov <nikita.y.volkov@mail.ru>+copyright:+  (c) 2015, Nikita Volkov+license:+  MIT+license-file:+  LICENSE+build-type:+  Simple+cabal-version:+  >=1.10+++source-repository head+  type:+    git+  location:+    git://github.com/nikita-volkov/hasql-transaction.git+++library+  hs-source-dirs:+    library+  ghc-options:+  default-extensions:+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+  default-language:+    Haskell2010+  other-modules:+    Hasql.Transaction.Prelude+    Hasql.Transaction.Queries+  exposed-modules:+    Hasql.Transaction+  build-depends:+    hasql >= 0.14 && < 0.15,+    -- database:+    postgresql-error-codes >= 1 && < 2,+    -- data:+    bytestring-tree-builder >= 0.1 && < 0.3,+    bytestring >= 0.10 && < 0.11,+    -- control:+    contravariant >= 1.3 && < 2,+    contravariant-extras >= 0.3 && < 0.4,+    either >= 4.4.1 && < 5,+    transformers >= 0.3 && < 0.5,+    -- general:+    base-prelude >= 0.1.19 && < 0.2
+ library/Hasql/Transaction.hs view
@@ -0,0 +1,96 @@+module Hasql.Transaction+(+  -- * Transaction settings+  Mode(..),+  IsolationLevel(..),+  -- * Transaction monad+  Transaction,+  run,+  query,+)+where++import Hasql.Transaction.Prelude+import qualified Hasql.Connection as Connection+import qualified Hasql.Query as Query+import qualified Hasql.Transaction.Queries as Queries+import qualified PostgreSQL.ErrorCodes as ErrorCodes+++-- |+-- A composable abstraction over the retryable transactions.+-- +-- Executes multiple queries under the specified mode and isolation level,+-- while automatically retrying the transaction in case of conflicts.+-- Thus this abstraction closely reproduces the behaviour of 'STM'.+newtype Transaction a =+  Transaction (ReaderT (Connection.Connection, IORef Int) (EitherT Query.ResultsError IO) a)+  deriving (Functor, Applicative, Monad)++-- |+-- +data Mode =+  -- |+  -- Read-only. No writes possible.+  Read |+  -- |+  -- Write and commit.+  Write |+  -- |+  -- Write without committing.+  -- Useful for testing, +  -- allowing you to modify your database, +  -- producing some result based on your changes,+  -- and letting Hasql roll all the changes back on the exit from the transaction.+  WriteWithoutCommitting+  deriving (Show, Eq, Ord, Enum, Bounded)++-- |+-- For reference see+-- <http://www.postgresql.org/docs/current/static/transaction-iso.html the Postgres' documentation>.+-- +data IsolationLevel =+  ReadCommitted |+  RepeatableRead |+  Serializable+  deriving (Show, Eq, Ord, Enum, Bounded)++-- |+-- Execute the transaction using the provided isolation level, mode and a database connection.+{-# INLINABLE run #-}+run :: Transaction a -> IsolationLevel -> Mode -> Connection.Connection -> IO (Either Query.ResultsError a)+run (Transaction tx) isolation mode connection =+  runEitherT $ do+    EitherT $ Query.run (Queries.beginTransaction mode') () connection+    counterRef <- lift $ newIORef 0+    resultEither <- lift $ runEitherT $ runReaderT tx (connection, counterRef)+    case resultEither of+      Left (Query.ResultError (Query.ServerError code _ _ _))+        | code == ErrorCodes.serialization_failure ->+          EitherT $ run (Transaction tx) isolation mode connection+      _ -> do+        result <- EitherT $ pure resultEither+        let+          query =+            if commit+              then Queries.commitTransaction+              else Queries.abortTransaction+          in+            EitherT $ Query.run query () connection+        pure result+  where+    mode' =+      (unsafeCoerce isolation, write)+    (write, commit) =+      case mode of+        Read -> (False, True)+        Write -> (True, True)+        WriteWithoutCommitting -> (True, False)++-- |+-- Execute a query in the context of a transaction.+{-# INLINABLE query #-}+query :: a -> Query.Query a b -> Transaction b+query params query =+  Transaction $ ReaderT $ \(connection, _) -> EitherT $+  Query.run query params connection
+ library/Hasql/Transaction/Prelude.hs view
@@ -0,0 +1,36 @@+module Hasql.Transaction.Prelude+( +  module Exports,+)+where+++-- base-prelude+-------------------------+import BasePrelude as Exports hiding (assert, left, right, isLeft, isRight, error)++-- transformers+-------------------------+import Control.Monad.IO.Class as Exports+import Control.Monad.Trans.Class as Exports+import Control.Monad.Trans.Maybe as Exports hiding (liftListen, liftPass)+import Control.Monad.Trans.Reader as Exports hiding (liftCallCC, liftCatch)+import Control.Monad.Trans.State.Strict as Exports hiding (liftCallCC, liftCatch, liftListen, liftPass)++-- contravariant+-------------------------+import Data.Functor.Contravariant as Exports+import Data.Functor.Contravariant.Divisible as Exports++-- contravariant-extras+-------------------------+import Contravariant.Extras as Exports++-- either+-------------------------+import Control.Monad.Trans.Either as Exports+import Data.Either.Combinators as Exports++-- bytestring+-------------------------+import Data.ByteString as Exports (ByteString)
+ library/Hasql/Transaction/Queries.hs view
@@ -0,0 +1,79 @@+module Hasql.Transaction.Queries+where++import Hasql.Transaction.Prelude+import qualified Hasql.Query as HQ+import qualified Hasql.Encoding as HE+import qualified Hasql.Decoding as HD+import qualified ByteString.TreeBuilder as TB+++-- * Transactions+-------------------------++data Isolation =+  ReadCommitted |+  RepeatableRead |+  Serializable ++type TransactionMode =+  (Isolation, Bool)++beginTransaction :: TransactionMode -> HQ.Query () ()+beginTransaction (isolation, write) =+  HQ.Query sql HE.unit HD.unit True+  where+    sql =+      TB.toByteString $+      mconcat $+      [+        "BEGIN "+        ,+        case isolation of+          ReadCommitted  -> "ISOLATION LEVEL READ COMMITTED"+          RepeatableRead -> "ISOLATION LEVEL REPEATABLE READ"+          Serializable   -> "ISOLATION LEVEL SERIALIZABLE"+        ,+        " "+        ,+        case write of+          True  -> "READ WRITE"+          False -> "READ ONLY"+      ]++commitTransaction :: HQ.Query () ()+commitTransaction =+  HQ.Query "commit" HE.unit HD.unit True++abortTransaction :: HQ.Query () ()+abortTransaction =+  HQ.Query "abort" HE.unit HD.unit True+++-- * Streaming+-------------------------++declareCursor :: ByteString -> ByteString -> HE.Params a -> HQ.Query a ()+declareCursor name sql encoder =+  HQ.Query sql' encoder HD.unit False+  where+    sql' =+      TB.toByteString $+      "DECLARE " <> TB.byteString name <> " NO SCROLL CURSOR FOR " <> TB.byteString sql++closeCursor :: HQ.Query ByteString ()+closeCursor =+  HQ.Query "CLOSE $1" (HE.value HE.bytea) HD.unit True++fetchFromCursor :: (b -> a -> b) -> b -> HD.Row a -> HQ.Query (Int64, ByteString) b+fetchFromCursor step init rowDec =+  HQ.Query sql encoder decoder True+  where+    sql =+      "FETCH FORWARD $1 FROM $2"+    encoder =+      contrazip2+        (HE.value HE.int8)+        (HE.value HE.bytea)+    decoder =+      HD.foldlRows step init rowDec