{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell #-}


module Database.MSSQLServer.Query.RpcQuerySet ( RpcQuerySet (..)
                                              , RpcQuery (..)
                                              , RpcQueryId (..)
                                              , StoredProcedure (..)
                                              , RpcParamSet (..)
                                              , RpcParam (..)
                                              , RpcParamName
                                              , rpcReqBatchParam

                                              , 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
                                              ) where


import qualified Data.Text as T
import qualified Data.ByteString as B
import Data.Word (Word16(..))

import Database.Tds.Message
import Database.MSSQLServer.Query.Only
import Database.MSSQLServer.Query.Template

import Control.Monad(forM)
import Language.Haskell.TH (runIO,pprint)

import Data.Time (UTCTime(..))
import Data.UUID.Types (UUID)
import Data.Fixed (Fixed(..),HasResolution(..))


data RpcQuery a b = RpcQuery !a !b
                  deriving (Int -> RpcQuery a b -> ShowS
[RpcQuery a b] -> ShowS
RpcQuery a b -> String
(Int -> RpcQuery a b -> ShowS)
-> (RpcQuery a b -> String)
-> ([RpcQuery a b] -> ShowS)
-> Show (RpcQuery a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> RpcQuery a b -> ShowS
forall a b. (Show a, Show b) => [RpcQuery a b] -> ShowS
forall a b. (Show a, Show b) => RpcQuery a b -> String
showList :: [RpcQuery a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [RpcQuery a b] -> ShowS
show :: RpcQuery a b -> String
$cshow :: forall a b. (Show a, Show b) => RpcQuery a b -> String
showsPrec :: Int -> RpcQuery a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> RpcQuery a b -> ShowS
Show)

-- | 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).
class RpcQueryId a where
  toRpcReqBatch :: (RpcParamSet b) => a -> b -> RpcReqBatch

instance RpcQueryId Word16 where
  toRpcReqBatch :: Word16 -> b -> RpcReqBatch
toRpcReqBatch Word16
id b
ps = Word16 -> Word16 -> [RpcReqBatchParam] -> RpcReqBatch
RpcReqBatchProcId Word16
id Word16
0x0000 ([RpcReqBatchParam] -> RpcReqBatch)
-> [RpcReqBatchParam] -> RpcReqBatch
forall a b. (a -> b) -> a -> b
$ b -> [RpcReqBatchParam]
forall a. RpcParamSet a => a -> [RpcReqBatchParam]
toRpcReqBatchParams b
ps
  
instance RpcQueryId T.Text where
  toRpcReqBatch :: Text -> b -> RpcReqBatch
toRpcReqBatch Text
name b
ps = Text -> Word16 -> [RpcReqBatchParam] -> RpcReqBatch
RpcReqBatchProcName Text
name Word16
0x0000 ([RpcReqBatchParam] -> RpcReqBatch)
-> [RpcReqBatchParam] -> RpcReqBatch
forall a b. (a -> b) -> a -> b
$ b -> [RpcReqBatchParam]
forall a. RpcParamSet a => a -> [RpcReqBatchParam]
toRpcReqBatchParams b
ps

data StoredProcedure = SP_Cursor 
                     | SP_CursorOpen
                     | SP_CursorPrepare
                     | SP_CursorExecute
                     | SP_CursorPrepExec
                     | SP_CursorUnprepare
                     | SP_CursorFetch
                     | SP_CursorOption
                     | SP_CursorClose
                     | SP_ExecuteSql
                     | SP_Prepare
                     | SP_Execute
                     | SP_PrepExec
                     | SP_PrepExecRpc
                     | SP_Unprepare
                     deriving (Int -> StoredProcedure -> ShowS
[StoredProcedure] -> ShowS
StoredProcedure -> String
(Int -> StoredProcedure -> ShowS)
-> (StoredProcedure -> String)
-> ([StoredProcedure] -> ShowS)
-> Show StoredProcedure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StoredProcedure] -> ShowS
$cshowList :: [StoredProcedure] -> ShowS
show :: StoredProcedure -> String
$cshow :: StoredProcedure -> String
showsPrec :: Int -> StoredProcedure -> ShowS
$cshowsPrec :: Int -> StoredProcedure -> ShowS
Show,Int -> StoredProcedure
StoredProcedure -> Int
StoredProcedure -> [StoredProcedure]
StoredProcedure -> StoredProcedure
StoredProcedure -> StoredProcedure -> [StoredProcedure]
StoredProcedure
-> StoredProcedure -> StoredProcedure -> [StoredProcedure]
(StoredProcedure -> StoredProcedure)
-> (StoredProcedure -> StoredProcedure)
-> (Int -> StoredProcedure)
-> (StoredProcedure -> Int)
-> (StoredProcedure -> [StoredProcedure])
-> (StoredProcedure -> StoredProcedure -> [StoredProcedure])
-> (StoredProcedure -> StoredProcedure -> [StoredProcedure])
-> (StoredProcedure
    -> StoredProcedure -> StoredProcedure -> [StoredProcedure])
-> Enum StoredProcedure
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: StoredProcedure
-> StoredProcedure -> StoredProcedure -> [StoredProcedure]
$cenumFromThenTo :: StoredProcedure
-> StoredProcedure -> StoredProcedure -> [StoredProcedure]
enumFromTo :: StoredProcedure -> StoredProcedure -> [StoredProcedure]
$cenumFromTo :: StoredProcedure -> StoredProcedure -> [StoredProcedure]
enumFromThen :: StoredProcedure -> StoredProcedure -> [StoredProcedure]
$cenumFromThen :: StoredProcedure -> StoredProcedure -> [StoredProcedure]
enumFrom :: StoredProcedure -> [StoredProcedure]
$cenumFrom :: StoredProcedure -> [StoredProcedure]
fromEnum :: StoredProcedure -> Int
$cfromEnum :: StoredProcedure -> Int
toEnum :: Int -> StoredProcedure
$ctoEnum :: Int -> StoredProcedure
pred :: StoredProcedure -> StoredProcedure
$cpred :: StoredProcedure -> StoredProcedure
succ :: StoredProcedure -> StoredProcedure
$csucc :: StoredProcedure -> StoredProcedure
Enum,StoredProcedure
StoredProcedure -> StoredProcedure -> Bounded StoredProcedure
forall a. a -> a -> Bounded a
maxBound :: StoredProcedure
$cmaxBound :: StoredProcedure
minBound :: StoredProcedure
$cminBound :: StoredProcedure
Bounded)

instance RpcQueryId StoredProcedure where
  toRpcReqBatch :: StoredProcedure -> b -> RpcReqBatch
toRpcReqBatch StoredProcedure
sp b
ps = Word16 -> Word16 -> [RpcReqBatchParam] -> RpcReqBatch
RpcReqBatchProcId (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ (StoredProcedure -> Int
forall a. Enum a => a -> Int
fromEnum StoredProcedure
sp) Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Word16
0x0000 ([RpcReqBatchParam] -> RpcReqBatch)
-> [RpcReqBatchParam] -> RpcReqBatch
forall a b. (a -> b) -> a -> b
$ b -> [RpcReqBatchParam]
forall a. RpcParamSet a => a -> [RpcReqBatchParam]
toRpcReqBatchParams b
ps


type RpcParamName  = T.Text

data RpcParam a = RpcParamVal !RpcParamName !TypeInfo !a
                | RpcParamRef !RpcParamName !TypeInfo !a
                | RpcParamDefVal !RpcParamName !TypeInfo !a
                | RpcParamDefRef !RpcParamName !TypeInfo !a
                deriving (Int -> RpcParam a -> ShowS
[RpcParam a] -> ShowS
RpcParam a -> String
(Int -> RpcParam a -> ShowS)
-> (RpcParam a -> String)
-> ([RpcParam a] -> ShowS)
-> Show (RpcParam a)
forall a. Show a => Int -> RpcParam a -> ShowS
forall a. Show a => [RpcParam a] -> ShowS
forall a. Show a => RpcParam a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RpcParam a] -> ShowS
$cshowList :: forall a. Show a => [RpcParam a] -> ShowS
show :: RpcParam a -> String
$cshow :: forall a. Show a => RpcParam a -> String
showsPrec :: Int -> RpcParam a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> RpcParam a -> ShowS
Show)



rpcReqBatchParam :: (Data a) => RpcParam a -> RpcReqBatchParam
rpcReqBatchParam :: RpcParam a -> RpcReqBatchParam
rpcReqBatchParam = RpcParam a -> RpcReqBatchParam
forall a. Data a => RpcParam a -> RpcReqBatchParam
f
  where
    f :: RpcParam a -> RpcReqBatchParam
f (RpcParamVal Text
name TypeInfo
ti a
dt) = Text -> StatusFlag -> TypeInfo -> RawBytes -> RpcReqBatchParam
RpcReqBatchParam Text
name StatusFlag
0 TypeInfo
ti (TypeInfo -> a -> RawBytes
forall a. Data a => TypeInfo -> a -> RawBytes
toRawBytes TypeInfo
ti a
dt)
    f (RpcParamRef Text
name TypeInfo
ti a
dt) = Text -> StatusFlag -> TypeInfo -> RawBytes -> RpcReqBatchParam
RpcReqBatchParam Text
name StatusFlag
1 TypeInfo
ti (TypeInfo -> a -> RawBytes
forall a. Data a => TypeInfo -> a -> RawBytes
toRawBytes TypeInfo
ti a
dt)
    f (RpcParamDefVal Text
name TypeInfo
ti a
dt) = Text -> StatusFlag -> TypeInfo -> RawBytes -> RpcReqBatchParam
RpcReqBatchParam Text
name StatusFlag
2 TypeInfo
ti (TypeInfo -> a -> RawBytes
forall a. Data a => TypeInfo -> a -> RawBytes
toRawBytes TypeInfo
ti a
dt)
    f (RpcParamDefRef Text
name TypeInfo
ti a
dt) = Text -> StatusFlag -> TypeInfo -> RawBytes -> RpcReqBatchParam
RpcReqBatchParam Text
name StatusFlag
3 TypeInfo
ti (TypeInfo -> a -> RawBytes
forall a. Data a => TypeInfo -> a -> RawBytes
toRawBytes TypeInfo
ti a
dt)



class RpcParamSet a where
  toRpcReqBatchParams :: a -> [RpcReqBatchParam]

instance RpcParamSet () where
  toRpcReqBatchParams :: () -> [RpcReqBatchParam]
toRpcReqBatchParams ()
_ = []

instance (Data a) => RpcParamSet (RpcParam a) where
  toRpcReqBatchParams :: RpcParam a -> [RpcReqBatchParam]
toRpcReqBatchParams RpcParam a
v1 = [RpcReqBatchParam
b1]
    where
      !b1 :: RpcReqBatchParam
b1 = RpcParam a -> RpcReqBatchParam
forall a. Data a => RpcParam a -> RpcReqBatchParam
rpcReqBatchParam RpcParam a
v1

-- [MEMO] using Template Haskell
forM [2..60] $ \n -> do
  dec <- rpcParamSetTupleQ n
--  runIO $ putStrLn $ pprint dec
  return dec
--instance (Data a1, Data a2) => RpcParamSet (RpcParam a1, RpcParam a2) where
--  toRpcReqBatchParams (d1,d2) = [p1,bp]
--    where
--      !p1 = rpcReqBatchParam d1
--      !p2 = rpcReqBatchParam d2
--




class RpcQuerySet a where
  toRpcRequest :: a -> RpcRequest

instance (RpcQueryId a1, RpcParamSet b1) => RpcQuerySet (RpcQuery a1 b1) where
  toRpcRequest :: RpcQuery a1 b1 -> RpcRequest
toRpcRequest (RpcQuery a1
a1 b1
b1) = [RpcReqBatch] -> RpcRequest
RpcRequest [RpcReqBatch
r1]
    where
      !r1 :: RpcReqBatch
r1 = a1 -> b1 -> RpcReqBatch
forall a b. (RpcQueryId a, RpcParamSet b) => a -> b -> RpcReqBatch
toRpcReqBatch a1
a1 b1
b1

-- [MEMO] using Template Haskell
forM [2..30] $ \n -> do
  dec <- rpcQuerySetTupleQ n
--  runIO $ putStrLn $ pprint dec
  return dec
--instance (RpcQueryId a1, RpcParamSet b1, RpcQueryId a2, RpcParamSet b2) => RpcQuerySet (RpcQuery a1 b1, RpcQuery a2 b2) where
--  toRpcRequest (RpcQuery a1 b1,RpcQuery a2 b2) = RpcRequest [r1,r2]
--    where
--      !r1 = toRpcReqBatch a1 b1
--      !r2 = toRpcReqBatch a2 b2
--


decimalScale :: (HasResolution a) => Fixed a -> Scale
decimalScale :: Fixed a -> StatusFlag
decimalScale = Integer -> StatusFlag
digits (Integer -> StatusFlag)
-> (Fixed a -> Integer) -> Fixed a -> StatusFlag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixed a -> Integer
forall k (a :: k) (p :: k -> *). HasResolution a => p a -> Integer
resolution
  where
    digits :: Integer -> Scale
    digits :: Integer -> StatusFlag
digits = Double -> StatusFlag
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double -> StatusFlag)
-> (Integer -> Double) -> Integer -> StatusFlag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
10.0) (Double -> Double) -> (Integer -> Double) -> Integer -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Double
forall a. Num a => Integer -> a
fromInteger


bitVal :: (Integral a) => RpcParamName -> (Maybe a) -> RpcParam (Maybe a)
bitVal :: Text -> Maybe a -> RpcParam (Maybe a)
bitVal Text
name Maybe a
n = Text -> TypeInfo -> Maybe a -> RpcParam (Maybe a)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamVal Text
name TypeInfo
TIBitN Maybe a
n

tinyintVal :: (Integral a) => RpcParamName -> (Maybe a) -> RpcParam (Maybe a)
tinyintVal :: Text -> Maybe a -> RpcParam (Maybe a)
tinyintVal Text
name Maybe a
n = Text -> TypeInfo -> Maybe a -> RpcParam (Maybe a)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamVal Text
name TypeInfo
TIIntN1 Maybe a
n

smallintVal :: (Integral a) => RpcParamName -> (Maybe a) -> RpcParam (Maybe a)
smallintVal :: Text -> Maybe a -> RpcParam (Maybe a)
smallintVal Text
name Maybe a
n = Text -> TypeInfo -> Maybe a -> RpcParam (Maybe a)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamVal Text
name TypeInfo
TIIntN2 Maybe a
n

intVal :: (Integral a) => RpcParamName -> (Maybe a) -> RpcParam (Maybe a)
intVal :: Text -> Maybe a -> RpcParam (Maybe a)
intVal Text
name Maybe a
n = Text -> TypeInfo -> Maybe a -> RpcParam (Maybe a)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamVal Text
name TypeInfo
TIIntN4 Maybe a
n

bigintVal :: (Integral a) => RpcParamName -> (Maybe a) -> RpcParam (Maybe a)
bigintVal :: Text -> Maybe a -> RpcParam (Maybe a)
bigintVal Text
name Maybe a
n = Text -> TypeInfo -> Maybe a -> RpcParam (Maybe a)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamVal Text
name TypeInfo
TIIntN8 Maybe a
n

smallmoneyVal :: RpcParamName -> (Maybe Money) -> RpcParam (Maybe Money)
smallmoneyVal :: Text -> Maybe Money -> RpcParam (Maybe Money)
smallmoneyVal Text
name Maybe Money
m = Text -> TypeInfo -> Maybe Money -> RpcParam (Maybe Money)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamVal Text
name TypeInfo
TIMoneyN4 Maybe Money
m

moneyVal :: RpcParamName -> (Maybe Money) -> RpcParam (Maybe Money)
moneyVal :: Text -> Maybe Money -> RpcParam (Maybe Money)
moneyVal Text
name Maybe Money
m = Text -> TypeInfo -> Maybe Money -> RpcParam (Maybe Money)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamVal Text
name TypeInfo
TIMoneyN8 Maybe Money
m

smalldatetimeVal :: RpcParamName -> (Maybe UTCTime) -> RpcParam (Maybe UTCTime)
smalldatetimeVal :: Text -> Maybe UTCTime -> RpcParam (Maybe UTCTime)
smalldatetimeVal Text
name Maybe UTCTime
dt = Text -> TypeInfo -> Maybe UTCTime -> RpcParam (Maybe UTCTime)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamVal Text
name TypeInfo
TIDateTimeN4 Maybe UTCTime
dt

datetimeVal :: RpcParamName -> (Maybe UTCTime) -> RpcParam (Maybe UTCTime)
datetimeVal :: Text -> Maybe UTCTime -> RpcParam (Maybe UTCTime)
datetimeVal Text
name Maybe UTCTime
dt = Text -> TypeInfo -> Maybe UTCTime -> RpcParam (Maybe UTCTime)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamVal Text
name TypeInfo
TIDateTimeN8 Maybe UTCTime
dt

float24Val :: (Fractional a) => RpcParamName -> (Maybe a) -> RpcParam (Maybe a)
float24Val :: Text -> Maybe a -> RpcParam (Maybe a)
float24Val Text
name Maybe a
n = Text -> TypeInfo -> Maybe a -> RpcParam (Maybe a)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamVal Text
name TypeInfo
TIFltN4 Maybe a
n

realVal :: (Fractional a) => RpcParamName -> (Maybe a) -> RpcParam (Maybe a)
realVal :: Text -> Maybe a -> RpcParam (Maybe a)
realVal = Text -> Maybe a -> RpcParam (Maybe a)
forall a. Fractional a => Text -> Maybe a -> RpcParam (Maybe a)
float24Val

float53Val :: (Fractional a) => RpcParamName -> (Maybe a) -> RpcParam (Maybe a)
float53Val :: Text -> Maybe a -> RpcParam (Maybe a)
float53Val Text
name Maybe a
n = Text -> TypeInfo -> Maybe a -> RpcParam (Maybe a)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamVal Text
name TypeInfo
TIFltN8 Maybe a
n

doubleVal :: (Fractional a) => RpcParamName -> (Maybe a) -> RpcParam (Maybe a)
doubleVal :: Text -> Maybe a -> RpcParam (Maybe a)
doubleVal = Text -> Maybe a -> RpcParam (Maybe a)
forall a. Fractional a => Text -> Maybe a -> RpcParam (Maybe a)
float53Val

uniqueidentifierVal :: RpcParamName -> (Maybe UUID) -> RpcParam (Maybe UUID)
uniqueidentifierVal :: Text -> Maybe UUID -> RpcParam (Maybe UUID)
uniqueidentifierVal Text
name Maybe UUID
uuid = Text -> TypeInfo -> Maybe UUID -> RpcParam (Maybe UUID)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamVal Text
name TypeInfo
TIGUID Maybe UUID
uuid

decimalVal :: (HasResolution a) => RpcParamName -> Precision -> (Either Scale (Fixed a)) -> RpcParam (Maybe (Fixed a))
decimalVal :: Text
-> StatusFlag
-> Either StatusFlag (Fixed a)
-> RpcParam (Maybe (Fixed a))
decimalVal Text
name StatusFlag
p (Left StatusFlag
s) = Text -> TypeInfo -> Maybe (Fixed a) -> RpcParam (Maybe (Fixed a))
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamVal Text
name (StatusFlag -> StatusFlag -> TypeInfo
TIDecimalN StatusFlag
p StatusFlag
s) Maybe (Fixed a)
forall a. Maybe a
Nothing
decimalVal Text
name StatusFlag
p (Right Fixed a
f) = Text -> TypeInfo -> Maybe (Fixed a) -> RpcParam (Maybe (Fixed a))
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamVal Text
name (StatusFlag -> StatusFlag -> TypeInfo
TIDecimalN StatusFlag
p (Fixed a -> StatusFlag
forall a. HasResolution a => Fixed a -> StatusFlag
decimalScale Fixed a
f)) (Fixed a -> Maybe (Fixed a)
forall a. a -> Maybe a
Just Fixed a
f)

numericVal :: (HasResolution a) => RpcParamName -> Precision -> (Either Scale (Fixed a)) -> RpcParam (Maybe (Fixed a))
numericVal :: Text
-> StatusFlag
-> Either StatusFlag (Fixed a)
-> RpcParam (Maybe (Fixed a))
numericVal Text
name StatusFlag
p (Left StatusFlag
s) = Text -> TypeInfo -> Maybe (Fixed a) -> RpcParam (Maybe (Fixed a))
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamVal Text
name (StatusFlag -> StatusFlag -> TypeInfo
TINumericN StatusFlag
p StatusFlag
s) Maybe (Fixed a)
forall a. Maybe a
Nothing
numericVal Text
name StatusFlag
p (Right Fixed a
f) = Text -> TypeInfo -> Maybe (Fixed a) -> RpcParam (Maybe (Fixed a))
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamVal Text
name (StatusFlag -> StatusFlag -> TypeInfo
TINumericN StatusFlag
p (Fixed a -> StatusFlag
forall a. HasResolution a => Fixed a -> StatusFlag
decimalScale Fixed a
f)) (Fixed a -> Maybe (Fixed a)
forall a. a -> Maybe a
Just Fixed a
f)

charVal :: RpcParamName -> (Maybe B.ByteString) -> RpcParam (Maybe B.ByteString)
charVal :: Text -> Maybe ByteString -> RpcParam (Maybe ByteString)
charVal Text
name Maybe ByteString
Nothing = Text -> TypeInfo -> Maybe ByteString -> RpcParam (Maybe ByteString)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamVal Text
name (Word16 -> Collation -> TypeInfo
TIBigChar Word16
0 (Collation32 -> StatusFlag -> Collation
Collation Collation32
0x00000000 StatusFlag
0x00)) Maybe ByteString
forall a. Maybe a
Nothing
charVal Text
name (Just ByteString
bs) = Text -> TypeInfo -> Maybe ByteString -> RpcParam (Maybe ByteString)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamVal Text
name (Word16 -> Collation -> TypeInfo
TIBigChar (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
bs) (Collation32 -> StatusFlag -> Collation
Collation Collation32
0x00000000 StatusFlag
0x00)) (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs)

varcharVal :: RpcParamName -> (Maybe B.ByteString) -> RpcParam (Maybe B.ByteString)
varcharVal :: Text -> Maybe ByteString -> RpcParam (Maybe ByteString)
varcharVal Text
name Maybe ByteString
Nothing = Text -> TypeInfo -> Maybe ByteString -> RpcParam (Maybe ByteString)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamVal Text
name (Word16 -> Collation -> TypeInfo
TIBigVarChar Word16
0 (Collation32 -> StatusFlag -> Collation
Collation Collation32
0x00000000 StatusFlag
0x00)) Maybe ByteString
forall a. Maybe a
Nothing
varcharVal Text
name (Just ByteString
bs) = Text -> TypeInfo -> Maybe ByteString -> RpcParam (Maybe ByteString)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamVal Text
name (Word16 -> Collation -> TypeInfo
TIBigVarChar (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
bs) (Collation32 -> StatusFlag -> Collation
Collation Collation32
0x00000000 StatusFlag
0x00)) (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs)

textVal :: RpcParamName -> (Maybe B.ByteString) -> RpcParam (Maybe B.ByteString)
textVal :: Text -> Maybe ByteString -> RpcParam (Maybe ByteString)
textVal Text
name Maybe ByteString
Nothing = Text -> TypeInfo -> Maybe ByteString -> RpcParam (Maybe ByteString)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamVal Text
name (Collation32 -> Collation -> TypeInfo
TIText Collation32
0 (Collation32 -> StatusFlag -> Collation
Collation Collation32
0x00000000 StatusFlag
0x00)) Maybe ByteString
forall a. Maybe a
Nothing
textVal Text
name (Just ByteString
bs) = Text -> TypeInfo -> Maybe ByteString -> RpcParam (Maybe ByteString)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamVal Text
name (Collation32 -> Collation -> TypeInfo
TIText (Int -> Collation32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Collation32) -> Int -> Collation32
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
bs) (Collation32 -> StatusFlag -> Collation
Collation Collation32
0x00000000 StatusFlag
0x00)) (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs)

ncharVal :: RpcParamName -> (Maybe T.Text) -> RpcParam (Maybe T.Text)
ncharVal :: Text -> Maybe Text -> RpcParam (Maybe Text)
ncharVal Text
name Maybe Text
Nothing = Text -> TypeInfo -> Maybe Text -> RpcParam (Maybe Text)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamVal Text
name (Word16 -> Collation -> TypeInfo
TINChar Word16
0 (Collation32 -> StatusFlag -> Collation
Collation Collation32
0x00000000 StatusFlag
0x00)) Maybe Text
forall a. Maybe a
Nothing
ncharVal Text
name (Just Text
ts) = Text -> TypeInfo -> Maybe Text -> RpcParam (Maybe Text)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamVal Text
name (Word16 -> Collation -> TypeInfo
TINChar (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ (Text -> Int
T.length Text
ts) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) (Collation32 -> StatusFlag -> Collation
Collation Collation32
0x00000000 StatusFlag
0x00)) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ts)

nvarcharVal :: RpcParamName -> (Maybe T.Text) -> RpcParam (Maybe T.Text)
nvarcharVal :: Text -> Maybe Text -> RpcParam (Maybe Text)
nvarcharVal Text
name Maybe Text
Nothing = Text -> TypeInfo -> Maybe Text -> RpcParam (Maybe Text)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamVal Text
name (Word16 -> Collation -> TypeInfo
TINVarChar Word16
0 (Collation32 -> StatusFlag -> Collation
Collation Collation32
0x00000000 StatusFlag
0x00)) Maybe Text
forall a. Maybe a
Nothing
nvarcharVal Text
name (Just Text
ts) = Text -> TypeInfo -> Maybe Text -> RpcParam (Maybe Text)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamVal Text
name (Word16 -> Collation -> TypeInfo
TINVarChar (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ (Text -> Int
T.length Text
ts) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) (Collation32 -> StatusFlag -> Collation
Collation Collation32
0x00000000 StatusFlag
0x00)) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ts)

ntextVal :: RpcParamName -> (Maybe T.Text) -> RpcParam (Maybe T.Text)
ntextVal :: Text -> Maybe Text -> RpcParam (Maybe Text)
ntextVal Text
name Maybe Text
Nothing = Text -> TypeInfo -> Maybe Text -> RpcParam (Maybe Text)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamVal Text
name (Collation32 -> Collation -> TypeInfo
TINText Collation32
0 (Collation32 -> StatusFlag -> Collation
Collation Collation32
0x00000000 StatusFlag
0x00)) Maybe Text
forall a. Maybe a
Nothing
ntextVal Text
name (Just Text
ts) = Text -> TypeInfo -> Maybe Text -> RpcParam (Maybe Text)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamVal Text
name (Collation32 -> Collation -> TypeInfo
TINText (Int -> Collation32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Collation32) -> Int -> Collation32
forall a b. (a -> b) -> a -> b
$ (Text -> Int
T.length Text
ts) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) (Collation32 -> StatusFlag -> Collation
Collation Collation32
0x00000000 StatusFlag
0x00)) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ts)

binaryVal :: RpcParamName -> (Maybe B.ByteString) -> RpcParam (Maybe B.ByteString)
binaryVal :: Text -> Maybe ByteString -> RpcParam (Maybe ByteString)
binaryVal Text
name Maybe ByteString
Nothing = Text -> TypeInfo -> Maybe ByteString -> RpcParam (Maybe ByteString)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamVal Text
name (Word16 -> TypeInfo
TIBigBinary Word16
0) Maybe ByteString
forall a. Maybe a
Nothing
binaryVal Text
name (Just ByteString
bs) = Text -> TypeInfo -> Maybe ByteString -> RpcParam (Maybe ByteString)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamVal Text
name (Word16 -> TypeInfo
TIBigBinary (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
bs)) (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs)

varbinaryVal :: RpcParamName -> (Maybe B.ByteString) -> RpcParam (Maybe B.ByteString)
varbinaryVal :: Text -> Maybe ByteString -> RpcParam (Maybe ByteString)
varbinaryVal Text
name Maybe ByteString
Nothing = Text -> TypeInfo -> Maybe ByteString -> RpcParam (Maybe ByteString)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamVal Text
name (Word16 -> TypeInfo
TIBigVarBinary Word16
0) Maybe ByteString
forall a. Maybe a
Nothing
varbinaryVal Text
name (Just ByteString
bs) = Text -> TypeInfo -> Maybe ByteString -> RpcParam (Maybe ByteString)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamVal Text
name (Word16 -> TypeInfo
TIBigVarBinary (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
bs)) (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs)

imageVal :: RpcParamName -> (Maybe B.ByteString) -> RpcParam (Maybe B.ByteString)
imageVal :: Text -> Maybe ByteString -> RpcParam (Maybe ByteString)
imageVal Text
name Maybe ByteString
Nothing = Text -> TypeInfo -> Maybe ByteString -> RpcParam (Maybe ByteString)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamVal Text
name (Collation32 -> TypeInfo
TIImage Collation32
0) Maybe ByteString
forall a. Maybe a
Nothing
imageVal Text
name (Just ByteString
bs) = Text -> TypeInfo -> Maybe ByteString -> RpcParam (Maybe ByteString)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamVal Text
name (Collation32 -> TypeInfo
TIImage (Int -> Collation32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Collation32) -> Int -> Collation32
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
bs)) (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs)



bitRef :: (Integral a) => RpcParamName -> (Maybe a) -> RpcParam (Maybe a)
bitRef :: Text -> Maybe a -> RpcParam (Maybe a)
bitRef Text
name Maybe a
n = Text -> TypeInfo -> Maybe a -> RpcParam (Maybe a)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamRef Text
name TypeInfo
TIBitN Maybe a
n

tinyintRef :: (Integral a)  => RpcParamName -> (Maybe a) -> RpcParam (Maybe a)
tinyintRef :: Text -> Maybe a -> RpcParam (Maybe a)
tinyintRef Text
name Maybe a
n = Text -> TypeInfo -> Maybe a -> RpcParam (Maybe a)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamRef Text
name TypeInfo
TIIntN1 Maybe a
n

smallintRef :: (Integral a) => RpcParamName -> (Maybe a) -> RpcParam (Maybe a)
smallintRef :: Text -> Maybe a -> RpcParam (Maybe a)
smallintRef Text
name Maybe a
n = Text -> TypeInfo -> Maybe a -> RpcParam (Maybe a)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamRef Text
name TypeInfo
TIIntN2 Maybe a
n

intRef :: (Integral a) => RpcParamName -> (Maybe a) -> RpcParam (Maybe a)
intRef :: Text -> Maybe a -> RpcParam (Maybe a)
intRef Text
name Maybe a
n = Text -> TypeInfo -> Maybe a -> RpcParam (Maybe a)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamRef Text
name TypeInfo
TIIntN4 Maybe a
n

bigintRef :: (Integral a) => RpcParamName -> (Maybe a) -> RpcParam (Maybe a)
bigintRef :: Text -> Maybe a -> RpcParam (Maybe a)
bigintRef Text
name Maybe a
n = Text -> TypeInfo -> Maybe a -> RpcParam (Maybe a)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamRef Text
name TypeInfo
TIIntN8 Maybe a
n

smallmoneyRef :: RpcParamName -> (Maybe Money) -> RpcParam (Maybe Money)
smallmoneyRef :: Text -> Maybe Money -> RpcParam (Maybe Money)
smallmoneyRef Text
name Maybe Money
m = Text -> TypeInfo -> Maybe Money -> RpcParam (Maybe Money)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamRef Text
name TypeInfo
TIMoneyN4 Maybe Money
m

moneyRef :: RpcParamName -> (Maybe Money) -> RpcParam (Maybe Money)
moneyRef :: Text -> Maybe Money -> RpcParam (Maybe Money)
moneyRef Text
name Maybe Money
m = Text -> TypeInfo -> Maybe Money -> RpcParam (Maybe Money)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamRef Text
name TypeInfo
TIMoneyN8 Maybe Money
m

smalldatetimeRef :: RpcParamName -> (Maybe UTCTime) -> RpcParam (Maybe UTCTime)
smalldatetimeRef :: Text -> Maybe UTCTime -> RpcParam (Maybe UTCTime)
smalldatetimeRef Text
name Maybe UTCTime
dt = Text -> TypeInfo -> Maybe UTCTime -> RpcParam (Maybe UTCTime)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamRef Text
name TypeInfo
TIDateTimeN4 Maybe UTCTime
dt

datetimeRef :: RpcParamName -> (Maybe UTCTime) -> RpcParam (Maybe UTCTime)
datetimeRef :: Text -> Maybe UTCTime -> RpcParam (Maybe UTCTime)
datetimeRef Text
name Maybe UTCTime
dt = Text -> TypeInfo -> Maybe UTCTime -> RpcParam (Maybe UTCTime)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamRef Text
name TypeInfo
TIDateTimeN8 Maybe UTCTime
dt

float24Ref :: (Fractional a) => RpcParamName -> (Maybe a) -> RpcParam (Maybe a)
float24Ref :: Text -> Maybe a -> RpcParam (Maybe a)
float24Ref Text
name Maybe a
n = Text -> TypeInfo -> Maybe a -> RpcParam (Maybe a)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamRef Text
name TypeInfo
TIFltN4 Maybe a
n

realRef :: (Fractional a) => RpcParamName -> (Maybe a) -> RpcParam (Maybe a)
realRef :: Text -> Maybe a -> RpcParam (Maybe a)
realRef = Text -> Maybe a -> RpcParam (Maybe a)
forall a. Fractional a => Text -> Maybe a -> RpcParam (Maybe a)
float24Ref

float53Ref :: (Fractional a) => RpcParamName -> (Maybe a) -> RpcParam (Maybe a)
float53Ref :: Text -> Maybe a -> RpcParam (Maybe a)
float53Ref Text
name Maybe a
n = Text -> TypeInfo -> Maybe a -> RpcParam (Maybe a)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamRef Text
name TypeInfo
TIFltN8 Maybe a
n

doubleRef :: (Fractional a) => RpcParamName -> (Maybe a) -> RpcParam (Maybe a)
doubleRef :: Text -> Maybe a -> RpcParam (Maybe a)
doubleRef = Text -> Maybe a -> RpcParam (Maybe a)
forall a. Fractional a => Text -> Maybe a -> RpcParam (Maybe a)
float53Ref

uniqueidentifierRef :: RpcParamName -> (Maybe UUID) -> RpcParam (Maybe UUID)
uniqueidentifierRef :: Text -> Maybe UUID -> RpcParam (Maybe UUID)
uniqueidentifierRef Text
name Maybe UUID
uuid = Text -> TypeInfo -> Maybe UUID -> RpcParam (Maybe UUID)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamRef Text
name TypeInfo
TIGUID Maybe UUID
uuid

decimalRef :: (HasResolution a) => RpcParamName -> Precision -> (Either Scale (Fixed a)) -> RpcParam (Maybe (Fixed a))
decimalRef :: Text
-> StatusFlag
-> Either StatusFlag (Fixed a)
-> RpcParam (Maybe (Fixed a))
decimalRef Text
name StatusFlag
p (Left StatusFlag
s) = Text -> TypeInfo -> Maybe (Fixed a) -> RpcParam (Maybe (Fixed a))
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamRef Text
name (StatusFlag -> StatusFlag -> TypeInfo
TIDecimalN StatusFlag
p StatusFlag
s) Maybe (Fixed a)
forall a. Maybe a
Nothing
decimalRef Text
name StatusFlag
p (Right Fixed a
f) = Text -> TypeInfo -> Maybe (Fixed a) -> RpcParam (Maybe (Fixed a))
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamRef Text
name (StatusFlag -> StatusFlag -> TypeInfo
TIDecimalN StatusFlag
p (Fixed a -> StatusFlag
forall a. HasResolution a => Fixed a -> StatusFlag
decimalScale Fixed a
f)) (Fixed a -> Maybe (Fixed a)
forall a. a -> Maybe a
Just Fixed a
f)

numericRef :: (HasResolution a) => RpcParamName -> Precision -> (Either Scale (Fixed a)) -> RpcParam (Maybe (Fixed a))
numericRef :: Text
-> StatusFlag
-> Either StatusFlag (Fixed a)
-> RpcParam (Maybe (Fixed a))
numericRef Text
name StatusFlag
p (Left StatusFlag
s) = Text -> TypeInfo -> Maybe (Fixed a) -> RpcParam (Maybe (Fixed a))
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamRef Text
name (StatusFlag -> StatusFlag -> TypeInfo
TINumericN StatusFlag
p StatusFlag
s) Maybe (Fixed a)
forall a. Maybe a
Nothing
numericRef Text
name StatusFlag
p (Right Fixed a
f) = Text -> TypeInfo -> Maybe (Fixed a) -> RpcParam (Maybe (Fixed a))
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamRef Text
name (StatusFlag -> StatusFlag -> TypeInfo
TINumericN StatusFlag
p (Fixed a -> StatusFlag
forall a. HasResolution a => Fixed a -> StatusFlag
decimalScale Fixed a
f)) (Fixed a -> Maybe (Fixed a)
forall a. a -> Maybe a
Just Fixed a
f)

charRef :: RpcParamName -> Int -> (Maybe B.ByteString) -> RpcParam (Maybe B.ByteString)
charRef :: Text -> Int -> Maybe ByteString -> RpcParam (Maybe ByteString)
charRef Text
name Int
len Maybe ByteString
bs = Text -> TypeInfo -> Maybe ByteString -> RpcParam (Maybe ByteString)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamRef Text
name (Word16 -> Collation -> TypeInfo
TIBigChar (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) (Collation32 -> StatusFlag -> Collation
Collation Collation32
0x00000000 StatusFlag
0x00)) Maybe ByteString
bs

varcharRef :: RpcParamName -> Int -> (Maybe B.ByteString) -> RpcParam (Maybe B.ByteString)
varcharRef :: Text -> Int -> Maybe ByteString -> RpcParam (Maybe ByteString)
varcharRef Text
name Int
len Maybe ByteString
bs = Text -> TypeInfo -> Maybe ByteString -> RpcParam (Maybe ByteString)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamRef Text
name (Word16 -> Collation -> TypeInfo
TIBigVarChar (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) (Collation32 -> StatusFlag -> Collation
Collation Collation32
0x00000000 StatusFlag
0x00)) Maybe ByteString
bs

textRef :: RpcParamName -> Int -> (Maybe B.ByteString) -> RpcParam (Maybe B.ByteString)
textRef :: Text -> Int -> Maybe ByteString -> RpcParam (Maybe ByteString)
textRef Text
name Int
len Maybe ByteString
bs = Text -> TypeInfo -> Maybe ByteString -> RpcParam (Maybe ByteString)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamRef Text
name (Collation32 -> Collation -> TypeInfo
TIText (Int -> Collation32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) (Collation32 -> StatusFlag -> Collation
Collation Collation32
0x00000000 StatusFlag
0x00)) Maybe ByteString
bs

ncharRef :: RpcParamName -> Int -> (Maybe T.Text) -> RpcParam (Maybe T.Text)
ncharRef :: Text -> Int -> Maybe Text -> RpcParam (Maybe Text)
ncharRef Text
name Int
len Maybe Text
ts = Text -> TypeInfo -> Maybe Text -> RpcParam (Maybe Text)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamRef Text
name (Word16 -> Collation -> TypeInfo
TINChar (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2) (Collation32 -> StatusFlag -> Collation
Collation Collation32
0x00000000 StatusFlag
0x00)) Maybe Text
ts

nvarcharRef :: RpcParamName -> Int -> (Maybe T.Text) -> RpcParam (Maybe T.Text)
nvarcharRef :: Text -> Int -> Maybe Text -> RpcParam (Maybe Text)
nvarcharRef Text
name Int
len Maybe Text
ts = Text -> TypeInfo -> Maybe Text -> RpcParam (Maybe Text)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamRef Text
name (Word16 -> Collation -> TypeInfo
TINVarChar (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2) (Collation32 -> StatusFlag -> Collation
Collation Collation32
0x00000000 StatusFlag
0x00)) Maybe Text
ts

ntextRef :: RpcParamName -> Int -> (Maybe T.Text) -> RpcParam (Maybe T.Text)
ntextRef :: Text -> Int -> Maybe Text -> RpcParam (Maybe Text)
ntextRef Text
name Int
len Maybe Text
ts = Text -> TypeInfo -> Maybe Text -> RpcParam (Maybe Text)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamRef Text
name (Collation32 -> Collation -> TypeInfo
TINText (Int -> Collation32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Collation32) -> Int -> Collation32
forall a b. (a -> b) -> a -> b
$ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2) (Collation32 -> StatusFlag -> Collation
Collation Collation32
0x00000000 StatusFlag
0x00)) Maybe Text
ts

binaryRef :: RpcParamName -> Int -> (Maybe B.ByteString) -> RpcParam (Maybe B.ByteString)
binaryRef :: Text -> Int -> Maybe ByteString -> RpcParam (Maybe ByteString)
binaryRef Text
name Int
len Maybe ByteString
bs = Text -> TypeInfo -> Maybe ByteString -> RpcParam (Maybe ByteString)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamRef Text
name (Word16 -> TypeInfo
TIBigBinary (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)) Maybe ByteString
bs

varbinaryRef :: RpcParamName -> Int -> (Maybe B.ByteString) -> RpcParam (Maybe B.ByteString)
varbinaryRef :: Text -> Int -> Maybe ByteString -> RpcParam (Maybe ByteString)
varbinaryRef Text
name Int
len Maybe ByteString
bs = Text -> TypeInfo -> Maybe ByteString -> RpcParam (Maybe ByteString)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamRef Text
name (Word16 -> TypeInfo
TIBigVarBinary (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)) Maybe ByteString
bs

imageRef :: RpcParamName -> Int -> (Maybe B.ByteString) -> RpcParam (Maybe B.ByteString)
imageRef :: Text -> Int -> Maybe ByteString -> RpcParam (Maybe ByteString)
imageRef Text
name Int
len Maybe ByteString
bs = Text -> TypeInfo -> Maybe ByteString -> RpcParam (Maybe ByteString)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamRef Text
name (Collation32 -> TypeInfo
TIImage (Int -> Collation32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)) Maybe ByteString
bs



bitDefRef :: (Integral a) => RpcParamName -> RpcParam (Maybe a)
bitDefRef :: Text -> RpcParam (Maybe a)
bitDefRef Text
name = Text -> TypeInfo -> Maybe a -> RpcParam (Maybe a)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamDefRef Text
name TypeInfo
TIBitN Maybe a
forall a. Maybe a
Nothing

tinyintDefRef :: (Integral a)  => RpcParamName -> RpcParam (Maybe a)
tinyintDefRef :: Text -> RpcParam (Maybe a)
tinyintDefRef Text
name = Text -> TypeInfo -> Maybe a -> RpcParam (Maybe a)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamDefRef Text
name TypeInfo
TIIntN1 Maybe a
forall a. Maybe a
Nothing

smallintDefRef :: (Integral a) => RpcParamName -> RpcParam (Maybe a)
smallintDefRef :: Text -> RpcParam (Maybe a)
smallintDefRef Text
name = Text -> TypeInfo -> Maybe a -> RpcParam (Maybe a)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamDefRef Text
name TypeInfo
TIIntN2 Maybe a
forall a. Maybe a
Nothing

intDefRef :: (Integral a) => RpcParamName -> RpcParam (Maybe a)
intDefRef :: Text -> RpcParam (Maybe a)
intDefRef Text
name = Text -> TypeInfo -> Maybe a -> RpcParam (Maybe a)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamDefRef Text
name TypeInfo
TIIntN4 Maybe a
forall a. Maybe a
Nothing

bigintDefRef :: (Integral a) => RpcParamName -> RpcParam (Maybe a)
bigintDefRef :: Text -> RpcParam (Maybe a)
bigintDefRef Text
name = Text -> TypeInfo -> Maybe a -> RpcParam (Maybe a)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamDefRef Text
name TypeInfo
TIIntN8 Maybe a
forall a. Maybe a
Nothing

smallmoneyDefRef :: RpcParamName -> RpcParam (Maybe Money)
smallmoneyDefRef :: Text -> RpcParam (Maybe Money)
smallmoneyDefRef Text
name = Text -> TypeInfo -> Maybe Money -> RpcParam (Maybe Money)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamDefRef Text
name TypeInfo
TIMoneyN4 Maybe Money
forall a. Maybe a
Nothing

moneyDefRef :: RpcParamName -> RpcParam (Maybe Money)
moneyDefRef :: Text -> RpcParam (Maybe Money)
moneyDefRef Text
name = Text -> TypeInfo -> Maybe Money -> RpcParam (Maybe Money)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamDefRef Text
name TypeInfo
TIMoneyN8 Maybe Money
forall a. Maybe a
Nothing

smalldatetimeDefRef :: RpcParamName -> RpcParam (Maybe UTCTime)
smalldatetimeDefRef :: Text -> RpcParam (Maybe UTCTime)
smalldatetimeDefRef Text
name = Text -> TypeInfo -> Maybe UTCTime -> RpcParam (Maybe UTCTime)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamDefRef Text
name TypeInfo
TIDateTimeN4 Maybe UTCTime
forall a. Maybe a
Nothing

datetimeDefRef :: RpcParamName -> RpcParam (Maybe UTCTime)
datetimeDefRef :: Text -> RpcParam (Maybe UTCTime)
datetimeDefRef Text
name = Text -> TypeInfo -> Maybe UTCTime -> RpcParam (Maybe UTCTime)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamDefRef Text
name TypeInfo
TIDateTimeN8 Maybe UTCTime
forall a. Maybe a
Nothing

float24DefRef :: (Fractional a) => RpcParamName -> RpcParam (Maybe a)
float24DefRef :: Text -> RpcParam (Maybe a)
float24DefRef Text
name = Text -> TypeInfo -> Maybe a -> RpcParam (Maybe a)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamDefRef Text
name TypeInfo
TIFltN4 Maybe a
forall a. Maybe a
Nothing

realDefRef :: (Fractional a) => RpcParamName -> RpcParam (Maybe a)
realDefRef :: Text -> RpcParam (Maybe a)
realDefRef = Text -> RpcParam (Maybe a)
forall a. Fractional a => Text -> RpcParam (Maybe a)
float24DefRef

float53DefRef :: (Fractional a) => RpcParamName -> RpcParam (Maybe a)
float53DefRef :: Text -> RpcParam (Maybe a)
float53DefRef Text
name = Text -> TypeInfo -> Maybe a -> RpcParam (Maybe a)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamDefRef Text
name TypeInfo
TIFltN8 Maybe a
forall a. Maybe a
Nothing

doubleDefRef :: (Fractional a) => RpcParamName -> RpcParam (Maybe a)
doubleDefRef :: Text -> RpcParam (Maybe a)
doubleDefRef = Text -> RpcParam (Maybe a)
forall a. Fractional a => Text -> RpcParam (Maybe a)
float53DefRef

uniqueidentifierDefRef :: RpcParamName -> RpcParam (Maybe UUID)
uniqueidentifierDefRef :: Text -> RpcParam (Maybe UUID)
uniqueidentifierDefRef Text
name = Text -> TypeInfo -> Maybe UUID -> RpcParam (Maybe UUID)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamDefRef Text
name TypeInfo
TIGUID Maybe UUID
forall a. Maybe a
Nothing

decimalDefRef :: (HasResolution a) => RpcParamName -> Precision -> Scale -> RpcParam (Maybe (Fixed a))
decimalDefRef :: Text -> StatusFlag -> StatusFlag -> RpcParam (Maybe (Fixed a))
decimalDefRef Text
name StatusFlag
p StatusFlag
s = Text -> TypeInfo -> Maybe (Fixed a) -> RpcParam (Maybe (Fixed a))
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamDefRef Text
name (StatusFlag -> StatusFlag -> TypeInfo
TIDecimalN StatusFlag
p StatusFlag
s) Maybe (Fixed a)
forall a. Maybe a
Nothing

numericDefRef :: (HasResolution a) => RpcParamName -> Precision -> Scale -> RpcParam (Maybe (Fixed a))
numericDefRef :: Text -> StatusFlag -> StatusFlag -> RpcParam (Maybe (Fixed a))
numericDefRef Text
name StatusFlag
p StatusFlag
s = Text -> TypeInfo -> Maybe (Fixed a) -> RpcParam (Maybe (Fixed a))
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamDefRef Text
name (StatusFlag -> StatusFlag -> TypeInfo
TINumericN StatusFlag
p StatusFlag
s) Maybe (Fixed a)
forall a. Maybe a
Nothing

charDefRef :: RpcParamName -> Int -> RpcParam (Maybe B.ByteString)
charDefRef :: Text -> Int -> RpcParam (Maybe ByteString)
charDefRef Text
name Int
len = Text -> TypeInfo -> Maybe ByteString -> RpcParam (Maybe ByteString)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamDefRef Text
name (Word16 -> Collation -> TypeInfo
TIBigChar (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) (Collation32 -> StatusFlag -> Collation
Collation Collation32
0x00000000 StatusFlag
0x00)) Maybe ByteString
forall a. Maybe a
Nothing

varcharDefRef :: RpcParamName -> Int -> RpcParam (Maybe B.ByteString)
varcharDefRef :: Text -> Int -> RpcParam (Maybe ByteString)
varcharDefRef Text
name Int
len = Text -> TypeInfo -> Maybe ByteString -> RpcParam (Maybe ByteString)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamDefRef Text
name (Word16 -> Collation -> TypeInfo
TIBigVarChar (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) (Collation32 -> StatusFlag -> Collation
Collation Collation32
0x00000000 StatusFlag
0x00)) Maybe ByteString
forall a. Maybe a
Nothing

textDefRef :: RpcParamName -> Int -> RpcParam (Maybe B.ByteString)
textDefRef :: Text -> Int -> RpcParam (Maybe ByteString)
textDefRef Text
name Int
len = Text -> TypeInfo -> Maybe ByteString -> RpcParam (Maybe ByteString)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamDefRef Text
name (Collation32 -> Collation -> TypeInfo
TIText (Int -> Collation32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) (Collation32 -> StatusFlag -> Collation
Collation Collation32
0x00000000 StatusFlag
0x00)) Maybe ByteString
forall a. Maybe a
Nothing

ncharDefRef :: RpcParamName -> Int -> RpcParam (Maybe T.Text)
ncharDefRef :: Text -> Int -> RpcParam (Maybe Text)
ncharDefRef Text
name Int
len = Text -> TypeInfo -> Maybe Text -> RpcParam (Maybe Text)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamDefRef Text
name (Word16 -> Collation -> TypeInfo
TINChar (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2) (Collation32 -> StatusFlag -> Collation
Collation Collation32
0x00000000 StatusFlag
0x00)) Maybe Text
forall a. Maybe a
Nothing

nvarcharDefRef :: RpcParamName -> Int -> RpcParam (Maybe T.Text)
nvarcharDefRef :: Text -> Int -> RpcParam (Maybe Text)
nvarcharDefRef Text
name Int
len = Text -> TypeInfo -> Maybe Text -> RpcParam (Maybe Text)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamDefRef Text
name (Word16 -> Collation -> TypeInfo
TINVarChar (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2) (Collation32 -> StatusFlag -> Collation
Collation Collation32
0x00000000 StatusFlag
0x00)) Maybe Text
forall a. Maybe a
Nothing

ntextDefRef :: RpcParamName -> Int -> RpcParam (Maybe T.Text)
ntextDefRef :: Text -> Int -> RpcParam (Maybe Text)
ntextDefRef Text
name Int
len = Text -> TypeInfo -> Maybe Text -> RpcParam (Maybe Text)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamDefRef Text
name (Collation32 -> Collation -> TypeInfo
TINText (Int -> Collation32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Collation32) -> Int -> Collation32
forall a b. (a -> b) -> a -> b
$ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2) (Collation32 -> StatusFlag -> Collation
Collation Collation32
0x00000000 StatusFlag
0x00)) Maybe Text
forall a. Maybe a
Nothing

binaryDefRef :: RpcParamName -> Int -> RpcParam (Maybe B.ByteString)
binaryDefRef :: Text -> Int -> RpcParam (Maybe ByteString)
binaryDefRef Text
name Int
len = Text -> TypeInfo -> Maybe ByteString -> RpcParam (Maybe ByteString)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamDefRef Text
name (Word16 -> TypeInfo
TIBigBinary (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)) Maybe ByteString
forall a. Maybe a
Nothing

varbinaryDefRef :: RpcParamName -> Int -> RpcParam (Maybe B.ByteString)
varbinaryDefRef :: Text -> Int -> RpcParam (Maybe ByteString)
varbinaryDefRef Text
name Int
len = Text -> TypeInfo -> Maybe ByteString -> RpcParam (Maybe ByteString)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamDefRef Text
name (Word16 -> TypeInfo
TIBigVarBinary (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)) Maybe ByteString
forall a. Maybe a
Nothing

imageDefRef :: RpcParamName -> Int -> RpcParam (Maybe B.ByteString)
imageDefRef :: Text -> Int -> RpcParam (Maybe ByteString)
imageDefRef Text
name Int
len = Text -> TypeInfo -> Maybe ByteString -> RpcParam (Maybe ByteString)
forall a. Text -> TypeInfo -> a -> RpcParam a
RpcParamDefRef Text
name (Collation32 -> TypeInfo
TIImage (Int -> Collation32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)) Maybe ByteString
forall a. Maybe a
Nothing