mssql-simple-0.6.0.0: src/Database/MSSQLServer/Query.hs
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE CPP #-}
-- |
-- SQL Server client library implemented in Haskell
--
-- 'sql' function is useful for execution of plain sql text.
-- Also 'rpc' function is useful for stored procedure RPC with input/output parameters.
--
-- [Usage Example](https://github.com/mitsuji/mssql-simple-example/blob/master/app/Main.hs)
module Database.MSSQLServer.Query (
-- * SQL Text Query
-- $use_sql
sql
-- ** ResultSet
, ResultSet (..)
, Result (..)
, Row (..)
, Only (..)
, RowCount (..)
, ReturnStatus (..)
-- * RPC Query
-- $use_rpc
, rpc
-- ** RpcResponseSet
, RpcResponseSet (..)
, RpcResponse (..)
, RpcOutputSet (..)
-- ** RpcResultSet
, RpcResultSet (..)
, RpcResult (..)
-- ** RpcQuerySet
, RpcQuerySet (..)
, RpcQuery (..)
, RpcQueryId (..)
, StoredProcedure (..)
, RpcParamSet (..)
, RpcParam (..)
, RpcParamName
-- ** Helpers for passing parameters
, bitVal
, tinyintVal
, smallintVal
, intVal
, bigintVal
, smallmoneyVal
, moneyVal
, smalldatetimeVal
, datetimeVal
, float24Val
, realVal
, float53Val
, doubleVal
, uniqueidentifierVal
, decimalVal
, numericVal
, charVal
, varcharVal
, textVal
, ncharVal
, nvarcharVal
, ntextVal
, binaryVal
, varbinaryVal
, imageVal
, bitRef
, tinyintRef
, smallintRef
, intRef
, bigintRef
, smallmoneyRef
, moneyRef
, smalldatetimeRef
, datetimeRef
, float24Ref
, realRef
, float53Ref
, doubleRef
, uniqueidentifierRef
, decimalRef
, numericRef
, charRef
, varcharRef
, textRef
, ncharRef
, nvarcharRef
, ntextRef
, binaryRef
, varbinaryRef
, imageRef
, bitDefRef
, tinyintDefRef
, smallintDefRef
, intDefRef
, bigintDefRef
, smallmoneyDefRef
, moneyDefRef
, smalldatetimeDefRef
, datetimeDefRef
, float24DefRef
, realDefRef
, float53DefRef
, doubleDefRef
, uniqueidentifierDefRef
, decimalDefRef
, numericDefRef
, charDefRef
, varcharDefRef
, textDefRef
, ncharDefRef
, nvarcharDefRef
, ntextDefRef
, binaryDefRef
, varbinaryDefRef
, imageDefRef
-- * Exceptions
, withTransaction
, QueryError (..)
) where
import Data.Typeable(Typeable)
import Network.Socket (Socket)
import Network.Socket.ByteString (recv)
import Network.Socket.ByteString.Lazy (sendAll)
import qualified Data.Text as T
import qualified Data.Binary.Get as Get
import qualified Data.Binary.Put as Put
import Control.Exception (Exception(..),throwIO,onException)
import Database.Tds.Message
import Database.MSSQLServer.Connection (Connection(..))
import Database.MSSQLServer.Query.Only
import Database.MSSQLServer.Query.Row
import Database.MSSQLServer.Query.ResultSet
import Database.MSSQLServer.Query.RpcResponseSet
import Database.MSSQLServer.Query.RpcQuerySet
import Database.MSSQLServer.Query.TokenStreamParser
#if MIN_VERSION_mtl(2,2,1)
import Control.Monad.Except
#else
import Control.Monad.Error
runExceptT = runErrorT
#endif
data QueryError = QueryError !Info
deriving (Show,Typeable)
instance Exception QueryError
sql :: ResultSet a => Connection -> T.Text -> IO a
sql (Connection sock ps) query = do
sendAll sock $ Put.runPut $ putClientMessage ps $ CMSqlBatch $ SqlBatch query
TokenStreams tss <- readMessage sock $ Get.runGetIncremental getServerMessage
case parse responseParser tss of
[] -> fail "sql: failed to parse token streams"
(Left info,_):_ -> throwIO $ QueryError info
(Right x,_):_ -> return x
where
responseParser :: (ResultSet a) => Parser (Either Info a)
responseParser = runExceptT $ resultSetParser
rpc :: (RpcQuerySet a, RpcResponseSet b) => Connection -> a -> IO b
rpc (Connection sock ps) queries = do
sendAll sock $ Put.runPut $ putClientMessage ps $ CMRpcRequest $ toRpcRequest queries
TokenStreams tss <- readMessage sock $ Get.runGetIncremental getServerMessage
case parse rpcResponseSetParser tss of
[] -> fail "rpc: failed to parse token streams"
(x,_):_ -> return x
withTransaction :: Connection -> IO a -> IO a
withTransaction conn act = do
begin
r <- act `onException` rollback
commit
return r
where
begin = sql conn $ T.pack "BEGIN TRANSACTION" :: IO ()
commit = sql conn $ T.pack "COMMIT TRANSACTION" :: IO ()
rollback = sql conn $ T.pack "ROLLBACK TRANSACTION":: IO ()
readMessage :: Socket -> Get.Decoder a -> IO a
readMessage sock decoder = do
bs <- recv sock 512 -- [TODO] optimize
case Get.pushChunk decoder bs of
Get.Done _ _ msg -> return msg
decoder' -> readMessage sock decoder'
-- $use_sql
-- A 'sql' function accepts valid 'Connection' and SQL text.
-- And the expression could be evaluated as a instance of 'ResultSet' type class.
--
-- A 'Row' represents a record included in a query result.
-- Also list of 'Row' is a instance of 'ResultSet'.
-- So the result of select query could be obtained as follows.
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- >
-- > import Database.MSSQLServer.Connection
-- > import Database.MSSQLServer.Query
-- >
-- > sql_select1 :: Connection -> IO Int
-- > sql_select1 conn = do
-- > [Only i] <- sql conn "SELECT 2 + 2" :: IO [Only Int]
-- > return i
--
-- In SQL , uncomputable expression could be evaluated as NULL.
-- In that case, 'Maybe' type could be used.
--
-- > sql_select2 :: Connection -> IO (Maybe Int)
-- > sql_select2 conn = do
-- > [Only mi] <- sql conn "SELECT 6 / 2" :: IO [Only (Maybe Int)]
-- > return mi
--
-- > sql_select3 :: Connection -> IO (Maybe Int)
-- > sql_select3 conn = do
-- > [Only mi] <- sql conn "SELECT 6 / 0" :: IO [Only (Maybe Int)]
-- > return mi
--
-- The result of select query from SQL table could be obtained as follows.
-- A member of tuple must be a instance of 'Data' type class
-- and convertible with the SQL data type of a SQL table column.
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- >
-- > import Database.MSSQLServer.Connection
-- > import Database.MSSQLServer.Query
-- >
-- > import qualified Data.Text.Lazy as LT
-- > import Database.Tds.Message
-- > import Data.Time (UTCTime(..))
-- >
-- > sql_select4 :: Connection -> IO [(Int,String,LT.Text,Money,UTCTime,Maybe UTCTime,Maybe UTCTime)]
-- > sql_select4 conn = sql conn "SELECT * FROM TSome ORDER BY somePrice"
--
-- Any type could be a instance of 'Row' and used as the result of select query as follows.
--
-- > {-# LANGUAGE BangPatterns #-}
-- >
-- > data Some = Some { someID :: Int
-- > , someTitle :: LT.Text
-- > , someContent :: LT.Text
-- > , somePrice :: Money
-- > , someCreated:: UTCTime
-- > , someModified:: Maybe UTCTime
-- > , someDeleted:: Maybe UTCTime
-- > }
-- > deriving (Show)
-- >
-- > instance Row Some where
-- > fromListOfRawBytes [m1,m2,m3,m4,m5,m6,m7] [b1,b2,b3,b4,b5,b6,b7] = Some d1 d2 d3 d4 d5 d6 d7
-- > where
-- > !d1 = fromRawBytes (mcdTypeInfo m1) b1
-- > !d2 = fromRawBytes (mcdTypeInfo m2) b2
-- > !d3 = fromRawBytes (mcdTypeInfo m3) b3
-- > !d4 = fromRawBytes (mcdTypeInfo m4) b4
-- > !d5 = fromRawBytes (mcdTypeInfo m5) b5
-- > !d6 = fromRawBytes (mcdTypeInfo m6) b6
-- > !d7 = fromRawBytes (mcdTypeInfo m7) b7
-- >
-- > mcdTypeInfo :: MetaColumnData -> TypeInfo
-- > mcdTypeInfo (MetaColumnData _ _ ti _ _) = ti
-- >
-- > fromListOfRawBytes _ _ = error "fromListOfRawBytes: List length must be 7"
-- >
-- > sql_select5 :: Connection -> IO [Some]
-- > sql_select5 conn = sql conn "SELECT TOP 10 * FROM TSome ORDER BY somePrice DESC"
--
-- 'Row' is also a instance of 'Result' and tuple of 'Result' is a instance of 'ResultSet'.
-- So the result of multiple SQL query could be obtained simultaneously as follows.
--
-- > import Data.Monoid (mconcat)
-- >
-- > sql_select6 :: Connection -> IO ([Some],[Some])
-- > sql_select6 conn =
-- > sql conn $ mconcat ["SELECT * FROM TSome WHERE someID < 8 ORDER BY someID;",
-- > "SELECT * FROM TSome WHERE 8 <= someID AND someID < 12 ORDER BY someID DESC;"]
--
-- 'RowCount' is a instance of 'ResultSet'.
-- So the count of SQL table record affected with the SQL query could be obtained as follows.
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- >
-- > import Database.MSSQLServer.Connection
-- > import Database.MSSQLServer.Query
-- >
-- > sql_count1 :: Connection -> IO Int
-- > sql_count1 conn = do
-- > RowCount rc <- sql conn "UPDATE TSome SET somePrice = somePrice + 100 WHERE someID < 5"
-- > return rc
--
-- Also () is a instance of 'ResultSet'.
-- So the result of SQL query could be discarded as follows.
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- >
-- > import Database.MSSQLServer.Connection
-- > import Database.MSSQLServer.Query
-- >
-- > sql_discard1 :: Connection -> IO ()
-- > sql_discard1 conn = sql conn "UPDATE TSome SET somePrice = somePrice + 100 WHERE someID < 5"
--
-- Even DROP/CREATE TABLE statement could be executed as follows when your account has privileges.
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- > {-# LANGUAGE QuasiQuotes #-}
-- >
-- > import Database.MSSQLServer.Connection
-- > import Database.MSSQLServer.Query
-- > import Text.RawString.QQ (r)
-- >
-- > sql_create_table1 :: Connection -> IO ()
-- > sql_create_table1 conn = do
-- > sql conn "DROP TABLE TSome" :: IO ()
-- > sql conn [r|
-- > CREATE TABLE TSome (
-- > someID int IDENTITY(1,1) NOT NULL,
-- > someTitle nvarchar(40) NOT NULL,
-- > someContent ntext NOT NULL,
-- > somePrice money NOT NULL,
-- > someCreated datetime NOT NULL,
-- > someModified datetime NULL,
-- > someDeleted datetime NULL,
-- >
-- > CONSTRAINT PK_TSome PRIMARY KEY CLUSTERED (
-- > someID ASC
-- > )
-- > WITH (
-- > PAD_INDEX = OFF,
-- > STATISTICS_NORECOMPUTE = OFF,
-- > IGNORE_DUP_KEY = OFF,
-- > ALLOW_ROW_LOCKS = ON,
-- > ALLOW_PAGE_LOCKS = ON
-- > ) ON [PRIMARY]
-- >
-- > ) ON [PRIMARY] TEXTIMAGE_ON [PRIMARY]
-- > |]
--
-- INSERT batch could be executed within transaction as follows.
--
-- > sql_insert1 :: Connection -> IO ()
-- > sql_insert1 conn = sql conn [r|
-- > BEGIN TRAN;
-- > INSERT INTO TSome(someTitle,someContent,somePrice,someCreated) VALUES('title','content',12345.60,GETDATE());
-- > INSERT INTO TSome(someTitle,someContent,somePrice,someCreated) VALUES('title','content',12345.60,GETDATE());
-- > INSERT INTO TSome(someTitle,someContent,somePrice,someCreated) VALUES('title','content',12345.60,GETDATE());
-- > INSERT INTO TSome(someTitle,someContent,somePrice,someCreated) VALUES('title','content',12345.60,GETDATE());
-- > COMMIT TRAN;
-- > |]
-- >
--
-- 'ReturnStatus' is a instance of 'ResultSet'.
-- So when a stored procedure executed in SQL text, Return status of the execution could be obtained as follows.
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- >
-- > import Database.MSSQLServer.Connection
-- > import Database.MSSQLServer.Query
-- >
-- > sql_status1 :: Connection -> IO Int
-- > sql_status1 conn = do
-- > ReturnStatus rets <- sql conn "EXEC SP_Input1 @Val1=3"
-- > return rets
-- $use_rpc
-- Stored procedure RPC could be executed as follows.
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- >
-- > import Database.MSSQLServer.Connection
-- > import Database.MSSQLServer.Query
-- >
-- > import qualified Data.Text as T
-- > import Data.Word (Word16)
-- >
-- > rpc_sql_select1 :: Connection -> IO (RpcResponse () [Some])
-- > rpc_sql_select1 conn = rpc conn $
-- > RpcQuery ("sp_executesql"::T.Text) $ nvarcharVal "" (Just "SELECT * FROM TSome")
--
-- There several ways provided for specify stored procedures.
-- See ProcID section of [\[MS-TDS\] 2.2.6.6 RPC Request](https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-tds/619c43b6-9495-4a58-9e49-a4950db245b3).
--
-- > rpc_sql_select2 :: Connection -> Int -> IO (RpcResponse () [Some])
-- > rpc_sql_select2 conn max = rpc conn $ RpcQuery SP_ExecuteSql
-- > ( nvarcharVal "" (Just "SELECT * FROM TSome WHERE someID < @Max")
-- > , nvarcharVal "" (Just "@Max Int")
-- > , intVal "" (Just max)
-- > )
--
-- > rpc_sql_select3 :: Connection -> Int -> Int -> IO (RpcResponse () [Some])
-- > rpc_sql_select3 conn min max = rpc conn $ RpcQuery (0xa::Word16)
-- > ( nvarcharVal "" (Just "SELECT * FROM TSome WHERE @Min < someID AND someID < @Max")
-- > , nvarcharVal "" (Just "@Min Int, @Max Int")
-- > , intVal "@Min" (Just min)
-- > , intVal "@Max" (Just max)
-- > )