{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE CPP #-}
module Database.MSSQLServer.Query.ResultSet ( ResultSet (..)
, Result (..)
) where
import Control.Applicative ((<$>))
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
noResult :: Parser' ()
noResult = do
_ <- trySatisfyMany $ not . isTSDoneOrDoneProc
_ <- trySatisfy isTSDoneOrDoneProc
return ()
where
isTSDoneOrDoneProc :: TokenStream -> Bool
isTSDoneOrDoneProc (TSDone{}) = True
isTSDoneOrDoneProc (TSDoneProc{}) = True
isTSDoneOrDoneProc _ = False
returnStatus :: Parser' ReturnStatus
returnStatus = do
_ <- trySatisfyMany $ not . isTSReturnStatus
TSReturnStatus rets <- trySatisfy isTSReturnStatus
_ <- trySatisfy isTSDoneProc
return $ ReturnStatus $ fromIntegral rets
where
isTSReturnStatus :: TokenStream -> Bool
isTSReturnStatus (TSReturnStatus{}) = True
isTSReturnStatus _ = False
isTSDoneProc :: TokenStream -> Bool
isTSDoneProc (TSDoneProc{}) = True
isTSDoneProc _ = False
rowCount :: Parser' RowCount
rowCount = do
_ <- trySatisfyMany $ not . isTSDone
TSDone (Done _ _ rc) <- trySatisfy isTSDone
return $ RowCount $ fromIntegral rc
listOfRow :: Row a => Parser' ([a])
listOfRow = do
tsCmd <- trySatisfy isTSColMetaData
_ <- trySatisfyMany $ not . isTSRow
tsRows <- trySatisfyMany isTSRow
_ <- trySatisfyMany $ not . isTSDone
_ <- trySatisfy $ isTSDone
return $
let
(TSColMetaData (maybeCmd)) = tsCmd
mcds = case (\(ColMetaData x) -> x) <$> maybeCmd of
Nothing -> error "listOfRow: ColMetaData is necessary"
Just mcds' -> mcds'
rows = (\(TSRow row) -> getRawBytes <$> row) <$> tsRows
in fromListOfRawBytes mcds <$> rows
where
isTSColMetaData :: TokenStream -> Bool
isTSColMetaData (TSColMetaData{}) = True
isTSColMetaData _ = False
isTSRow :: TokenStream -> Bool
isTSRow (TSRow{}) = True
isTSRow _ = False
getRawBytes :: RowColumnData -> RawBytes
getRawBytes (RCDOrdinal dt) = dt
getRawBytes (RCDLarge _ _ dt) = dt
isTSDone :: TokenStream -> Bool
isTSDone (TSDone{}) = True
isTSDone _ = False
class ResultSet a where
resultSetParser :: Parser' a
instance ResultSet () where
resultSetParser = noResult
instance ResultSet RowCount where
resultSetParser = rowCount
instance ResultSet ReturnStatus where
resultSetParser = returnStatus
instance (Row a) => ResultSet [a] where
resultSetParser = listOfRow
forM [2..30] $ \n -> do
dec <- resultSetTupleQ n
return dec
class Result a where
resultParser :: Parser' a
instance Result () where
resultParser = noResult
instance Result RowCount where
resultParser = rowCount
instance Result ReturnStatus where
resultParser = returnStatus
instance Row a => Result [a] where
resultParser = listOfRow