RowParser -> CxRow

This commit is contained in:
Nikita Volkov 2014-12-29 11:27:42 +03:00
parent 260425abed
commit 284b5b74e0
4 changed files with 16 additions and 16 deletions

View File

@ -89,7 +89,7 @@ library
other-modules:
Hasql.Prelude
Hasql.QParser
Hasql.RowParser
Hasql.CxRow
Hasql.TH
exposed-modules:
Hasql

View File

@ -86,7 +86,7 @@ main =
replicateM_ 6 process
block
context "RowParser" $ do
context "CxRow" $ do
it "should fail on incorrect arity" $ do
flip shouldSatisfy (\case Left (H.ResultError _) -> True; _ -> False) =<< do

View File

@ -52,13 +52,13 @@ module Hasql
TxListT,
-- * Row Parser
RowParser.RowParser,
CxRow.CxRow,
)
where
import Hasql.Prelude
import qualified Hasql.Backend as Bknd
import qualified Hasql.RowParser as RowParser
import qualified Hasql.CxRow as CxRow
import qualified Hasql.QParser as QParser
import qualified ListT
import qualified Data.Pool as Pool
@ -274,7 +274,7 @@ countTx =
-- Use 'maybeTx', 'listTx' or 'vectorTx' instead.
--
-- If the result is empty this executor will raise 'ResultError'.
singleTx :: RowParser.RowParser c r => Bknd.Stmt c -> Tx c s r
singleTx :: CxRow.CxRow c r => Bknd.Stmt c -> Tx c s r
singleTx =
join . fmap (maybe (Tx $ left $ ResultError "No rows on 'singleTx'") return) .
maybeTx
@ -282,25 +282,25 @@ singleTx =
-- |
-- Execute a statement,
-- which optionally produces a single result row.
maybeTx :: RowParser.RowParser c r => Bknd.Stmt c -> Tx c s (Maybe r)
maybeTx :: CxRow.CxRow c r => Bknd.Stmt c -> Tx c s (Maybe r)
maybeTx =
fmap (fmap Vector.unsafeHead . mfilter (not . Vector.null) . Just) . vectorTx
-- |
-- Execute a statement,
-- and produce a list of results.
listTx :: RowParser.RowParser c r => Bknd.Stmt c -> Tx c s [r]
listTx :: CxRow.CxRow c r => Bknd.Stmt c -> Tx c s [r]
listTx =
fmap toList . vectorTx
-- |
-- Execute a statement,
-- and produce a vector of results.
vectorTx :: RowParser.RowParser c r => Bknd.Stmt c -> Tx c s (Vector r)
vectorTx :: CxRow.CxRow c r => Bknd.Stmt c -> Tx c s (Vector r)
vectorTx s =
Tx $ do
r <- lift $ Bknd.vectorTx s
EitherT $ return $ traverse ((mapLeft ResultError) . RowParser.parseRow) $ r
EitherT $ return $ traverse ((mapLeft ResultError) . CxRow.parseRow) $ r
-- |
-- Execute a @SELECT@ statement with a cursor,
@ -311,13 +311,13 @@ vectorTx s =
-- Note that in most databases cursors require establishing a database transaction,
-- so depending on a backend the transaction may result in an error,
-- if you run it improperly.
streamTx :: RowParser.RowParser c r => Bknd.Stmt c -> Tx c s (TxListT s (Tx c s) r)
streamTx :: CxRow.CxRow c r => Bknd.Stmt c -> Tx c s (TxListT s (Tx c s) r)
streamTx s =
Tx $ do
r <- lift $ Bknd.streamTx s
return $ TxListT $ do
row <- hoist (Tx . lift) r
lift $ Tx $ EitherT $ return $ mapLeft ResultError $ RowParser.parseRow $ row
lift $ Tx $ EitherT $ return $ mapLeft ResultError $ CxRow.parseRow $ row
-- * Result Stream

View File

@ -1,4 +1,4 @@
module Hasql.RowParser where
module Hasql.CxRow where
import Hasql.Prelude
import Language.Haskell.TH
@ -10,16 +10,16 @@ import qualified Hasql.TH as THUtil
-- |
-- This class is only intended to be used with the supplied instances,
-- which should be enough to cover all use cases.
class RowParser c r where
class CxRow c r where
parseRow :: Bknd.ResultRow c -> Either Text r
instance RowParser c () where
instance CxRow c () where
parseRow row =
if Vector.null row
then Right ()
else Left "Not an empty row"
instance Bknd.CxValue c v => RowParser c (Identity v) where
instance Bknd.CxValue c v => CxRow c (Identity v) where
parseRow row = do
Identity <$> Bknd.decodeValue (Vector.unsafeHead row)
@ -35,7 +35,7 @@ return $ flip map [2 .. 24] $ \arity ->
constraints =
map (\t -> ClassP ''Bknd.CxValue [connectionType, t]) varTypes
head =
AppT (AppT (ConT ''RowParser) connectionType) (foldl AppT (TupleT arity) varTypes)
AppT (AppT (ConT ''CxRow) connectionType) (foldl AppT (TupleT arity) varTypes)
parseRowDec =
FunD 'parseRow [Clause [VarP rowVarName] (NormalB e) []]
where