module Database.Persist.Sql.Raw where
import Control.Exception (throwIO)
import Control.Monad (liftM, when)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Logger (logDebugNS, runLoggingT)
import Control.Monad.Reader (MonadReader, ReaderT, ask)
import Control.Monad.Trans.Resource (MonadResource, release)
import Data.Acquire (Acquire, allocateAcquire, mkAcquire, with)
import Data.Conduit
import Data.IORef (newIORef, readIORef, writeIORef)
import Data.Int (Int64)
import Data.Text (Text, pack)
import qualified Data.Text as T
import Database.Persist
import Database.Persist.Sql.Class
import Database.Persist.Sql.Types
import Database.Persist.Sql.Types.Internal
import Database.Persist.SqlBackend.Internal.StatementCache
rawQuery :: (MonadResource m, MonadReader env m, BackendCompatible SqlBackend env)
=> Text
-> [PersistValue]
-> ConduitM () [PersistValue] m ()
rawQuery :: Text -> [PersistValue] -> ConduitM () [PersistValue] m ()
rawQuery Text
sql [PersistValue]
vals = do
Acquire (ConduitM () [PersistValue] m ())
srcRes <- ReaderT env IO (Acquire (ConduitM () [PersistValue] m ()))
-> ConduitT
() [PersistValue] m (Acquire (ConduitM () [PersistValue] m ()))
forall (m :: * -> *) backend b.
(MonadIO m, MonadReader backend m) =>
ReaderT backend IO b -> m b
liftPersist (ReaderT env IO (Acquire (ConduitM () [PersistValue] m ()))
-> ConduitT
() [PersistValue] m (Acquire (ConduitM () [PersistValue] m ())))
-> ReaderT env IO (Acquire (ConduitM () [PersistValue] m ()))
-> ConduitT
() [PersistValue] m (Acquire (ConduitM () [PersistValue] m ()))
forall a b. (a -> b) -> a -> b
$ Text
-> [PersistValue]
-> ReaderT env IO (Acquire (ConduitM () [PersistValue] m ()))
forall (m1 :: * -> *) (m2 :: * -> *) env.
(MonadIO m1, MonadIO m2, BackendCompatible SqlBackend env) =>
Text
-> [PersistValue]
-> ReaderT env m1 (Acquire (ConduitM () [PersistValue] m2 ()))
rawQueryRes Text
sql [PersistValue]
vals
(ReleaseKey
releaseKey, ConduitM () [PersistValue] m ()
src) <- Acquire (ConduitM () [PersistValue] m ())
-> ConduitT
() [PersistValue] m (ReleaseKey, ConduitM () [PersistValue] m ())
forall (m :: * -> *) a.
MonadResource m =>
Acquire a -> m (ReleaseKey, a)
allocateAcquire Acquire (ConduitM () [PersistValue] m ())
srcRes
ConduitM () [PersistValue] m ()
src
ReleaseKey -> ConduitM () [PersistValue] m ()
forall (m :: * -> *). MonadIO m => ReleaseKey -> m ()
release ReleaseKey
releaseKey
rawQueryRes
:: (MonadIO m1, MonadIO m2, BackendCompatible SqlBackend env)
=> Text
-> [PersistValue]
-> ReaderT env m1 (Acquire (ConduitM () [PersistValue] m2 ()))
rawQueryRes :: Text
-> [PersistValue]
-> ReaderT env m1 (Acquire (ConduitM () [PersistValue] m2 ()))
rawQueryRes Text
sql [PersistValue]
vals = do
SqlBackend
conn <- env -> SqlBackend
forall sup sub. BackendCompatible sup sub => sub -> sup
projectBackend (env -> SqlBackend)
-> ReaderT env m1 env -> ReaderT env m1 SqlBackend
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` ReaderT env m1 env
forall r (m :: * -> *). MonadReader r m => m r
ask
let make :: IO Statement
make = do
LoggingT IO ()
-> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> IO ()
forall (m :: * -> *) a.
LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT (Text -> Text -> LoggingT IO ()
forall (m :: * -> *). MonadLogger m => Text -> Text -> m ()
logDebugNS (String -> Text
pack String
"SQL") (Text -> LoggingT IO ()) -> Text -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
T.append Text
sql (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"; " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [PersistValue] -> String
forall a. Show a => a -> String
show [PersistValue]
vals)
(SqlBackend -> Loc -> Text -> LogLevel -> LogStr -> IO ()
connLogFunc SqlBackend
conn)
SqlBackend -> Text -> IO Statement
getStmtConn SqlBackend
conn Text
sql
Acquire (ConduitM () [PersistValue] m2 ())
-> ReaderT env m1 (Acquire (ConduitM () [PersistValue] m2 ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Acquire (ConduitM () [PersistValue] m2 ())
-> ReaderT env m1 (Acquire (ConduitM () [PersistValue] m2 ())))
-> Acquire (ConduitM () [PersistValue] m2 ())
-> ReaderT env m1 (Acquire (ConduitM () [PersistValue] m2 ()))
forall a b. (a -> b) -> a -> b
$ do
Statement
stmt <- IO Statement -> (Statement -> IO ()) -> Acquire Statement
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire IO Statement
make Statement -> IO ()
stmtReset
Statement
-> [PersistValue] -> Acquire (ConduitM () [PersistValue] m2 ())
Statement
-> forall (m :: * -> *).
MonadIO m =>
[PersistValue] -> Acquire (ConduitM () [PersistValue] m ())
stmtQuery Statement
stmt [PersistValue]
vals
rawExecute :: (MonadIO m, BackendCompatible SqlBackend backend)
=> Text
-> [PersistValue]
-> ReaderT backend m ()
rawExecute :: Text -> [PersistValue] -> ReaderT backend m ()
rawExecute Text
x [PersistValue]
y = (Int64 -> ()) -> ReaderT backend m Int64 -> ReaderT backend m ()
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (() -> Int64 -> ()
forall a b. a -> b -> a
const ()) (ReaderT backend m Int64 -> ReaderT backend m ())
-> ReaderT backend m Int64 -> ReaderT backend m ()
forall a b. (a -> b) -> a -> b
$ Text -> [PersistValue] -> ReaderT backend m Int64
forall (m :: * -> *) backend.
(MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m Int64
rawExecuteCount Text
x [PersistValue]
y
rawExecuteCount :: (MonadIO m, BackendCompatible SqlBackend backend)
=> Text
-> [PersistValue]
-> ReaderT backend m Int64
rawExecuteCount :: Text -> [PersistValue] -> ReaderT backend m Int64
rawExecuteCount Text
sql [PersistValue]
vals = do
SqlBackend
conn <- backend -> SqlBackend
forall sup sub. BackendCompatible sup sub => sub -> sup
projectBackend (backend -> SqlBackend)
-> ReaderT backend m backend -> ReaderT backend m SqlBackend
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` ReaderT backend m backend
forall r (m :: * -> *). MonadReader r m => m r
ask
LoggingT (ReaderT backend m) ()
-> (Loc -> Text -> LogLevel -> LogStr -> IO ())
-> ReaderT backend m ()
forall (m :: * -> *) a.
LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT (Text -> Text -> LoggingT (ReaderT backend m) ()
forall (m :: * -> *). MonadLogger m => Text -> Text -> m ()
logDebugNS (String -> Text
pack String
"SQL") (Text -> LoggingT (ReaderT backend m) ())
-> Text -> LoggingT (ReaderT backend m) ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
T.append Text
sql (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"; " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [PersistValue] -> String
forall a. Show a => a -> String
show [PersistValue]
vals)
(SqlBackend -> Loc -> Text -> LogLevel -> LogStr -> IO ()
connLogFunc SqlBackend
conn)
Statement
stmt <- Text -> ReaderT backend m Statement
forall (m :: * -> *) backend.
(MonadIO m, MonadReader backend m,
BackendCompatible SqlBackend backend) =>
Text -> m Statement
getStmt Text
sql
Int64
res <- IO Int64 -> ReaderT backend m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> ReaderT backend m Int64)
-> IO Int64 -> ReaderT backend m Int64
forall a b. (a -> b) -> a -> b
$ Statement -> [PersistValue] -> IO Int64
stmtExecute Statement
stmt [PersistValue]
vals
IO () -> ReaderT backend m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT backend m ()) -> IO () -> ReaderT backend m ()
forall a b. (a -> b) -> a -> b
$ Statement -> IO ()
stmtReset Statement
stmt
Int64 -> ReaderT backend m Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
res
getStmt
:: (MonadIO m, MonadReader backend m, BackendCompatible SqlBackend backend)
=> Text -> m Statement
getStmt :: Text -> m Statement
getStmt Text
sql = do
SqlBackend
conn <- backend -> SqlBackend
forall sup sub. BackendCompatible sup sub => sub -> sup
projectBackend (backend -> SqlBackend) -> m backend -> m SqlBackend
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m backend
forall r (m :: * -> *). MonadReader r m => m r
ask
IO Statement -> m Statement
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Statement -> m Statement) -> IO Statement -> m Statement
forall a b. (a -> b) -> a -> b
$ SqlBackend -> Text -> IO Statement
getStmtConn SqlBackend
conn Text
sql
getStmtConn :: SqlBackend -> Text -> IO Statement
getStmtConn :: SqlBackend -> Text -> IO Statement
getStmtConn SqlBackend
conn Text
sql = do
let cacheK :: StatementCacheKey
cacheK = Text -> StatementCacheKey
mkCacheKeyFromQuery Text
sql
Maybe Statement
mstmt <- StatementCache -> StatementCacheKey -> IO (Maybe Statement)
statementCacheLookup (SqlBackend -> StatementCache
connStmtMap SqlBackend
conn) StatementCacheKey
cacheK
Statement
stmt <- case Maybe Statement
mstmt of
Just Statement
stmt -> Statement -> IO Statement
forall (f :: * -> *) a. Applicative f => a -> f a
pure Statement
stmt
Maybe Statement
Nothing -> do
Statement
stmt' <- IO Statement -> IO Statement
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Statement -> IO Statement) -> IO Statement -> IO Statement
forall a b. (a -> b) -> a -> b
$ SqlBackend -> Text -> IO Statement
connPrepare SqlBackend
conn Text
sql
IORef Bool
iactive <- IO (IORef Bool) -> IO (IORef Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Bool) -> IO (IORef Bool))
-> IO (IORef Bool) -> IO (IORef Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
True
let stmt :: Statement
stmt = Statement :: IO ()
-> IO ()
-> ([PersistValue] -> IO Int64)
-> (forall (m :: * -> *).
MonadIO m =>
[PersistValue] -> Acquire (ConduitM () [PersistValue] m ()))
-> Statement
Statement
{ stmtFinalize :: IO ()
stmtFinalize = do
Bool
active <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
iactive
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
active (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do Statement -> IO ()
stmtFinalize Statement
stmt'
IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
iactive Bool
False
, stmtReset :: IO ()
stmtReset = do
Bool
active <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
iactive
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
active (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Statement -> IO ()
stmtReset Statement
stmt'
, stmtExecute :: [PersistValue] -> IO Int64
stmtExecute = \[PersistValue]
x -> do
Bool
active <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
iactive
if Bool
active
then Statement -> [PersistValue] -> IO Int64
stmtExecute Statement
stmt' [PersistValue]
x
else PersistentSqlException -> IO Int64
forall e a. Exception e => e -> IO a
throwIO (PersistentSqlException -> IO Int64)
-> PersistentSqlException -> IO Int64
forall a b. (a -> b) -> a -> b
$ Text -> PersistentSqlException
StatementAlreadyFinalized Text
sql
, stmtQuery :: forall (m :: * -> *).
MonadIO m =>
[PersistValue] -> Acquire (ConduitM () [PersistValue] m ())
stmtQuery = \[PersistValue]
x -> do
Bool
active <- IO Bool -> Acquire Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Acquire Bool) -> IO Bool -> Acquire Bool
forall a b. (a -> b) -> a -> b
$ IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
iactive
if Bool
active
then Statement
-> [PersistValue] -> Acquire (ConduitM () [PersistValue] m ())
Statement
-> forall (m :: * -> *).
MonadIO m =>
[PersistValue] -> Acquire (ConduitM () [PersistValue] m ())
stmtQuery Statement
stmt' [PersistValue]
x
else IO (ConduitM () [PersistValue] m ())
-> Acquire (ConduitM () [PersistValue] m ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ConduitM () [PersistValue] m ())
-> Acquire (ConduitM () [PersistValue] m ()))
-> IO (ConduitM () [PersistValue] m ())
-> Acquire (ConduitM () [PersistValue] m ())
forall a b. (a -> b) -> a -> b
$ PersistentSqlException -> IO (ConduitM () [PersistValue] m ())
forall e a. Exception e => e -> IO a
throwIO (PersistentSqlException -> IO (ConduitM () [PersistValue] m ()))
-> PersistentSqlException -> IO (ConduitM () [PersistValue] m ())
forall a b. (a -> b) -> a -> b
$ Text -> PersistentSqlException
StatementAlreadyFinalized Text
sql
}
IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ StatementCache -> StatementCacheKey -> Statement -> IO ()
statementCacheInsert (SqlBackend -> StatementCache
connStmtMap SqlBackend
conn) StatementCacheKey
cacheK Statement
stmt
Statement -> IO Statement
forall (f :: * -> *) a. Applicative f => a -> f a
pure Statement
stmt
(SqlBackendHooks -> SqlBackend -> Text -> Statement -> IO Statement
hookGetStatement (SqlBackendHooks
-> SqlBackend -> Text -> Statement -> IO Statement)
-> SqlBackendHooks
-> SqlBackend
-> Text
-> Statement
-> IO Statement
forall a b. (a -> b) -> a -> b
$ SqlBackend -> SqlBackendHooks
connHooks SqlBackend
conn) SqlBackend
conn Text
sql Statement
stmt
rawSql :: (RawSql a, MonadIO m, BackendCompatible SqlBackend backend)
=> Text
-> [PersistValue]
-> ReaderT backend m [a]
rawSql :: Text -> [PersistValue] -> ReaderT backend m [a]
rawSql Text
stmt = [PersistValue] -> ReaderT backend m [a]
run
where
getType :: (x -> m [a]) -> a
getType :: (x -> m [a]) -> a
getType = String -> (x -> m [a]) -> a
forall a. HasCallStack => String -> a
error String
"rawSql.getType"
x :: a
x = ([PersistValue] -> ReaderT backend m [a]) -> a
forall x (m :: * -> *) a. (x -> m [a]) -> a
getType [PersistValue] -> ReaderT backend m [a]
run
process :: [PersistValue] -> Either Text a
process = [PersistValue] -> Either Text a
forall a. RawSql a => [PersistValue] -> Either Text a
rawSqlProcessRow
withStmt' :: [Text]
-> [PersistValue]
-> ConduitT [PersistValue] Void IO [a]
-> ReaderT backend m [a]
withStmt' [Text]
colSubsts [PersistValue]
params ConduitT [PersistValue] Void IO [a]
sink = do
Acquire (ConduitM () [PersistValue] IO ())
srcRes <- Text
-> [PersistValue]
-> ReaderT backend m (Acquire (ConduitM () [PersistValue] IO ()))
forall (m1 :: * -> *) (m2 :: * -> *) env.
(MonadIO m1, MonadIO m2, BackendCompatible SqlBackend env) =>
Text
-> [PersistValue]
-> ReaderT env m1 (Acquire (ConduitM () [PersistValue] m2 ()))
rawQueryRes Text
sql [PersistValue]
params
IO [a] -> ReaderT backend m [a]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [a] -> ReaderT backend m [a])
-> IO [a] -> ReaderT backend m [a]
forall a b. (a -> b) -> a -> b
$ Acquire (ConduitM () [PersistValue] IO ())
-> (ConduitM () [PersistValue] IO () -> IO [a]) -> IO [a]
forall (m :: * -> *) a b.
MonadUnliftIO m =>
Acquire a -> (a -> m b) -> m b
with Acquire (ConduitM () [PersistValue] IO ())
srcRes (\ConduitM () [PersistValue] IO ()
src -> ConduitT () Void IO [a] -> IO [a]
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void IO [a] -> IO [a])
-> ConduitT () Void IO [a] -> IO [a]
forall a b. (a -> b) -> a -> b
$ ConduitM () [PersistValue] IO ()
src ConduitM () [PersistValue] IO ()
-> ConduitT [PersistValue] Void IO [a] -> ConduitT () Void IO [a]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT [PersistValue] Void IO [a]
sink)
where
sql :: Text
sql = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text] -> [Text]
makeSubsts [Text]
colSubsts ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
T.splitOn Text
placeholder Text
stmt
placeholder :: Text
placeholder = Text
"??"
makeSubsts :: [Text] -> [Text] -> [Text]
makeSubsts (Text
s:[Text]
ss) (Text
t:[Text]
ts) = Text
t Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
s Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text] -> [Text]
makeSubsts [Text]
ss [Text]
ts
makeSubsts [] [] = []
makeSubsts [] [Text]
ts = [Text -> [Text] -> Text
T.intercalate Text
placeholder [Text]
ts]
makeSubsts [Text]
ss [] = String -> [Text]
forall a. HasCallStack => String -> a
error ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
err)
where
err :: [String]
err = [ String
"rawsql: there are still ", Int -> String
forall a. Show a => a -> String
show ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ss)
, String
"'??' placeholder substitutions to be made "
, String
"but all '??' placeholders have already been "
, String
"consumed. Please read 'rawSql's documentation "
, String
"on how '??' placeholders work."
]
run :: [PersistValue] -> ReaderT backend m [a]
run [PersistValue]
params = do
SqlBackend
conn <- backend -> SqlBackend
forall sup sub. BackendCompatible sup sub => sub -> sup
projectBackend (backend -> SqlBackend)
-> ReaderT backend m backend -> ReaderT backend m SqlBackend
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` ReaderT backend m backend
forall r (m :: * -> *). MonadReader r m => m r
ask
let (Int
colCount, [Text]
colSubsts) = (Text -> Text) -> a -> (Int, [Text])
forall a. RawSql a => (Text -> Text) -> a -> (Int, [Text])
rawSqlCols (SqlBackend -> Text -> Text
connEscapeRawName SqlBackend
conn) a
x
[Text]
-> [PersistValue]
-> ConduitT [PersistValue] Void IO [a]
-> ReaderT backend m [a]
withStmt' [Text]
colSubsts [PersistValue]
params (ConduitT [PersistValue] Void IO [a] -> ReaderT backend m [a])
-> ConduitT [PersistValue] Void IO [a] -> ReaderT backend m [a]
forall a b. (a -> b) -> a -> b
$ Int -> ConduitT [PersistValue] Void IO [a]
firstRow Int
colCount
firstRow :: Int -> ConduitT [PersistValue] Void IO [a]
firstRow Int
colCount = do
Maybe [PersistValue]
mrow <- ConduitT [PersistValue] Void IO (Maybe [PersistValue])
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await
case Maybe [PersistValue]
mrow of
Maybe [PersistValue]
Nothing -> [a] -> ConduitT [PersistValue] Void IO [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Just [PersistValue]
row
| Int
colCount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [PersistValue] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PersistValue]
row -> Maybe [PersistValue] -> ConduitT [PersistValue] Void IO [a]
getter Maybe [PersistValue]
mrow
| Bool
otherwise -> String -> ConduitT [PersistValue] Void IO [a]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ConduitT [PersistValue] Void IO [a])
-> String -> ConduitT [PersistValue] Void IO [a]
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"rawSql: wrong number of columns, got "
, Int -> String
forall a. Show a => a -> String
show ([PersistValue] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PersistValue]
row), String
" but expected ", Int -> String
forall a. Show a => a -> String
show Int
colCount
, String
" (", a -> String
forall a. RawSql a => a -> String
rawSqlColCountReason a
x, String
")." ]
getter :: Maybe [PersistValue] -> ConduitT [PersistValue] Void IO [a]
getter = ([a] -> [a])
-> Maybe [PersistValue] -> ConduitT [PersistValue] Void IO [a]
go [a] -> [a]
forall a. a -> a
id
where
go :: ([a] -> [a])
-> Maybe [PersistValue] -> ConduitT [PersistValue] Void IO [a]
go [a] -> [a]
acc Maybe [PersistValue]
Nothing = [a] -> ConduitT [PersistValue] Void IO [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> [a]
acc [])
go [a] -> [a]
acc (Just [PersistValue]
row) =
case [PersistValue] -> Either Text a
process [PersistValue]
row of
Left Text
err -> String -> ConduitT [PersistValue] Void IO [a]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Text -> String
T.unpack Text
err)
Right a
r -> ConduitT [PersistValue] Void IO (Maybe [PersistValue])
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await ConduitT [PersistValue] Void IO (Maybe [PersistValue])
-> (Maybe [PersistValue] -> ConduitT [PersistValue] Void IO [a])
-> ConduitT [PersistValue] Void IO [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([a] -> [a])
-> Maybe [PersistValue] -> ConduitT [PersistValue] Void IO [a]
go ([a] -> [a]
acc ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
ra -> [a] -> [a]
forall a. a -> [a] -> [a]
:))