From e940079a4cedb38f263dfc108ebe9ff9c3964504 Mon Sep 17 00:00:00 2001 From: Nikita Volkov Date: Sun, 12 Oct 2014 22:32:51 +0400 Subject: [PATCH] Reimplement Backend --- high-sql.cabal | 1 + library/HighSQL/Backend.hs | 153 ++++++++++++++++--------------------- library/HighSQL/Prelude.hs | 6 +- 3 files changed, 70 insertions(+), 90 deletions(-) diff --git a/high-sql.cabal b/high-sql.cabal index b2eac5e..aeb5fca 100644 --- a/high-sql.cabal +++ b/high-sql.cabal @@ -56,6 +56,7 @@ library text == 1.1.*, hashable == 1.2.*, -- control: + errors == 1.4.*, list-t >= 0.2.1 && < 0.3, mmorph == 1.0.*, monad-control == 0.3.*, diff --git a/library/HighSQL/Backend.hs b/library/HighSQL/Backend.hs index 3c0ee7b..f5ac3de 100644 --- a/library/HighSQL/Backend.hs +++ b/library/HighSQL/Backend.hs @@ -2,108 +2,83 @@ -- An open API for implementation of specific backend drivers. module HighSQL.Backend where -import HighSQL.Prelude hiding (Error) +import HighSQL.Prelude import qualified Data.Text as Text import qualified Language.Haskell.TH as TH import qualified Data.Decimal as Decimal --- | --- A database interface. --- --- Implementations are provided by driver libraries. -data Backend = - Backend { - connect :: IO Connection - } - - -data Connection = - forall s. - Connection { - -- | - -- Start a transaction in a write mode if the flag is true. - beginTransaction :: Bool -> IO (), - -- | - -- Finish the transaction, - -- while releasing all the resources acquired with 'executeAndStream'. - -- - -- The boolean defines whether to commit the updates, - -- otherwise it rolls back. - finishTransaction :: Bool -> IO (), - -- | - -- If the backend supports statement preparation, - -- this function compiles a bytestring statement - -- with placeholders if it's not compiled already, - -- and otherwise returns the cached already compiled statement. - -- IOW, it implements memoization. - -- - -- If the backend does not support this, - -- then this function should simply be implemented as a 'return'. - prepare :: ByteString -> IO s, - -- | - -- Execute a statement with values for placeholders. - execute :: s -> [Value] -> IO (), - -- | - -- Execute a statement with values for placeholders, - -- returning the amount of affected rows. - executeCountingEffects :: s -> [Value] -> IO Integer, - -- | - -- Execute a statement with values for placeholders, - -- returning the possibly generated auto-incremented value. - executeIncrementing :: s -> [Value] -> IO (Maybe Integer), - -- | - -- Execute a statement with values and an expected results stream size. - -- The expected stream size can be used by the backend to determine - -- an optimal fetching method. - executeStreaming :: s -> [Value] -> Maybe Integer -> IO ResultSet, - -- | - -- Close the connection. - disconnect :: IO () - } - - -data Error = +data Failure b = -- | -- A transaction failed and should be retried. - TransactionError | + TransactionFailure | -- | -- Cannot connect to a server -- or the connection got interrupted. - ConnectionError Text | - -- | - -- A free-form backend-specific exception. - BackendError SomeException - deriving (Show, Typeable) + ConnectionFailure Text -instance Exception Error + +type M b = + ExceptT (Failure b) IO -- | --- A row width and a stream of values. --- The length of the stream must be a multiple of the row width. -type ResultSet = - (Int, ListT IO Value) +-- A width of a row and a stream of serialized values. +type ResultsStream = + (Int, ListT IO ByteString) + + +class Backend b where + -- | + -- An argument prepared for a statement. + type StatementArgument b + -- | + -- A raw value returned from the database. + data Result b + type Connection b + -- | + -- Open a connection using the backend's settings. + connect :: b -> M b (Connection b) + -- | + -- Close the connection. + disconnect :: Connection b -> M b () + -- | + -- If the backend supports statement preparation, + -- this function compiles a bytestring statement + -- with placeholders if it's not compiled already, + -- and otherwise returns the cached already compiled statement. + -- IOW, it implements memoization. + -- + -- If the backend does not support this, + -- then this function should simply be implemented as a 'return'. + prepare :: ByteString -> Connection b -> M b s + -- | + -- Execute a statement with values for placeholders. + execute :: ByteString -> [StatementArgument b] -> Connection b -> M b () + -- | + -- Execute a statement with values for placeholders + -- and an expected results stream size. + -- The expected stream size can be used by the backend to determine + -- an optimal fetching method. + executeStreaming :: ByteString -> [StatementArgument b] -> Maybe Integer -> Connection b -> ListT (M b) r + -- | + -- Execute a statement with values for placeholders, + -- returning the amount of affected rows. + executeCountingEffects :: s -> [StatementArgument b] -> Connection b -> M b Integer + -- | + -- Start a transaction in a write mode if the flag is true. + beginTransaction :: Bool -> Connection b -> M b () + -- | + -- Finish the transaction, + -- while releasing all the resources acquired with 'executeAndStream'. + -- + -- The boolean defines whether to commit the updates, + -- otherwise it rolls back. + finishTransaction :: Bool -> Connection b -> M b () + + +class Backend b => Value v b where + renderArgument :: v -> StatementArgument b + parseResult :: Result b -> Maybe v -data Value = - Text !Text | - ByteString !ByteString | - Word32 !Word32 | - Word64 !Word64 | - Int32 !Int32 | - Int64 !Int64 | - Integer !Integer | - Char !Char | - Bool !Bool | - Double !Double | - Rational !Rational | - Day !Day | - LocalTime !LocalTime | - TimeOfDay !TimeOfDay | - ZonedTime !ZonedTime | - UTCTime !UTCTime | - NominalDiffTime !NominalDiffTime | - -- | Yes, this encodes @NULL@s. - Maybe !(Maybe Value) - deriving (Show, Data, Typeable, Generic) diff --git a/library/HighSQL/Prelude.hs b/library/HighSQL/Prelude.hs index b1d8245..6cf3e9c 100644 --- a/library/HighSQL/Prelude.hs +++ b/library/HighSQL/Prelude.hs @@ -9,7 +9,7 @@ where -- base-prelude ------------------------- -import BasePrelude as Exports hiding (left, right, tryJust, bool) +import BasePrelude as Exports hiding (left, right, tryJust, bool, isRight, isLeft) -- mtl-prelude ------------------------- @@ -19,6 +19,10 @@ import MTLPrelude as Exports hiding (shift) ------------------------- import Control.Monad.Morph as Exports +-- errors +------------------------- +import Control.Error as Exports + -- list-t ------------------------- import ListT as Exports (ListT)