{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE CPP #-}
module Database.MSSQLServer.Query.ResultSet ( ResultSet (..)
, Result (..)
) where
import Control.Applicative(Alternative((<|>)),many,(<$>))
import Database.Tds.Message
import Database.MSSQLServer.Query.Row
import Database.MSSQLServer.Query.Only
import Database.MSSQLServer.Query.TokenStreamParser
import Database.MSSQLServer.Query.Template
import Control.Monad(forM)
import Language.Haskell.TH (runIO,pprint)
#if MIN_VERSION_mtl(2,2,1)
import Control.Monad.Except
#else
import Control.Monad.Error
#endif
errorDone :: Parser TokenStream
errorDone :: Parser TokenStream
errorDone = do
[TokenStream]
_ <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ (TokenStream -> Bool) -> Parser TokenStream
satisfy forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenStream -> Bool
isTSError
TokenStream
ts <- (TokenStream -> Bool) -> Parser TokenStream
satisfy TokenStream -> Bool
isTSError
[TokenStream]
_ <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ (TokenStream -> Bool) -> Parser TokenStream
satisfy forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenStream -> Bool
isTSDoneOrDoneProc
TokenStream
_ <- (TokenStream -> Bool) -> Parser TokenStream
satisfy TokenStream -> Bool
isFinalTSDoneOrDoneProc
forall (m :: * -> *) a. Monad m => a -> m a
return TokenStream
ts
where
isTSError :: TokenStream -> Bool
isTSError :: TokenStream -> Bool
isTSError (TSError{}) = Bool
True
isTSError TokenStream
_ = Bool
False
trySatisfy :: (TokenStream -> Bool) -> Parser' TokenStream
trySatisfy :: (TokenStream -> Bool) -> Parser' TokenStream
trySatisfy TokenStream -> Bool
f = do
TokenStream
ts <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ ((TokenStream -> Bool) -> Parser TokenStream
satisfyNotError TokenStream -> Bool
f) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TokenStream
errorDone
case TokenStream
ts of
TSError Info
ei -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Info
ei
TokenStream
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return TokenStream
ts
trySatisfyMany :: (TokenStream -> Bool) -> Parser' [TokenStream]
trySatisfyMany :: (TokenStream -> Bool) -> Parser' [TokenStream]
trySatisfyMany TokenStream -> Bool
f = do
[TokenStream]
tss <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ (forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ (TokenStream -> Bool) -> Parser TokenStream
satisfyNotError TokenStream -> Bool
f) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((\TokenStream
x->[TokenStream
x]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TokenStream
errorDone)
case [TokenStream]
tss of
(TSError Info
ei):[TokenStream]
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Info
ei
[TokenStream]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return [TokenStream]
tss
noResultDone :: Parser' ()
noResultDone :: Parser' ()
noResultDone = do
[TokenStream]
_ <- (TokenStream -> Bool) -> Parser' [TokenStream]
trySatisfyMany forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenStream -> Bool
isTSDoneOrDoneProc
TokenStream
_ <- (TokenStream -> Bool) -> Parser' TokenStream
trySatisfy TokenStream -> Bool
isTSDoneOrDoneProc
forall (m :: * -> *) a. Monad m => a -> m a
return ()
noResultFinalDone :: Parser' ()
noResultFinalDone :: Parser' ()
noResultFinalDone = do
[TokenStream]
_ <- (TokenStream -> Bool) -> Parser' [TokenStream]
trySatisfyMany forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenStream -> Bool
isFinalTSDoneOrDoneProc
TokenStream
_ <- (TokenStream -> Bool) -> Parser' TokenStream
trySatisfy TokenStream -> Bool
isFinalTSDoneOrDoneProc
forall (m :: * -> *) a. Monad m => a -> m a
return ()
noResultFinalDone' :: Parser' ()
noResultFinalDone' :: Parser' ()
noResultFinalDone' = do
[TokenStream]
_ <- (TokenStream -> Bool) -> Parser' [TokenStream]
trySatisfyMany forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenStream -> Bool
isTSDoneOrDoneProc
TokenStream
_ <- (TokenStream -> Bool) -> Parser' TokenStream
trySatisfy TokenStream -> Bool
isFinalTSDoneOrDoneProc
forall (m :: * -> *) a. Monad m => a -> m a
return ()
returnStatus :: Parser' ReturnStatus
returnStatus :: Parser' ReturnStatus
returnStatus = do
[TokenStream]
_ <- (TokenStream -> Bool) -> Parser' [TokenStream]
trySatisfyMany forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenStream -> Bool
isTSReturnStatus
TSReturnStatus Int32
rets <- (TokenStream -> Bool) -> Parser' TokenStream
trySatisfy TokenStream -> Bool
isTSReturnStatus
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> ReturnStatus
ReturnStatus forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
rets
where
isTSReturnStatus :: TokenStream -> Bool
isTSReturnStatus :: TokenStream -> Bool
isTSReturnStatus (TSReturnStatus{}) = Bool
True
isTSReturnStatus TokenStream
_ = Bool
False
returnStatusDone :: Parser' ReturnStatus
returnStatusDone :: Parser' ReturnStatus
returnStatusDone = do
ReturnStatus
rets <- Parser' ReturnStatus
returnStatus
[TokenStream]
_ <- (TokenStream -> Bool) -> Parser' [TokenStream]
trySatisfyMany forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenStream -> Bool
isTSDoneProc
TokenStream
_ <- (TokenStream -> Bool) -> Parser' TokenStream
trySatisfy TokenStream -> Bool
isTSDoneProc
forall (m :: * -> *) a. Monad m => a -> m a
return ReturnStatus
rets
returnStatusFinalDone :: Parser' ReturnStatus
returnStatusFinalDone :: Parser' ReturnStatus
returnStatusFinalDone = do
ReturnStatus
rets <- Parser' ReturnStatus
returnStatus
[TokenStream]
_ <- (TokenStream -> Bool) -> Parser' [TokenStream]
trySatisfyMany forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenStream -> Bool
isFinalTSDoneProc
TokenStream
_ <- (TokenStream -> Bool) -> Parser' TokenStream
trySatisfy TokenStream -> Bool
isFinalTSDoneProc
forall (m :: * -> *) a. Monad m => a -> m a
return ReturnStatus
rets
returnStatusFinalDone' :: Parser' ReturnStatus
returnStatusFinalDone' :: Parser' ReturnStatus
returnStatusFinalDone' = do
ReturnStatus
rets <- Parser' ReturnStatus
returnStatus
[TokenStream]
_ <- (TokenStream -> Bool) -> Parser' [TokenStream]
trySatisfyMany forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenStream -> Bool
isTSDoneProc
TokenStream
_ <- (TokenStream -> Bool) -> Parser' TokenStream
trySatisfy TokenStream -> Bool
isFinalTSDoneProc
forall (m :: * -> *) a. Monad m => a -> m a
return ReturnStatus
rets
rowCountDone :: Parser' RowCount
rowCountDone :: Parser' RowCount
rowCountDone = do
[TokenStream]
_ <- (TokenStream -> Bool) -> Parser' [TokenStream]
trySatisfyMany forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenStream -> Bool
isTSDone
TSDone (Done DoneStatus
_ DoneStatus
_ Int32
rc) <- (TokenStream -> Bool) -> Parser' TokenStream
trySatisfy TokenStream -> Bool
isTSDone
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> RowCount
RowCount forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
rc
rowCountFinalDone :: Parser' RowCount
rowCountFinalDone :: Parser' RowCount
rowCountFinalDone = do
[TokenStream]
_ <- (TokenStream -> Bool) -> Parser' [TokenStream]
trySatisfyMany forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenStream -> Bool
isFinalTSDone
TSDone (Done DoneStatus
_ DoneStatus
_ Int32
rc) <- (TokenStream -> Bool) -> Parser' TokenStream
trySatisfy TokenStream -> Bool
isFinalTSDone
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> RowCount
RowCount forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
rc
rowCountFinalDone' :: Parser' RowCount
rowCountFinalDone' :: Parser' RowCount
rowCountFinalDone' = do
[TokenStream]
_ <- (TokenStream -> Bool) -> Parser' [TokenStream]
trySatisfyMany forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenStream -> Bool
isTSDone
TSDone (Done DoneStatus
_ DoneStatus
_ Int32
rc) <- (TokenStream -> Bool) -> Parser' TokenStream
trySatisfy TokenStream -> Bool
isFinalTSDone
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> RowCount
RowCount forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
rc
listOfRow :: Row a => Parser' ([a])
listOfRow :: forall a. Row a => Parser' [a]
listOfRow = do
TokenStream
tsCmd <- (TokenStream -> Bool) -> Parser' TokenStream
trySatisfy TokenStream -> Bool
isTSColMetaData
[TokenStream]
_ <- (TokenStream -> Bool) -> Parser' [TokenStream]
trySatisfyMany forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenStream -> Bool
isTSRow
[TokenStream]
tsRows <- (TokenStream -> Bool) -> Parser' [TokenStream]
trySatisfyMany TokenStream -> Bool
isTSRow
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
let
(TSColMetaData (Maybe ColMetaData
maybeCmd)) = TokenStream
tsCmd
mcds :: [MetaColumnData]
mcds = case (\(ColMetaData [MetaColumnData]
x) -> [MetaColumnData]
x) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ColMetaData
maybeCmd of
Maybe [MetaColumnData]
Nothing -> forall a. HasCallStack => [Char] -> a
error [Char]
"listOfRow: ColMetaData is necessary"
Just [MetaColumnData]
mcds' -> [MetaColumnData]
mcds'
rows :: [[RawBytes]]
rows = (\(TSRow [RowColumnData]
row) -> RowColumnData -> RawBytes
getRawBytes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RowColumnData]
row) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TokenStream]
tsRows
in forall a. Row a => [MetaColumnData] -> [RawBytes] -> a
fromListOfRawBytes [MetaColumnData]
mcds forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[RawBytes]]
rows
where
isTSColMetaData :: TokenStream -> Bool
isTSColMetaData :: TokenStream -> Bool
isTSColMetaData (TSColMetaData{}) = Bool
True
isTSColMetaData TokenStream
_ = Bool
False
isTSRow :: TokenStream -> Bool
isTSRow :: TokenStream -> Bool
isTSRow (TSRow{}) = Bool
True
isTSRow TokenStream
_ = Bool
False
getRawBytes :: RowColumnData -> RawBytes
getRawBytes :: RowColumnData -> RawBytes
getRawBytes (RCDOrdinal RawBytes
dt) = RawBytes
dt
getRawBytes (RCDLarge Maybe TextPointer
_ Maybe TimeStamp
_ RawBytes
dt) = RawBytes
dt
listOfRowDone :: Row a => Parser' ([a])
listOfRowDone :: forall a. Row a => Parser' [a]
listOfRowDone = do
[a]
rs <- forall a. Row a => Parser' [a]
listOfRow
[TokenStream]
_ <- (TokenStream -> Bool) -> Parser' [TokenStream]
trySatisfyMany forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenStream -> Bool
isTSDone
TokenStream
_ <- (TokenStream -> Bool) -> Parser' TokenStream
trySatisfy forall a b. (a -> b) -> a -> b
$ TokenStream -> Bool
isTSDone
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
rs
listOfRowFinalDone :: Row a => Parser' ([a])
listOfRowFinalDone :: forall a. Row a => Parser' [a]
listOfRowFinalDone = do
[a]
rs <- forall a. Row a => Parser' [a]
listOfRow
[TokenStream]
_ <- (TokenStream -> Bool) -> Parser' [TokenStream]
trySatisfyMany forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenStream -> Bool
isFinalTSDone
TokenStream
_ <- (TokenStream -> Bool) -> Parser' TokenStream
trySatisfy forall a b. (a -> b) -> a -> b
$ TokenStream -> Bool
isFinalTSDone
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
rs
listOfRowFinalDone' :: Row a => Parser' ([a])
listOfRowFinalDone' :: forall a. Row a => Parser' [a]
listOfRowFinalDone' = do
[a]
rs <- forall a. Row a => Parser' [a]
listOfRow
[TokenStream]
_ <- (TokenStream -> Bool) -> Parser' [TokenStream]
trySatisfyMany forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenStream -> Bool
isTSDone
TokenStream
_ <- (TokenStream -> Bool) -> Parser' TokenStream
trySatisfy forall a b. (a -> b) -> a -> b
$ TokenStream -> Bool
isFinalTSDone
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
rs
class ResultSet a where
resultSetParser :: Parser' a
instance ResultSet () where
resultSetParser :: Parser' ()
resultSetParser = Parser' ()
noResultFinalDone
instance ResultSet RowCount where
resultSetParser :: Parser' RowCount
resultSetParser = Parser' RowCount
rowCountFinalDone
instance ResultSet ReturnStatus where
resultSetParser :: Parser' ReturnStatus
resultSetParser = Parser' ReturnStatus
returnStatusFinalDone
instance (Row a) => ResultSet [a] where
resultSetParser :: Parser' [a]
resultSetParser = forall a. Row a => Parser' [a]
listOfRowFinalDone