mirror of
https://github.com/nikita-volkov/hasql.git
synced 2024-12-28 13:02:31 +03:00
RowParser -> CxRow
This commit is contained in:
parent
260425abed
commit
284b5b74e0
@ -89,7 +89,7 @@ library
|
||||
other-modules:
|
||||
Hasql.Prelude
|
||||
Hasql.QParser
|
||||
Hasql.RowParser
|
||||
Hasql.CxRow
|
||||
Hasql.TH
|
||||
exposed-modules:
|
||||
Hasql
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
Loading…
Reference in New Issue
Block a user