{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE FlexibleInstances #-}
-- Stream Types:    https://msdn.microsoft.com/en-us/library/dd303435.aspx
-- Data Types:      https://msdn.microsoft.com/en-us/library/dd305325.aspx
-- Data Stream:     https://msdn.microsoft.com/en-us/library/dd340794.aspx


module Database.Tds.Message.DataStream ( TypeInfo (..)
                                       , RawBytes (..)
                                       , getRawBytes
                                       , putRawBytes
                                       , Data (..)
                                       ) where

import Data.Monoid((<>))
import Control.Applicative((<$>),(<*>))

import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LB

import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Encoding as LT

import Data.Word (Word8(..),Word16(..),Word32(..),Word64(..))
import Data.Int (Int8(..),Int16(..),Int32(..),Int64(..))

import Data.Binary (Put(..),Get(..),Binary(..))
import qualified Data.Binary.Put as Put
import qualified Data.Binary.Get as Get

import Data.Time (UTCTime(..))
import Data.UUID.Types (UUID)
import qualified Data.UUID.Types as UUID

import Data.Fixed(Fixed(..),HasResolution(..))

import Database.Tds.Primitives.Null
import Database.Tds.Primitives.Money
import Database.Tds.Primitives.DateTime
import Database.Tds.Primitives.Float
import Database.Tds.Primitives.Decimal
import Database.Tds.Primitives.Collation

import Data.Maybe (fromJust)




-- | [\[MS-TDS\] 2.2.5.4 Data Type Definitions](https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-tds/ffb02215-af07-4b50-8545-1fd522106c68)
data TypeInfo = TINull       -- 0x1f
              | TIBit        -- 0x32
              | TIInt1       -- 0x30
              | TIInt2       -- 0x34
              | TIInt4       -- 0x38
              | TIInt8       -- 0x7f
              | TIMoney4     -- 0x7a
              | TIMoney8     -- 0x3c
              | TIDateTime4  -- 0x3a
              | TIDateTime8  -- 0x3d
              | TIFlt4       -- 0x3b
              | TIFlt8       -- 0x3e
                
              | TIBitN        -- 0x68
              | TIIntN1       -- 0x26
              | TIIntN2       -- 0x26
              | TIIntN4       -- 0x26
              | TIIntN8       -- 0x26
              | TIMoneyN4     -- 0x6e
              | TIMoneyN8     -- 0x6e
              | TIDateTimeN4  -- 0x6f
              | TIDateTimeN8  -- 0x6f
              | TIFltN4       -- 0x6d
              | TIFltN8       -- 0x6d
                
              | TIGUID                     -- 0x24
              | TIDecimalN !Precision !Scale -- 0x6a, 0x37(legacy)
              | TINumericN !Precision !Scale -- 0x6c, 0x3f(legacy)
                
              | TIChar !Word8                  -- 0x2f(legacy) -- [TODO] test
              | TIVarChar !Word8               -- 0x27(legacy) -- [TODO] test
              | TIBigChar !Word16 !Collation    -- 0xaf
              | TIBigVarChar !Word16 !Collation -- 0xa7
              | TIText !Word32 !Collation       -- 0x23
                
              | TINChar !Word16 !Collation    -- 0xef
              | TINVarChar !Word16 !Collation -- 0xe7
              | TINText !Word32 !Collation    -- 0x63
                
              | TIBinary !Word8        -- 0x2d(legacy) -- [TODO] test
              | TIVarBinary !Word8     -- 0x25(legacy) -- [TODO] test
              | TIBigBinary !Word16    -- 0xad
              | TIBigVarBinary !Word16 -- 0xa5
              | TIImage !Word32        -- 0x22
              deriving (Int -> TypeInfo -> ShowS
[TypeInfo] -> ShowS
TypeInfo -> String
(Int -> TypeInfo -> ShowS)
-> (TypeInfo -> String) -> ([TypeInfo] -> ShowS) -> Show TypeInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeInfo -> ShowS
showsPrec :: Int -> TypeInfo -> ShowS
$cshow :: TypeInfo -> String
show :: TypeInfo -> String
$cshowList :: [TypeInfo] -> ShowS
showList :: [TypeInfo] -> ShowS
Show)


-- https://msdn.microsoft.com/en-us/library/dd358284.aspx
-- https://msdn.microsoft.com/en-us/library/dd305325.aspx
getTypeInfo :: Get TypeInfo
getTypeInfo :: Get TypeInfo
getTypeInfo = Word8 -> Get TypeInfo
f (Word8 -> Get TypeInfo) -> Get Word8 -> Get TypeInfo
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Word8
Get.getWord8
  where
    f :: Word8 -> Get TypeInfo
    f :: Word8 -> Get TypeInfo
f Word8
0x1f = TypeInfo -> Get TypeInfo
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return TypeInfo
TINull
    f Word8
0x32 = TypeInfo -> Get TypeInfo
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return TypeInfo
TIBit
    f Word8
0x30 = TypeInfo -> Get TypeInfo
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return TypeInfo
TIInt1
    f Word8
0x34 = TypeInfo -> Get TypeInfo
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return TypeInfo
TIInt2
    f Word8
0x38 = TypeInfo -> Get TypeInfo
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return TypeInfo
TIInt4
    f Word8
0x7f = TypeInfo -> Get TypeInfo
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return TypeInfo
TIInt8
    f Word8
0x7a = TypeInfo -> Get TypeInfo
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return TypeInfo
TIMoney4
    f Word8
0x3c = TypeInfo -> Get TypeInfo
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return TypeInfo
TIMoney8
    f Word8
0x3a = TypeInfo -> Get TypeInfo
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return TypeInfo
TIDateTime4
    f Word8
0x3d = TypeInfo -> Get TypeInfo
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return TypeInfo
TIDateTime8
    f Word8
0x3b = TypeInfo -> Get TypeInfo
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return TypeInfo
TIFlt4
    f Word8
0x3e = TypeInfo -> Get TypeInfo
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return TypeInfo
TIFlt8

    f Word8
0x68 = do
      Word8
_ <- Get Word8
Get.getWord8
      TypeInfo -> Get TypeInfo
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return TypeInfo
TIBitN

    f Word8
0x26 = do
      Word8
len <- Get Word8
Get.getWord8
      case Word8
len of
        Word8
1 -> TypeInfo -> Get TypeInfo
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return TypeInfo
TIIntN1
        Word8
2 -> TypeInfo -> Get TypeInfo
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return TypeInfo
TIIntN2
        Word8
4 -> TypeInfo -> Get TypeInfo
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return TypeInfo
TIIntN4
        Word8
8 -> TypeInfo -> Get TypeInfo
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return TypeInfo
TIIntN8
        Word8
_ -> String -> Get TypeInfo
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"getTypeInfo: invalid data length"

    f Word8
0x6e = do
      Word8
len <- Get Word8
Get.getWord8
      case Word8
len of
        Word8
4 -> TypeInfo -> Get TypeInfo
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return TypeInfo
TIMoneyN4
        Word8
8 -> TypeInfo -> Get TypeInfo
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return TypeInfo
TIMoneyN8
        Word8
_ -> String -> Get TypeInfo
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"getTypeInfo: invalid data length"

    f Word8
0x6f = do
      Word8
len <- Get Word8
Get.getWord8
      case Word8
len of
        Word8
4 -> TypeInfo -> Get TypeInfo
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return TypeInfo
TIDateTimeN4
        Word8
8 -> TypeInfo -> Get TypeInfo
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return TypeInfo
TIDateTimeN8
        Word8
_ -> String -> Get TypeInfo
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"getTypeInfo: invalid data length"
  
    f Word8
0x6d = do
      Word8
len <- Get Word8
Get.getWord8
      case Word8
len of
        Word8
4 -> TypeInfo -> Get TypeInfo
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return TypeInfo
TIFltN4
        Word8
8 -> TypeInfo -> Get TypeInfo
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return TypeInfo
TIFltN8
        Word8
_ -> String -> Get TypeInfo
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"getTypeInfo: invalid data length"
  
    f Word8
0x24 = do
      Word8
len <- Get Word8
Get.getWord8 -- 0x10 (16byte)
      case Word8
len of
        Word8
16 -> TypeInfo -> Get TypeInfo
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return TypeInfo
TIGUID
        Word8
_ -> String -> Get TypeInfo
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"getTypeInfo: invalid data length"
  
    f Word8
0x37 = Word8 -> Get TypeInfo
f Word8
0x6a
    f Word8
0x6a = do
      Word8
_ <- Get Word8
Get.getWord8
      Word8 -> Word8 -> TypeInfo
TIDecimalN (Word8 -> Word8 -> TypeInfo)
-> Get Word8 -> Get (Word8 -> TypeInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
Get.getWord8 -- precision
                 Get (Word8 -> TypeInfo) -> Get Word8 -> Get TypeInfo
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word8
Get.getWord8 -- scale

    f Word8
0x3f = Word8 -> Get TypeInfo
f Word8
0x6c
    f Word8
0x6c = do
      Word8
_ <- Get Word8
Get.getWord8
      Word8 -> Word8 -> TypeInfo
TINumericN (Word8 -> Word8 -> TypeInfo)
-> Get Word8 -> Get (Word8 -> TypeInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
Get.getWord8 -- precision
                 Get (Word8 -> TypeInfo) -> Get Word8 -> Get TypeInfo
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word8
Get.getWord8 -- scale

    -- [TODO] test
    -- [MEMO] no collation
    f Word8
0x2f = Word8 -> TypeInfo
TIChar (Word8 -> TypeInfo) -> Get Word8 -> Get TypeInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
Get.getWord8

    -- [TODO] test
    -- [MEMO] no collation
    f Word8
0x27 = Word8 -> TypeInfo
TIVarChar (Word8 -> TypeInfo) -> Get Word8 -> Get TypeInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
Get.getWord8

    f Word8
0xaf = Word16 -> Collation -> TypeInfo
TIBigChar (Word16 -> Collation -> TypeInfo)
-> Get Word16 -> Get (Collation -> TypeInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
Get.getWord16le
                       Get (Collation -> TypeInfo) -> Get Collation -> Get TypeInfo
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Collation
getCollation -- collation

    f Word8
0xa7 = Word16 -> Collation -> TypeInfo
TIBigVarChar (Word16 -> Collation -> TypeInfo)
-> Get Word16 -> Get (Collation -> TypeInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
Get.getWord16le
                          Get (Collation -> TypeInfo) -> Get Collation -> Get TypeInfo
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Collation
getCollation -- collation

    f Word8
0x23 = Word32 -> Collation -> TypeInfo
TIText (Word32 -> Collation -> TypeInfo)
-> Get Word32 -> Get (Collation -> TypeInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
Get.getWord32le
                    Get (Collation -> TypeInfo) -> Get Collation -> Get TypeInfo
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Collation
getCollation -- collation

    f Word8
0xef = Word16 -> Collation -> TypeInfo
TINChar (Word16 -> Collation -> TypeInfo)
-> Get Word16 -> Get (Collation -> TypeInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
Get.getWord16le
                     Get (Collation -> TypeInfo) -> Get Collation -> Get TypeInfo
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Collation
getCollation -- collation

    f Word8
0xe7 = Word16 -> Collation -> TypeInfo
TINVarChar (Word16 -> Collation -> TypeInfo)
-> Get Word16 -> Get (Collation -> TypeInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
Get.getWord16le
                        Get (Collation -> TypeInfo) -> Get Collation -> Get TypeInfo
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Collation
getCollation -- collation

    f Word8
0x63 = Word32 -> Collation -> TypeInfo
TINText (Word32 -> Collation -> TypeInfo)
-> Get Word32 -> Get (Collation -> TypeInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
Get.getWord32le
                     Get (Collation -> TypeInfo) -> Get Collation -> Get TypeInfo
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Collation
getCollation -- collation

    -- [TODO] test
    f Word8
0x2d = Word8 -> TypeInfo
TIBinary (Word8 -> TypeInfo) -> Get Word8 -> Get TypeInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
Get.getWord8

    -- [TODO] test
    f Word8
0x25 = Word8 -> TypeInfo
TIVarBinary (Word8 -> TypeInfo) -> Get Word8 -> Get TypeInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
Get.getWord8

    f Word8
0xad = Word16 -> TypeInfo
TIBigBinary (Word16 -> TypeInfo) -> Get Word16 -> Get TypeInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
Get.getWord16le

    f Word8
0xa5 = Word16 -> TypeInfo
TIBigVarBinary (Word16 -> TypeInfo) -> Get Word16 -> Get TypeInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
Get.getWord16le

    f Word8
0x22 = Word32 -> TypeInfo
TIImage (Word32 -> TypeInfo) -> Get Word32 -> Get TypeInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
Get.getWord32le



-- https://msdn.microsoft.com/en-us/library/dd358284.aspx
-- https://msdn.microsoft.com/en-us/library/dd305325.aspx
putTypeInfo :: TypeInfo -> Put
putTypeInfo :: TypeInfo -> Put
putTypeInfo (TypeInfo
TINull     ) = Word8 -> Put
Put.putWord8 Word8
0x1f -- [TODO] test
putTypeInfo (TypeInfo
TIBit      ) = Word8 -> Put
Put.putWord8 Word8
0x32
putTypeInfo (TypeInfo
TIInt1     ) = Word8 -> Put
Put.putWord8 Word8
0x30
putTypeInfo (TypeInfo
TIInt2     ) = Word8 -> Put
Put.putWord8 Word8
0x34
putTypeInfo (TypeInfo
TIInt4     ) = Word8 -> Put
Put.putWord8 Word8
0x38
putTypeInfo (TypeInfo
TIInt8     ) = Word8 -> Put
Put.putWord8 Word8
0x7f
putTypeInfo (TypeInfo
TIMoney4   ) = Word8 -> Put
Put.putWord8 Word8
0x7a
putTypeInfo (TypeInfo
TIMoney8   ) = Word8 -> Put
Put.putWord8 Word8
0x3c
putTypeInfo (TypeInfo
TIDateTime4) = Word8 -> Put
Put.putWord8 Word8
0x3a
putTypeInfo (TypeInfo
TIDateTime8) = Word8 -> Put
Put.putWord8 Word8
0x3d
putTypeInfo (TypeInfo
TIFlt4     ) = Word8 -> Put
Put.putWord8 Word8
0x3b
putTypeInfo (TypeInfo
TIFlt8     ) = Word8 -> Put
Put.putWord8 Word8
0x3e

putTypeInfo (TypeInfo
TIBitN      ) = Word8 -> Put
Put.putWord8 Word8
0x68 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
Put.putWord8 Word8
1
putTypeInfo (TypeInfo
TIIntN1     ) = Word8 -> Put
Put.putWord8 Word8
0x26 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
Put.putWord8 Word8
1
putTypeInfo (TypeInfo
TIIntN2     ) = Word8 -> Put
Put.putWord8 Word8
0x26 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
Put.putWord8 Word8
2
putTypeInfo (TypeInfo
TIIntN4     ) = Word8 -> Put
Put.putWord8 Word8
0x26 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
Put.putWord8 Word8
4
putTypeInfo (TypeInfo
TIIntN8     ) = Word8 -> Put
Put.putWord8 Word8
0x26 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
Put.putWord8 Word8
8
putTypeInfo (TypeInfo
TIMoneyN4   ) = Word8 -> Put
Put.putWord8 Word8
0x6e Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
Put.putWord8 Word8
4
putTypeInfo (TypeInfo
TIMoneyN8   ) = Word8 -> Put
Put.putWord8 Word8
0x6e Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
Put.putWord8 Word8
8
putTypeInfo (TypeInfo
TIDateTimeN4) = Word8 -> Put
Put.putWord8 Word8
0x6f Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
Put.putWord8 Word8
4
putTypeInfo (TypeInfo
TIDateTimeN8) = Word8 -> Put
Put.putWord8 Word8
0x6f Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
Put.putWord8 Word8
8
putTypeInfo (TypeInfo
TIFltN4     ) = Word8 -> Put
Put.putWord8 Word8
0x6d Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
Put.putWord8 Word8
4
putTypeInfo (TypeInfo
TIFltN8     ) = Word8 -> Put
Put.putWord8 Word8
0x6d Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
Put.putWord8 Word8
8

putTypeInfo (TypeInfo
TIGUID) = Word8 -> Put
Put.putWord8 Word8
0x24 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
Put.putWord8 Word8
16
putTypeInfo (TIDecimalN Word8
p Word8
s) = do
  Word8 -> Put
Put.putWord8 Word8
0x6a
  Word8 -> Put
Put.putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word8
precisionToLen Word8
p) Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+Word8
1
  Word8 -> Put
Put.putWord8 Word8
p
  Word8 -> Put
Put.putWord8 Word8
s
putTypeInfo (TINumericN Word8
p Word8
s) = do
  Word8 -> Put
Put.putWord8 Word8
0x6c
  Word8 -> Put
Put.putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word8
precisionToLen Word8
p) Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+Word8
1
  Word8 -> Put
Put.putWord8 Word8
p
  Word8 -> Put
Put.putWord8 Word8
s


putTypeInfo (TIChar Word8
len) = do -- [TODO] test
  Word8 -> Put
Put.putWord8 Word8
0x2f
  Word8 -> Put
Put.putWord8 Word8
len
  -- [MEMO] no collation

putTypeInfo (TIVarChar Word8
len) = do -- [TODO] test
  Word8 -> Put
Put.putWord8 Word8
0x27
  Word8 -> Put
Put.putWord8 Word8
len
  -- [MEMO] no collation
  
putTypeInfo (TIBigChar Word16
len Collation
col) = do
  Word8 -> Put
Put.putWord8 Word8
0xaf
  Word16 -> Put
Put.putWord16le Word16
len
  Collation -> Put
putCollation Collation
col
  
putTypeInfo (TIBigVarChar Word16
len Collation
col) = do
  Word8 -> Put
Put.putWord8 Word8
0xa7
  Word16 -> Put
Put.putWord16le Word16
len
  Collation -> Put
putCollation Collation
col

putTypeInfo (TIText Word32
len Collation
col) = do
  Word8 -> Put
Put.putWord8 Word8
0x23
  Word32 -> Put
Put.putWord32le Word32
len
  Collation -> Put
putCollation Collation
col


putTypeInfo (TINChar Word16
len Collation
col) = do
  Word8 -> Put
Put.putWord8 Word8
0xef
  Word16 -> Put
Put.putWord16le Word16
len
  Collation -> Put
putCollation Collation
col
  
putTypeInfo (TINVarChar Word16
len Collation
col) = do
  Word8 -> Put
Put.putWord8 Word8
0xe7
  Word16 -> Put
Put.putWord16le Word16
len
  Collation -> Put
putCollation Collation
col

putTypeInfo (TINText Word32
len Collation
col) = do
  Word8 -> Put
Put.putWord8 Word8
0x63
  Word32 -> Put
Put.putWord32le Word32
len
  Collation -> Put
putCollation Collation
col


putTypeInfo (TIBinary Word8
len) = do -- [TODO] test
  Word8 -> Put
Put.putWord8 Word8
0x2d
  Word8 -> Put
Put.putWord8 Word8
len

putTypeInfo (TIVarBinary Word8
len) = do -- [TODO] test
  Word8 -> Put
Put.putWord8 Word8
0x25
  Word8 -> Put
Put.putWord8 Word8
len
  
putTypeInfo (TIBigBinary Word16
len) = do
  Word8 -> Put
Put.putWord8 Word8
0xad
  Word16 -> Put
Put.putWord16le Word16
len
  
putTypeInfo (TIBigVarBinary Word16
len) = do
  Word8 -> Put
Put.putWord8 Word8
0xa5
  Word16 -> Put
Put.putWord16le Word16
len

putTypeInfo (TIImage Word32
len) = do
  Word8 -> Put
Put.putWord8 Word8
0x22
  Word32 -> Put
Put.putWord32le Word32
len

  
instance Binary TypeInfo where
  put :: TypeInfo -> Put
put = TypeInfo -> Put
putTypeInfo
  get :: Get TypeInfo
get = Get TypeInfo
getTypeInfo




type RawBytes = Maybe LB.ByteString

getRawBytes :: TypeInfo -> Get RawBytes
getRawBytes :: TypeInfo -> Get RawBytes
getRawBytes = TypeInfo -> Get RawBytes
f
  where

    get8n :: Get RawBytes
    get8n :: Get RawBytes
get8n = do
      Word8
len <- Get Word8
Get.getWord8
      if Word8
len Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0
        then RawBytes -> Get RawBytes
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return RawBytes
forall a. Maybe a
Nothing
        else ByteString -> RawBytes
forall a. a -> Maybe a
Just (ByteString -> RawBytes) -> Get ByteString -> Get RawBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int64 -> Get ByteString
Get.getLazyByteString (Int64 -> Get ByteString) -> Int64 -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
len)
    
    get8s :: Get RawBytes
    get8s :: Get RawBytes
get8s = do
      Word8
len <- Get Word8
Get.getWord8
      if Word8
len Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xff
        then RawBytes -> Get RawBytes
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return RawBytes
forall a. Maybe a
Nothing
        else ByteString -> RawBytes
forall a. a -> Maybe a
Just (ByteString -> RawBytes) -> Get ByteString -> Get RawBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int64 -> Get ByteString
Get.getLazyByteString (Int64 -> Get ByteString) -> Int64 -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
len)
    
    get16s :: Get RawBytes
    get16s :: Get RawBytes
get16s = do
      Word16
len <- Get Word16
Get.getWord16le
      if Word16
len Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
0xffff
        then RawBytes -> Get RawBytes
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return RawBytes
forall a. Maybe a
Nothing
        else ByteString -> RawBytes
forall a. a -> Maybe a
Just (ByteString -> RawBytes) -> Get ByteString -> Get RawBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int64 -> Get ByteString
Get.getLazyByteString (Int64 -> Get ByteString) -> Int64 -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Word16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
len)
    
    get32s :: Get RawBytes
    get32s :: Get RawBytes
get32s = do
      Word32
len <- Get Word32
Get.getWord32le
      if Word32
len Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0xffffffff
        then RawBytes -> Get RawBytes
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return RawBytes
forall a. Maybe a
Nothing
        else ByteString -> RawBytes
forall a. a -> Maybe a
Just (ByteString -> RawBytes) -> Get ByteString -> Get RawBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int64 -> Get ByteString
Get.getLazyByteString (Int64 -> Get ByteString) -> Int64 -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
len)

    f :: TypeInfo -> Get RawBytes
    f :: TypeInfo -> Get RawBytes
f TypeInfo
TINull      = RawBytes -> Get RawBytes
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return RawBytes
forall a. Maybe a
Nothing
    f TypeInfo
TIBit       = ByteString -> RawBytes
forall a. a -> Maybe a
Just (ByteString -> RawBytes) -> Get ByteString -> Get RawBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> Get ByteString
Get.getLazyByteString Int64
1
    f TypeInfo
TIInt1      = ByteString -> RawBytes
forall a. a -> Maybe a
Just (ByteString -> RawBytes) -> Get ByteString -> Get RawBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> Get ByteString
Get.getLazyByteString Int64
1
    f TypeInfo
TIInt2      = ByteString -> RawBytes
forall a. a -> Maybe a
Just (ByteString -> RawBytes) -> Get ByteString -> Get RawBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> Get ByteString
Get.getLazyByteString Int64
2
    f TypeInfo
TIInt4      = ByteString -> RawBytes
forall a. a -> Maybe a
Just (ByteString -> RawBytes) -> Get ByteString -> Get RawBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> Get ByteString
Get.getLazyByteString Int64
4
    f TypeInfo
TIInt8      = ByteString -> RawBytes
forall a. a -> Maybe a
Just (ByteString -> RawBytes) -> Get ByteString -> Get RawBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> Get ByteString
Get.getLazyByteString Int64
8
    f TypeInfo
TIMoney4    = ByteString -> RawBytes
forall a. a -> Maybe a
Just (ByteString -> RawBytes) -> Get ByteString -> Get RawBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> Get ByteString
Get.getLazyByteString Int64
4
    f TypeInfo
TIMoney8    = ByteString -> RawBytes
forall a. a -> Maybe a
Just (ByteString -> RawBytes) -> Get ByteString -> Get RawBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> Get ByteString
Get.getLazyByteString Int64
8
    f TypeInfo
TIDateTime4 = ByteString -> RawBytes
forall a. a -> Maybe a
Just (ByteString -> RawBytes) -> Get ByteString -> Get RawBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> Get ByteString
Get.getLazyByteString Int64
4
    f TypeInfo
TIDateTime8 = ByteString -> RawBytes
forall a. a -> Maybe a
Just (ByteString -> RawBytes) -> Get ByteString -> Get RawBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> Get ByteString
Get.getLazyByteString Int64
8
    f TypeInfo
TIFlt4      = ByteString -> RawBytes
forall a. a -> Maybe a
Just (ByteString -> RawBytes) -> Get ByteString -> Get RawBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> Get ByteString
Get.getLazyByteString Int64
4
    f TypeInfo
TIFlt8      = ByteString -> RawBytes
forall a. a -> Maybe a
Just (ByteString -> RawBytes) -> Get ByteString -> Get RawBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> Get ByteString
Get.getLazyByteString Int64
8

    f TypeInfo
TIBitN  = Get RawBytes
get8n
    f TypeInfo
TIIntN1 = Get RawBytes
get8n
    f TypeInfo
TIIntN2 = Get RawBytes
get8n
    f TypeInfo
TIIntN4 = Get RawBytes
get8n
    f TypeInfo
TIIntN8 = Get RawBytes
get8n
    f TypeInfo
TIMoneyN4 = Get RawBytes
get8n
    f TypeInfo
TIMoneyN8 = Get RawBytes
get8n
    f TypeInfo
TIDateTimeN4 = Get RawBytes
get8n
    f TypeInfo
TIDateTimeN8 = Get RawBytes
get8n
    f TypeInfo
TIFltN4 = Get RawBytes
get8n
    f TypeInfo
TIFltN8 = Get RawBytes
get8n
    
    f TypeInfo
TIGUID = Get RawBytes
get8n
      
    f (TIDecimalN Word8
_ Word8
_) = Get RawBytes
get8n
    f (TINumericN Word8
_ Word8
_) = Get RawBytes
get8n

    f (TIChar Word8
_) = Get RawBytes
get8s
    f (TIVarChar Word8
_) = Get RawBytes
get8s
    f (TIBigChar Word16
_ Collation
_) = Get RawBytes
get16s
    f (TIBigVarChar Word16
_ Collation
_) = Get RawBytes
get16s
    f (TIText Word32
_ Collation
_) = Get RawBytes
get32s

    f (TINChar Word16
_ Collation
_) = Get RawBytes
get16s
    f (TINVarChar Word16
_ Collation
_) = Get RawBytes
get16s
    f (TINText Word32
_ Collation
_) = Get RawBytes
get32s
             
    f (TIBinary Word8
_) = Get RawBytes
get8s
    f (TIVarBinary Word8
_) = Get RawBytes
get8s
    f (TIBigBinary Word16
_) = Get RawBytes
get16s
    f (TIBigVarBinary Word16
_) = Get RawBytes
get16s
    f (TIImage Word32
_) = Get RawBytes
get32s


putRawBytes :: TypeInfo -> RawBytes -> Put
putRawBytes :: TypeInfo -> RawBytes -> Put
putRawBytes = TypeInfo -> RawBytes -> Put
g
  where

    put8n :: RawBytes -> Put
    put8n :: RawBytes -> Put
put8n RawBytes
Nothing = Word8 -> Put
Put.putWord8 Word8
0
    put8n (Just ByteString
bs) = do
      Word8 -> Put
Put.putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Int64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word8) -> Int64 -> Word8
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
LB.length ByteString
bs
      ByteString -> Put
Put.putLazyByteString  ByteString
bs
    
    put8s :: RawBytes -> Put
    put8s :: RawBytes -> Put
put8s RawBytes
Nothing = Word8 -> Put
Put.putWord8 Word8
0xff
    put8s (Just ByteString
bs) = do
      Word8 -> Put
Put.putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Int64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word8) -> Int64 -> Word8
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
LB.length ByteString
bs
      ByteString -> Put
Put.putLazyByteString  ByteString
bs
    
    put16s :: RawBytes -> Put
    put16s :: RawBytes -> Put
put16s RawBytes
Nothing = Word16 -> Put
Put.putWord16le Word16
0xffff
    put16s (Just ByteString
bs) = do
      Word16 -> Put
Put.putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Int64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word16) -> Int64 -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
LB.length ByteString
bs
      ByteString -> Put
Put.putLazyByteString  ByteString
bs
    
    put32s :: RawBytes -> Put
    put32s :: RawBytes -> Put
put32s RawBytes
Nothing = Word32 -> Put
Put.putWord32le Word32
0xffffffff
    put32s (Just ByteString
bs) = do
      Word32 -> Put
Put.putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word32) -> Int64 -> Word32
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
LB.length ByteString
bs
      ByteString -> Put
Put.putLazyByteString  ByteString
bs
    

    g :: TypeInfo -> RawBytes -> Put
    g :: TypeInfo -> RawBytes -> Put
g TypeInfo
TINull RawBytes
_ = () -> Put
forall a. a -> PutM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    
    g TypeInfo
TIBit RawBytes
Nothing        = String -> Put
forall a. HasCallStack => String -> a
error String
"putRawBytes: Nothing is not convertible to TIBit"
    g TypeInfo
TIInt1 RawBytes
Nothing       = String -> Put
forall a. HasCallStack => String -> a
error String
"putRawBytes: Nothing is not convertible to TIInt1"
    g TypeInfo
TIInt2 RawBytes
Nothing       = String -> Put
forall a. HasCallStack => String -> a
error String
"putRawBytes: Nothing is not convertible to TIInt2"
    g TypeInfo
TIInt4 RawBytes
Nothing       = String -> Put
forall a. HasCallStack => String -> a
error String
"putRawBytes: Nothing is not convertible to TIInt4"
    g TypeInfo
TIInt8 RawBytes
Nothing       = String -> Put
forall a. HasCallStack => String -> a
error String
"putRawBytes: Nothing is not convertible to TIInt8"
    g TypeInfo
TIMoney4 RawBytes
Nothing     = String -> Put
forall a. HasCallStack => String -> a
error String
"putRawBytes: Nothing is not convertible to TIMoney4"
    g TypeInfo
TIMoney8 RawBytes
Nothing     = String -> Put
forall a. HasCallStack => String -> a
error String
"putRawBytes: Nothing is not convertible to TIMoney8"
    g TypeInfo
TIDateTime4 RawBytes
Nothing  = String -> Put
forall a. HasCallStack => String -> a
error String
"putRawBytes: Nothing is not convertible to TIDateTime4"
    g TypeInfo
TIDateTime8 RawBytes
Nothing  = String -> Put
forall a. HasCallStack => String -> a
error String
"putRawBytes: Nothing is not convertible to TIDateTime8"
    g TypeInfo
TIFlt4 RawBytes
Nothing       = String -> Put
forall a. HasCallStack => String -> a
error String
"putRawBytes: Nothing is not convertible to TIFlt4"
    g TypeInfo
TIFlt8 RawBytes
Nothing       = String -> Put
forall a. HasCallStack => String -> a
error String
"putRawBytes: Nothing is not convertible to TIFlt8"
    
    g TypeInfo
TIBit (Just ByteString
bs)       = ByteString -> Put
Put.putLazyByteString ByteString
bs
    g TypeInfo
TIInt1 (Just ByteString
bs)      = ByteString -> Put
Put.putLazyByteString ByteString
bs
    g TypeInfo
TIInt2 (Just ByteString
bs)      = ByteString -> Put
Put.putLazyByteString ByteString
bs
    g TypeInfo
TIInt4 (Just ByteString
bs)      = ByteString -> Put
Put.putLazyByteString ByteString
bs
    g TypeInfo
TIInt8 (Just ByteString
bs)      = ByteString -> Put
Put.putLazyByteString ByteString
bs
    g TypeInfo
TIMoney4 (Just ByteString
bs)    = ByteString -> Put
Put.putLazyByteString ByteString
bs
    g TypeInfo
TIMoney8 (Just ByteString
bs)    = ByteString -> Put
Put.putLazyByteString ByteString
bs
    g TypeInfo
TIDateTime4 (Just ByteString
bs) = ByteString -> Put
Put.putLazyByteString ByteString
bs
    g TypeInfo
TIDateTime8 (Just ByteString
bs) = ByteString -> Put
Put.putLazyByteString ByteString
bs
    g TypeInfo
TIFlt4 (Just ByteString
bs)      = ByteString -> Put
Put.putLazyByteString ByteString
bs
    g TypeInfo
TIFlt8 (Just ByteString
bs)      = ByteString -> Put
Put.putLazyByteString ByteString
bs

    g TypeInfo
TIBitN RawBytes
rb       = RawBytes -> Put
put8n RawBytes
rb
    g TypeInfo
TIIntN1 RawBytes
rb      = RawBytes -> Put
put8n RawBytes
rb
    g TypeInfo
TIIntN2 RawBytes
rb      = RawBytes -> Put
put8n RawBytes
rb
    g TypeInfo
TIIntN4 RawBytes
rb      = RawBytes -> Put
put8n RawBytes
rb
    g TypeInfo
TIIntN8 RawBytes
rb      = RawBytes -> Put
put8n RawBytes
rb
    g TypeInfo
TIMoneyN4 RawBytes
rb    = RawBytes -> Put
put8n RawBytes
rb
    g TypeInfo
TIMoneyN8 RawBytes
rb    = RawBytes -> Put
put8n RawBytes
rb
    g TypeInfo
TIDateTimeN4 RawBytes
rb = RawBytes -> Put
put8n RawBytes
rb
    g TypeInfo
TIDateTimeN8 RawBytes
rb = RawBytes -> Put
put8n RawBytes
rb
    g TypeInfo
TIFltN4 RawBytes
rb      = RawBytes -> Put
put8n RawBytes
rb
    g TypeInfo
TIFltN8 RawBytes
rb      = RawBytes -> Put
put8n RawBytes
rb
    
    g TypeInfo
TIGUID RawBytes
rb = RawBytes -> Put
put8n RawBytes
rb

    g (TIDecimalN Word8
_ Word8
_) RawBytes
rb = RawBytes -> Put
put8n RawBytes
rb
    g (TINumericN Word8
_ Word8
_) RawBytes
rb = RawBytes -> Put
put8n RawBytes
rb

    g (TIChar Word8
_) RawBytes
rb = RawBytes -> Put
put8s RawBytes
rb
    g (TIVarChar Word8
_) RawBytes
rb = RawBytes -> Put
put8s RawBytes
rb
    g (TIBigChar Word16
_ Collation
_) RawBytes
rb = RawBytes -> Put
put16s RawBytes
rb
    g (TIBigVarChar Word16
_ Collation
_) RawBytes
rb = RawBytes -> Put
put16s RawBytes
rb
    g (TIText Word32
_ Collation
_) RawBytes
rb = RawBytes -> Put
put32s RawBytes
rb

    g (TINChar Word16
_ Collation
_) RawBytes
rb = RawBytes -> Put
put16s RawBytes
rb
    g (TINVarChar Word16
_ Collation
_) RawBytes
rb = RawBytes -> Put
put16s RawBytes
rb
    g (TINText Word32
_ Collation
_) RawBytes
rb = RawBytes -> Put
put32s RawBytes
rb

    g (TIBinary Word8
_) RawBytes
rb = RawBytes -> Put
put8s RawBytes
rb
    g (TIVarBinary Word8
_) RawBytes
rb = RawBytes -> Put
put8s RawBytes
rb
    g (TIBigBinary Word16
_) RawBytes
rb = RawBytes -> Put
put16s RawBytes
rb
    g (TIBigVarBinary Word16
_) RawBytes
rb = RawBytes -> Put
put16s RawBytes
rb
    g (TIImage Word32
_) RawBytes
rb = RawBytes -> Put
put32s RawBytes
rb



  
withValidNull :: TypeInfo -> (TypeInfo -> a) -> a
withValidNull :: forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidNull = TypeInfo -> (TypeInfo -> a) -> a
forall a. TypeInfo -> (TypeInfo -> a) -> a
f
  where
    f :: TypeInfo -> (TypeInfo -> a) -> a
    f :: forall a. TypeInfo -> (TypeInfo -> a) -> a
f ti :: TypeInfo
ti@TypeInfo
TINull TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f TypeInfo
ti TypeInfo -> a
_ = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"withValidNull: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (TypeInfo -> String
forall a. Show a => a -> String
show TypeInfo
ti) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is not convertible from/to Null"



withValidIntegral :: String -> TypeInfo -> (TypeInfo -> a) -> a
withValidIntegral :: forall a. String -> TypeInfo -> (TypeInfo -> a) -> a
withValidIntegral String
tn = TypeInfo -> (TypeInfo -> a) -> a
forall a. TypeInfo -> (TypeInfo -> a) -> a
f
  where
    f :: TypeInfo -> (TypeInfo -> a) -> a
    f :: forall a. TypeInfo -> (TypeInfo -> a) -> a
f ti :: TypeInfo
ti@TypeInfo
TIBit TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f ti :: TypeInfo
ti@TypeInfo
TIInt1 TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f ti :: TypeInfo
ti@TypeInfo
TIInt2 TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f ti :: TypeInfo
ti@TypeInfo
TIInt4 TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f ti :: TypeInfo
ti@TypeInfo
TIInt8 TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f ti :: TypeInfo
ti@TypeInfo
TIBitN TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f ti :: TypeInfo
ti@TypeInfo
TIIntN1 TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f ti :: TypeInfo
ti@TypeInfo
TIIntN2 TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti 
    f ti :: TypeInfo
ti@TypeInfo
TIIntN4 TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f ti :: TypeInfo
ti@TypeInfo
TIIntN8 TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f TypeInfo
ti TypeInfo -> a
_ = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"withValidIntegral: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (TypeInfo -> String
forall a. Show a => a -> String
show TypeInfo
ti) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is not convertible from/to " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
tn

withValidBool :: TypeInfo -> (TypeInfo -> a) -> a
withValidBool = String -> TypeInfo -> (TypeInfo -> a) -> a
forall a. String -> TypeInfo -> (TypeInfo -> a) -> a
withValidIntegral String
"Bool"
withValidInt :: TypeInfo -> (TypeInfo -> a) -> a
withValidInt = String -> TypeInfo -> (TypeInfo -> a) -> a
forall a. String -> TypeInfo -> (TypeInfo -> a) -> a
withValidIntegral String
"Int"
withValidInteger :: TypeInfo -> (TypeInfo -> a) -> a
withValidInteger = String -> TypeInfo -> (TypeInfo -> a) -> a
forall a. String -> TypeInfo -> (TypeInfo -> a) -> a
withValidIntegral String
"Integer"

isIntegralN :: TypeInfo -> Bool
isIntegralN :: TypeInfo -> Bool
isIntegralN = TypeInfo -> Bool
f
  where
    f :: TypeInfo -> Bool
    f :: TypeInfo -> Bool
f TypeInfo
TIBitN = Bool
True
    f TypeInfo
TIIntN1 = Bool
True
    f TypeInfo
TIIntN2 = Bool
True
    f TypeInfo
TIIntN4 = Bool
True
    f TypeInfo
TIIntN8 = Bool
True
    f TypeInfo
_ = Bool
False


getIntegral :: Integral a => TypeInfo -> Get a
getIntegral :: forall a. Integral a => TypeInfo -> Get a
getIntegral TypeInfo
TIBit  = Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> a) -> Get Word8 -> Get a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
Get.getWord8
getIntegral TypeInfo
TIInt1 = Int8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int8 -> a) -> Get Int8 -> Get a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8
Get.getInt8
getIntegral TypeInfo
TIInt2 = Int16 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int16 -> a) -> Get Int16 -> Get a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
Get.getInt16le
getIntegral TypeInfo
TIInt4 = Int32 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> a) -> Get Int32 -> Get a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
Get.getInt32le
getIntegral TypeInfo
TIInt8 = Int64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> a) -> Get Int64 -> Get a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
Get.getInt64le
getIntegral TypeInfo
TIBitN  = TypeInfo -> Get a
forall a. Integral a => TypeInfo -> Get a
getIntegral TypeInfo
TIBit
getIntegral TypeInfo
TIIntN1 = TypeInfo -> Get a
forall a. Integral a => TypeInfo -> Get a
getIntegral TypeInfo
TIInt1
getIntegral TypeInfo
TIIntN2 = TypeInfo -> Get a
forall a. Integral a => TypeInfo -> Get a
getIntegral TypeInfo
TIInt2
getIntegral TypeInfo
TIIntN4 = TypeInfo -> Get a
forall a. Integral a => TypeInfo -> Get a
getIntegral TypeInfo
TIInt4
getIntegral TypeInfo
TIIntN8 = TypeInfo -> Get a
forall a. Integral a => TypeInfo -> Get a
getIntegral TypeInfo
TIInt8


putIntegral :: Integral a => TypeInfo -> a -> Put
putIntegral :: forall a. Integral a => TypeInfo -> a -> Put
putIntegral TypeInfo
TIBit  a
i = Word8 -> Put
Put.putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i
putIntegral TypeInfo
TIInt1 a
i = Int8 -> Put
Put.putInt8 (Int8 -> Put) -> Int8 -> Put
forall a b. (a -> b) -> a -> b
$ a -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i
putIntegral TypeInfo
TIInt2 a
i = Int16 -> Put
Put.putInt16le (Int16 -> Put) -> Int16 -> Put
forall a b. (a -> b) -> a -> b
$ a -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i
putIntegral TypeInfo
TIInt4 a
i = Int32 -> Put
Put.putInt32le (Int32 -> Put) -> Int32 -> Put
forall a b. (a -> b) -> a -> b
$ a -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i
putIntegral TypeInfo
TIInt8 a
i = Int64 -> Put
Put.putInt64le (Int64 -> Put) -> Int64 -> Put
forall a b. (a -> b) -> a -> b
$ a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i
putIntegral TypeInfo
TIBitN  a
i = TypeInfo -> a -> Put
forall a. Integral a => TypeInfo -> a -> Put
putIntegral TypeInfo
TIBit a
i
putIntegral TypeInfo
TIIntN1 a
i = TypeInfo -> a -> Put
forall a. Integral a => TypeInfo -> a -> Put
putIntegral TypeInfo
TIInt1 a
i
putIntegral TypeInfo
TIIntN2 a
i = TypeInfo -> a -> Put
forall a. Integral a => TypeInfo -> a -> Put
putIntegral TypeInfo
TIInt2 a
i
putIntegral TypeInfo
TIIntN4 a
i = TypeInfo -> a -> Put
forall a. Integral a => TypeInfo -> a -> Put
putIntegral TypeInfo
TIInt4 a
i
putIntegral TypeInfo
TIIntN8 a
i = TypeInfo -> a -> Put
forall a. Integral a => TypeInfo -> a -> Put
putIntegral TypeInfo
TIInt8 a
i



  
withValidMoney :: TypeInfo -> (TypeInfo -> a) -> a
withValidMoney :: forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidMoney  = TypeInfo -> (TypeInfo -> a) -> a
forall a. TypeInfo -> (TypeInfo -> a) -> a
f
  where
    f :: TypeInfo -> (TypeInfo -> a) -> a
    f :: forall a. TypeInfo -> (TypeInfo -> a) -> a
f ti :: TypeInfo
ti@TypeInfo
TIMoney4 TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f ti :: TypeInfo
ti@TypeInfo
TIMoney8 TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f ti :: TypeInfo
ti@TypeInfo
TIMoneyN4 TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f ti :: TypeInfo
ti@TypeInfo
TIMoneyN8 TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f TypeInfo
ti TypeInfo -> a
_ = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"withValidMoney: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (TypeInfo -> String
forall a. Show a => a -> String
show TypeInfo
ti) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is not convertible from/to Money"

isMoneyN :: TypeInfo -> Bool
isMoneyN :: TypeInfo -> Bool
isMoneyN = TypeInfo -> Bool
f
  where
    f :: TypeInfo -> Bool
    f :: TypeInfo -> Bool
f TypeInfo
TIMoneyN4 = Bool
True
    f TypeInfo
TIMoneyN8 = Bool
True
    f TypeInfo
_ = Bool
False
    
getMoney :: TypeInfo -> Get Money
getMoney :: TypeInfo -> Get Money
getMoney TypeInfo
TIMoney4 = Int32 -> Money
bytesToMoney4 (Int32 -> Money) -> Get Int32 -> Get Money
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
Get.getInt32le
getMoney TypeInfo
TIMoney8 = Int32 -> Int32 -> Money
bytesToMoney8 (Int32 -> Int32 -> Money) -> Get Int32 -> Get (Int32 -> Money)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
Get.getInt32le Get (Int32 -> Money) -> Get Int32 -> Get Money
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int32
Get.getInt32le
getMoney TypeInfo
TIMoneyN4 = TypeInfo -> Get Money
getMoney TypeInfo
TIMoney4
getMoney TypeInfo
TIMoneyN8 = TypeInfo -> Get Money
getMoney TypeInfo
TIMoney8

putMoney :: TypeInfo -> Money -> Put
putMoney :: TypeInfo -> Money -> Put
putMoney TypeInfo
TIMoney4 Money
f = Int32 -> Put
Put.putInt32le (Int32 -> Put) -> Int32 -> Put
forall a b. (a -> b) -> a -> b
$ Money -> Int32
moneyToBytes4 Money
f
putMoney TypeInfo
TIMoney8 Money
f = do
  let (Int32
m,Int32
l) = Money -> (Int32, Int32)
moneyToBytes8 Money
f
  Int32 -> Put
Put.putInt32le Int32
m
  Int32 -> Put
Put.putInt32le Int32
l
putMoney TypeInfo
TIMoneyN4 Money
f = TypeInfo -> Money -> Put
putMoney TypeInfo
TIMoney4 Money
f
putMoney TypeInfo
TIMoneyN8 Money
f = TypeInfo -> Money -> Put
putMoney TypeInfo
TIMoney8 Money
f


  

withValidUTCTime :: TypeInfo -> (TypeInfo -> a) -> a
withValidUTCTime :: forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidUTCTime  = TypeInfo -> (TypeInfo -> a) -> a
forall a. TypeInfo -> (TypeInfo -> a) -> a
f
  where
    f :: TypeInfo -> (TypeInfo -> a) -> a
    f :: forall a. TypeInfo -> (TypeInfo -> a) -> a
f ti :: TypeInfo
ti@TypeInfo
TIDateTime4 TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f ti :: TypeInfo
ti@TypeInfo
TIDateTime8 TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f ti :: TypeInfo
ti@TypeInfo
TIDateTimeN4 TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f ti :: TypeInfo
ti@TypeInfo
TIDateTimeN8 TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f TypeInfo
ti TypeInfo -> a
_ = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"withValidUTCTime: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (TypeInfo -> String
forall a. Show a => a -> String
show TypeInfo
ti) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is not convertible from/to UTCTime"

isUTCTimeN :: TypeInfo -> Bool
isUTCTimeN :: TypeInfo -> Bool
isUTCTimeN = TypeInfo -> Bool
f
  where
    f :: TypeInfo -> Bool
    f :: TypeInfo -> Bool
f TypeInfo
TIDateTimeN4 = Bool
True
    f TypeInfo
TIDateTimeN8 = Bool
True
    f TypeInfo
_ = Bool
False
    
getUTCTime :: TypeInfo -> Get UTCTime
getUTCTime :: TypeInfo -> Get UTCTime
getUTCTime TypeInfo
TIDateTime4 = Word16 -> Word16 -> UTCTime
bytesToUtc4 (Word16 -> Word16 -> UTCTime)
-> Get Word16 -> Get (Word16 -> UTCTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
Get.getWord16le Get (Word16 -> UTCTime) -> Get Word16 -> Get UTCTime
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
Get.getWord16le
getUTCTime TypeInfo
TIDateTime8 = Int32 -> Word32 -> UTCTime
bytesToUtc8 (Int32 -> Word32 -> UTCTime)
-> Get Int32 -> Get (Word32 -> UTCTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
Get.getInt32le Get (Word32 -> UTCTime) -> Get Word32 -> Get UTCTime
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
Get.getWord32le
getUTCTime TypeInfo
TIDateTimeN4 = TypeInfo -> Get UTCTime
getUTCTime TypeInfo
TIDateTime4
getUTCTime TypeInfo
TIDateTimeN8 = TypeInfo -> Get UTCTime
getUTCTime TypeInfo
TIDateTime8

putUTCTime :: TypeInfo -> UTCTime -> Put
putUTCTime :: TypeInfo -> UTCTime -> Put
putUTCTime TypeInfo
TIDateTime4 UTCTime
time = do
  let (Word16
wday,Word16
wmin) = UTCTime -> (Word16, Word16)
utcToBytes4 UTCTime
time
  Word16 -> Put
Put.putWord16le Word16
wday
  Word16 -> Put
Put.putWord16le Word16
wmin
putUTCTime TypeInfo
TIDateTime8 UTCTime
time = do
  let (Int32
iday,Word32
w3hsec) = UTCTime -> (Int32, Word32)
utcToBytes8 UTCTime
time
  Int32 -> Put
Put.putInt32le Int32
iday
  Word32 -> Put
Put.putWord32le Word32
w3hsec
putUTCTime TypeInfo
TIDateTimeN4 UTCTime
time = TypeInfo -> UTCTime -> Put
putUTCTime TypeInfo
TIDateTime4 UTCTime
time
putUTCTime TypeInfo
TIDateTimeN8 UTCTime
time = TypeInfo -> UTCTime -> Put
putUTCTime TypeInfo
TIDateTime8 UTCTime
time




withValidFloat' :: String -> TypeInfo -> (TypeInfo -> a) -> a
withValidFloat' :: forall a. String -> TypeInfo -> (TypeInfo -> a) -> a
withValidFloat' String
tn = TypeInfo -> (TypeInfo -> a) -> a
forall a. TypeInfo -> (TypeInfo -> a) -> a
f
  where
    f :: TypeInfo -> (TypeInfo -> a) -> a
    f :: forall a. TypeInfo -> (TypeInfo -> a) -> a
f ti :: TypeInfo
ti@TypeInfo
TIFlt4 TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f ti :: TypeInfo
ti@TypeInfo
TIFlt8 TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f ti :: TypeInfo
ti@TypeInfo
TIFltN4 TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f ti :: TypeInfo
ti@TypeInfo
TIFltN8 TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f TypeInfo
ti TypeInfo -> a
_ = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"withValidFloat': " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (TypeInfo -> String
forall a. Show a => a -> String
show TypeInfo
ti) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is not convertible from/to " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
tn

withValidFloat :: TypeInfo -> (TypeInfo -> a) -> a
withValidFloat = String -> TypeInfo -> (TypeInfo -> a) -> a
forall a. String -> TypeInfo -> (TypeInfo -> a) -> a
withValidFloat' String
"Float"
withValidDouble :: TypeInfo -> (TypeInfo -> a) -> a
withValidDouble = String -> TypeInfo -> (TypeInfo -> a) -> a
forall a. String -> TypeInfo -> (TypeInfo -> a) -> a
withValidFloat' String
"Double"

isFloatN :: TypeInfo -> Bool
isFloatN :: TypeInfo -> Bool
isFloatN = TypeInfo -> Bool
f
  where
    f :: TypeInfo -> Bool
    f :: TypeInfo -> Bool
f TypeInfo
TIFltN4 = Bool
True
    f TypeInfo
TIFltN8 = Bool
True
    f TypeInfo
_ = Bool
False
    
getFloat :: Fractional a => TypeInfo -> Get a
getFloat :: forall a. Fractional a => TypeInfo -> Get a
getFloat TypeInfo
TIFlt4 = Float -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Float -> a) -> (Word32 -> Float) -> Word32 -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Float
wordToFloat (Word32 -> a) -> Get Word32 -> Get a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
Get.getWord32le
getFloat TypeInfo
TIFlt8 = Double -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> a) -> (Word64 -> Double) -> Word64 -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Double
wordToDouble (Word64 -> a) -> Get Word64 -> Get a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
Get.getWord64le
getFloat TypeInfo
TIFltN4 = TypeInfo -> Get a
forall a. Fractional a => TypeInfo -> Get a
getFloat TypeInfo
TIFlt4
getFloat TypeInfo
TIFltN8 = TypeInfo -> Get a
forall a. Fractional a => TypeInfo -> Get a
getFloat TypeInfo
TIFlt8

putFloat :: Real a => TypeInfo -> a -> Put
putFloat :: forall a. Real a => TypeInfo -> a -> Put
putFloat TypeInfo
TIFlt4 a
f = Word32 -> Put
Put.putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Float -> Word32
floatToWord (Float -> Word32) -> Float -> Word32
forall a b. (a -> b) -> a -> b
$ a -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
f
putFloat TypeInfo
TIFlt8 a
f = Word64 -> Put
Put.putWord64le (Word64 -> Put) -> Word64 -> Put
forall a b. (a -> b) -> a -> b
$ Double -> Word64
doubleToWord (Double -> Word64) -> Double -> Word64
forall a b. (a -> b) -> a -> b
$ a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
f
putFloat TypeInfo
TIFltN4 a
f = TypeInfo -> a -> Put
forall a. Real a => TypeInfo -> a -> Put
putFloat TypeInfo
TIFlt4 a
f
putFloat TypeInfo
TIFltN8 a
f = TypeInfo -> a -> Put
forall a. Real a => TypeInfo -> a -> Put
putFloat TypeInfo
TIFlt8 a
f








withValidFixed :: TypeInfo -> (TypeInfo -> a) -> a
withValidFixed :: forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidFixed  = TypeInfo -> (TypeInfo -> a) -> a
forall a. TypeInfo -> (TypeInfo -> a) -> a
f
  where
    f :: TypeInfo -> (TypeInfo -> a) -> a
    f :: forall a. TypeInfo -> (TypeInfo -> a) -> a
f ti :: TypeInfo
ti@(TIDecimalN Word8
_ Word8
_) TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f ti :: TypeInfo
ti@(TINumericN Word8
_ Word8
_) TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f TypeInfo
ti TypeInfo -> a
_ = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"withValidFixed: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (TypeInfo -> String
forall a. Show a => a -> String
show TypeInfo
ti) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is not convertible from/to Fixed"

-- https://msdn.microsoft.com/en-us/library/ee780893.aspx
-- [MEMO] sign byte + signed bytes
getFixed :: (HasResolution a) => Int -> Get (Fixed a)
getFixed :: forall a. HasResolution a => Int -> Get (Fixed a)
getFixed Int
len =
  Word8 -> ByteString -> Fixed a
forall a. HasResolution a => Word8 -> ByteString -> Fixed a
bytesToFixed (Word8 -> ByteString -> Fixed a)
-> Get Word8 -> Get (ByteString -> Fixed a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
Get.getWord8 Get (ByteString -> Fixed a) -> Get ByteString -> Get (Fixed a)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Get ByteString
Get.getByteString (Int -> Get ByteString) -> Int -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

putFixed :: (HasResolution a) => TypeInfo -> Fixed a -> Put
putFixed :: forall a. HasResolution a => TypeInfo -> Fixed a -> Put
putFixed (TIDecimalN Word8
p Word8
_) Fixed a
f = do -- [TODO] test
  let (Word8
s,ByteString
bs) = Word8 -> Fixed a -> (Word8, ByteString)
forall a.
HasResolution a =>
Word8 -> Fixed a -> (Word8, ByteString)
fixedToBytes Word8
p Fixed a
f
  Word8 -> Put
Put.putWord8 Word8
s
  ByteString -> Put
Put.putByteString ByteString
bs
putFixed (TINumericN Word8
p Word8
s) Fixed a
f = TypeInfo -> Fixed a -> Put
forall a. HasResolution a => TypeInfo -> Fixed a -> Put
putFixed (Word8 -> Word8 -> TypeInfo
TIDecimalN Word8
p Word8
s) Fixed a
f




withValidUUID :: TypeInfo -> (TypeInfo -> a) -> a
withValidUUID :: forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidUUID  = TypeInfo -> (TypeInfo -> a) -> a
forall a. TypeInfo -> (TypeInfo -> a) -> a
f
  where
    f :: TypeInfo -> (TypeInfo -> a) -> a
    f :: forall a. TypeInfo -> (TypeInfo -> a) -> a
f ti :: TypeInfo
ti@TypeInfo
TIGUID TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f TypeInfo
ti TypeInfo -> a
_ = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"withValidUUID: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (TypeInfo -> String
forall a. Show a => a -> String
show TypeInfo
ti) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is not convertible from/to UUID"

getUUID :: TypeInfo -> Get (Maybe UUID)
getUUID :: TypeInfo -> Get (Maybe UUID)
getUUID TypeInfo
_ = do
  (Word32
d1,Word16
d2,Word16
d3,ByteString
d4) <- (,,,) (Word32
 -> Word16
 -> Word16
 -> ByteString
 -> (Word32, Word16, Word16, ByteString))
-> Get Word32
-> Get
     (Word16
      -> Word16 -> ByteString -> (Word32, Word16, Word16, ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
Get.getWord32le Get
  (Word16
   -> Word16 -> ByteString -> (Word32, Word16, Word16, ByteString))
-> Get Word16
-> Get
     (Word16 -> ByteString -> (Word32, Word16, Word16, ByteString))
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
Get.getWord16le Get (Word16 -> ByteString -> (Word32, Word16, Word16, ByteString))
-> Get Word16
-> Get (ByteString -> (Word32, Word16, Word16, ByteString))
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
Get.getWord16le Get (ByteString -> (Word32, Word16, Word16, ByteString))
-> Get ByteString -> Get (Word32, Word16, Word16, ByteString)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get ByteString
Get.getByteString Int
8
  Maybe UUID -> Get (Maybe UUID)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe UUID -> Get (Maybe UUID)) -> Maybe UUID -> Get (Maybe UUID)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe UUID
UUID.fromByteString (ByteString -> Maybe UUID) -> ByteString -> Maybe UUID
forall a b. (a -> b) -> a -> b
$
    Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Word32 -> Put
Put.putWord32be Word32
d1 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word16 -> Put
Put.putWord16be Word16
d2 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word16 -> Put
Put.putWord16be Word16
d3 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
Put.putByteString ByteString
d4

putUUID :: TypeInfo -> UUID -> Put
putUUID :: TypeInfo -> UUID -> Put
putUUID TypeInfo
_ UUID
x = do
  let bs :: ByteString
bs = UUID -> ByteString
UUID.toByteString UUID
x
  let (Word32
d1,Word16
d2,Word16
d3,ByteString
d4) = (Get (Word32, Word16, Word16, ByteString)
 -> ByteString -> (Word32, Word16, Word16, ByteString))
-> ByteString
-> Get (Word32, Word16, Word16, ByteString)
-> (Word32, Word16, Word16, ByteString)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Get (Word32, Word16, Word16, ByteString)
-> ByteString -> (Word32, Word16, Word16, ByteString)
forall a. Get a -> ByteString -> a
runGet ByteString
bs (Get (Word32, Word16, Word16, ByteString)
 -> (Word32, Word16, Word16, ByteString))
-> Get (Word32, Word16, Word16, ByteString)
-> (Word32, Word16, Word16, ByteString)
forall a b. (a -> b) -> a -> b
$ (,,,) (Word32
 -> Word16
 -> Word16
 -> ByteString
 -> (Word32, Word16, Word16, ByteString))
-> Get Word32
-> Get
     (Word16
      -> Word16 -> ByteString -> (Word32, Word16, Word16, ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
Get.getWord32be Get
  (Word16
   -> Word16 -> ByteString -> (Word32, Word16, Word16, ByteString))
-> Get Word16
-> Get
     (Word16 -> ByteString -> (Word32, Word16, Word16, ByteString))
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
Get.getWord16be Get (Word16 -> ByteString -> (Word32, Word16, Word16, ByteString))
-> Get Word16
-> Get (ByteString -> (Word32, Word16, Word16, ByteString))
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
Get.getWord16be Get (ByteString -> (Word32, Word16, Word16, ByteString))
-> Get ByteString -> Get (Word32, Word16, Word16, ByteString)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get ByteString
Get.getByteString Int
8
  Word32 -> Put
Put.putWord32le Word32
d1 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word16 -> Put
Put.putWord16le Word16
d2 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word16 -> Put
Put.putWord16le Word16
d3 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
Put.putByteString ByteString
d4




withValidByteString :: TypeInfo -> (TypeInfo -> a) -> a
withValidByteString :: forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidByteString  = TypeInfo -> (TypeInfo -> a) -> a
forall a. TypeInfo -> (TypeInfo -> a) -> a
f
  where
    f :: TypeInfo -> (TypeInfo -> a) -> a
    f :: forall a. TypeInfo -> (TypeInfo -> a) -> a
f ti :: TypeInfo
ti@(TIChar Word8
_) TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f ti :: TypeInfo
ti@(TIVarChar Word8
_) TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f ti :: TypeInfo
ti@(TIBigChar Word16
_ Collation
_) TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f ti :: TypeInfo
ti@(TIBigVarChar Word16
_ Collation
_) TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f ti :: TypeInfo
ti@(TIText Word32
_ Collation
_) TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f ti :: TypeInfo
ti@(TIBinary Word8
_) TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f ti :: TypeInfo
ti@(TIVarBinary Word8
_) TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f ti :: TypeInfo
ti@(TIBigBinary Word16
_) TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f ti :: TypeInfo
ti@(TIBigVarBinary Word16
_) TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f ti :: TypeInfo
ti@(TIImage Word32
_) TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f TypeInfo
ti TypeInfo -> a
_ = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"withValidByteString: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (TypeInfo -> String
forall a. Show a => a -> String
show TypeInfo
ti) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is not convertible from/to ByteString"
    



withValidText' :: String -> TypeInfo -> (TypeInfo -> a) -> a
withValidText' :: forall a. String -> TypeInfo -> (TypeInfo -> a) -> a
withValidText' String
tn = TypeInfo -> (TypeInfo -> a) -> a
forall a. TypeInfo -> (TypeInfo -> a) -> a
f
  where
    f :: TypeInfo -> (TypeInfo -> a) -> a
    f :: forall a. TypeInfo -> (TypeInfo -> a) -> a
f ti :: TypeInfo
ti@(TINChar Word16
_ Collation
_) TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f ti :: TypeInfo
ti@(TINVarChar Word16
_ Collation
_) TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f ti :: TypeInfo
ti@(TINText Word32
_ Collation
_) TypeInfo -> a
g = TypeInfo -> a
g TypeInfo
ti
    f TypeInfo
ti TypeInfo -> a
_ = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"withValidText: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (TypeInfo -> String
forall a. Show a => a -> String
show TypeInfo
ti) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is not convertible from/to " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
tn

withValidText :: TypeInfo -> (TypeInfo -> a) -> a
withValidText = String -> TypeInfo -> (TypeInfo -> a) -> a
forall a. String -> TypeInfo -> (TypeInfo -> a) -> a
withValidText' String
"Text"
withValidString :: TypeInfo -> (TypeInfo -> a) -> a
withValidString = String -> TypeInfo -> (TypeInfo -> a) -> a
forall a. String -> TypeInfo -> (TypeInfo -> a) -> a
withValidText' String
"String"



runGet :: Get a -> LB.ByteString -> a
runGet :: forall a. Get a -> ByteString -> a
runGet Get a
f ByteString
bs = Get a -> ByteString -> a
forall a. Get a -> ByteString -> a
Get.runGet Get a
f ByteString
bs

runPut :: Put -> LB.ByteString
runPut :: Put -> ByteString
runPut Put
f = Put -> ByteString
Put.runPut Put
f


runGetBool :: TypeInfo -> LB.ByteString -> Bool
runGetBool :: TypeInfo -> ByteString -> Bool
runGetBool TypeInfo
ti ByteString
bs = (Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/=Integer
0) (Integer -> Bool) -> Integer -> Bool
forall a b. (a -> b) -> a -> b
$ Get Integer -> ByteString -> Integer
forall a. Get a -> ByteString -> a
runGet (TypeInfo -> Get Integer
forall a. Integral a => TypeInfo -> Get a
getIntegral TypeInfo
ti) ByteString
bs

runPutBool :: TypeInfo -> Bool -> LB.ByteString
runPutBool :: TypeInfo -> Bool -> ByteString
runPutBool TypeInfo
ti Bool
b = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ TypeInfo -> Integer -> Put
forall a. Integral a => TypeInfo -> a -> Put
putIntegral TypeInfo
ti (Integer -> Put) -> Integer -> Put
forall a b. (a -> b) -> a -> b
$ if Bool
b then Integer
1 else Integer
0



-- [TODO] check nullable flag

-- | [\[MS-TDS\] 2.2.5.5.1 System Data Type Values](https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-tds/5773bd3e-a8cf-45cc-a058-3fd3ec3a8aff)
class Data a where
  fromRawBytes :: TypeInfo -> RawBytes -> a
  toRawBytes :: TypeInfo -> a -> RawBytes


instance Data Null where
  fromRawBytes :: TypeInfo -> RawBytes -> Null
fromRawBytes TypeInfo
ti RawBytes
rb = TypeInfo -> (TypeInfo -> Null) -> Null
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidNull TypeInfo
ti ((TypeInfo -> Null) -> Null) -> (TypeInfo -> Null) -> Null
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ -> RawBytes -> Null
forall {a}. Maybe a -> Null
f RawBytes
rb
    where
      f :: Maybe a -> Null
f Maybe a
Nothing = Null
Null
      f Maybe a
_ = String -> Null
forall a. HasCallStack => String -> a
error String
"Null.fromRawBytes: non-Null value is not convertible to Null"
  toRawBytes :: TypeInfo -> Null -> RawBytes
toRawBytes TypeInfo
ti Null
_ = TypeInfo -> (TypeInfo -> RawBytes) -> RawBytes
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidNull TypeInfo
ti ((TypeInfo -> RawBytes) -> RawBytes)
-> (TypeInfo -> RawBytes) -> RawBytes
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ -> RawBytes
forall a. Maybe a
Nothing

instance Data Bool where
  fromRawBytes :: TypeInfo -> RawBytes -> Bool
fromRawBytes TypeInfo
ti (Just ByteString
bs) = TypeInfo -> (TypeInfo -> Bool) -> Bool
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidBool TypeInfo
ti ((TypeInfo -> Bool) -> Bool) -> (TypeInfo -> Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ \TypeInfo
vt -> TypeInfo -> ByteString -> Bool
runGetBool TypeInfo
vt ByteString
bs
  fromRawBytes TypeInfo
ti RawBytes
Nothing = TypeInfo -> (TypeInfo -> Bool) -> Bool
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidBool TypeInfo
ti ((TypeInfo -> Bool) -> Bool) -> (TypeInfo -> Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ -> String -> Bool
forall a. HasCallStack => String -> a
error String
"Bool.fromRawBytes: Null value is not convertible to Bool"
  toRawBytes :: TypeInfo -> Bool -> RawBytes
toRawBytes TypeInfo
ti Bool
b = TypeInfo -> (TypeInfo -> RawBytes) -> RawBytes
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidBool TypeInfo
ti ((TypeInfo -> RawBytes) -> RawBytes)
-> (TypeInfo -> RawBytes) -> RawBytes
forall a b. (a -> b) -> a -> b
$ \TypeInfo
vt -> ByteString -> RawBytes
forall a. a -> Maybe a
Just (ByteString -> RawBytes) -> ByteString -> RawBytes
forall a b. (a -> b) -> a -> b
$ TypeInfo -> Bool -> ByteString
runPutBool TypeInfo
vt Bool
b

instance Data Int where
  fromRawBytes :: TypeInfo -> RawBytes -> Int
fromRawBytes TypeInfo
ti (Just ByteString
bs) = TypeInfo -> (TypeInfo -> Int) -> Int
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidInt TypeInfo
ti ((TypeInfo -> Int) -> Int) -> (TypeInfo -> Int) -> Int
forall a b. (a -> b) -> a -> b
$ \TypeInfo
vt -> Get Int -> ByteString -> Int
forall a. Get a -> ByteString -> a
runGet (TypeInfo -> Get Int
forall a. Integral a => TypeInfo -> Get a
getIntegral TypeInfo
vt) ByteString
bs
  fromRawBytes TypeInfo
ti RawBytes
Nothing = TypeInfo -> (TypeInfo -> Int) -> Int
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidInt TypeInfo
ti ((TypeInfo -> Int) -> Int) -> (TypeInfo -> Int) -> Int
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ -> String -> Int
forall a. HasCallStack => String -> a
error String
"Int.fromRawBytes: Null value is not convertible to Int"
  toRawBytes :: TypeInfo -> Int -> RawBytes
toRawBytes TypeInfo
ti Int
i = TypeInfo -> (TypeInfo -> RawBytes) -> RawBytes
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidInt TypeInfo
ti ((TypeInfo -> RawBytes) -> RawBytes)
-> (TypeInfo -> RawBytes) -> RawBytes
forall a b. (a -> b) -> a -> b
$ \TypeInfo
vt -> ByteString -> RawBytes
forall a. a -> Maybe a
Just (ByteString -> RawBytes) -> ByteString -> RawBytes
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ TypeInfo -> Int -> Put
forall a. Integral a => TypeInfo -> a -> Put
putIntegral TypeInfo
vt Int
i

instance Data Integer where
  fromRawBytes :: TypeInfo -> RawBytes -> Integer
fromRawBytes TypeInfo
ti (Just ByteString
bs) = TypeInfo -> (TypeInfo -> Integer) -> Integer
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidInteger TypeInfo
ti ((TypeInfo -> Integer) -> Integer)
-> (TypeInfo -> Integer) -> Integer
forall a b. (a -> b) -> a -> b
$ \TypeInfo
vt -> Get Integer -> ByteString -> Integer
forall a. Get a -> ByteString -> a
runGet (TypeInfo -> Get Integer
forall a. Integral a => TypeInfo -> Get a
getIntegral TypeInfo
vt) ByteString
bs
  fromRawBytes TypeInfo
ti RawBytes
Nothing = TypeInfo -> (TypeInfo -> Integer) -> Integer
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidInteger TypeInfo
ti ((TypeInfo -> Integer) -> Integer)
-> (TypeInfo -> Integer) -> Integer
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ -> String -> Integer
forall a. HasCallStack => String -> a
error String
"Integer.fromRawBytes: Null value is not convertible to Integer"
  toRawBytes :: TypeInfo -> Integer -> RawBytes
toRawBytes TypeInfo
ti Integer
i = TypeInfo -> (TypeInfo -> RawBytes) -> RawBytes
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidInteger TypeInfo
ti ((TypeInfo -> RawBytes) -> RawBytes)
-> (TypeInfo -> RawBytes) -> RawBytes
forall a b. (a -> b) -> a -> b
$ \TypeInfo
vt -> ByteString -> RawBytes
forall a. a -> Maybe a
Just (ByteString -> RawBytes) -> ByteString -> RawBytes
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ TypeInfo -> Integer -> Put
forall a. Integral a => TypeInfo -> a -> Put
putIntegral TypeInfo
vt Integer
i

instance Data Money where
  fromRawBytes :: TypeInfo -> RawBytes -> Money
fromRawBytes TypeInfo
ti (Just ByteString
bs) = TypeInfo -> (TypeInfo -> Money) -> Money
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidMoney TypeInfo
ti ((TypeInfo -> Money) -> Money) -> (TypeInfo -> Money) -> Money
forall a b. (a -> b) -> a -> b
$ \TypeInfo
vt -> Get Money -> ByteString -> Money
forall a. Get a -> ByteString -> a
runGet (TypeInfo -> Get Money
getMoney TypeInfo
vt) ByteString
bs
  fromRawBytes TypeInfo
ti RawBytes
Nothing = TypeInfo -> (TypeInfo -> Money) -> Money
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidMoney TypeInfo
ti ((TypeInfo -> Money) -> Money) -> (TypeInfo -> Money) -> Money
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_-> String -> Money
forall a. HasCallStack => String -> a
error String
"Money.fromRawBytes: Null value is not convertible to Money"
  toRawBytes :: TypeInfo -> Money -> RawBytes
toRawBytes TypeInfo
ti Money
m = TypeInfo -> (TypeInfo -> RawBytes) -> RawBytes
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidMoney TypeInfo
ti ((TypeInfo -> RawBytes) -> RawBytes)
-> (TypeInfo -> RawBytes) -> RawBytes
forall a b. (a -> b) -> a -> b
$ \TypeInfo
vt -> ByteString -> RawBytes
forall a. a -> Maybe a
Just (ByteString -> RawBytes) -> ByteString -> RawBytes
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ TypeInfo -> Money -> Put
putMoney TypeInfo
vt Money
m
    
instance Data UTCTime where
  fromRawBytes :: TypeInfo -> RawBytes -> UTCTime
fromRawBytes TypeInfo
ti (Just ByteString
bs) = TypeInfo -> (TypeInfo -> UTCTime) -> UTCTime
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidUTCTime TypeInfo
ti ((TypeInfo -> UTCTime) -> UTCTime)
-> (TypeInfo -> UTCTime) -> UTCTime
forall a b. (a -> b) -> a -> b
$ \TypeInfo
vt -> Get UTCTime -> ByteString -> UTCTime
forall a. Get a -> ByteString -> a
runGet (TypeInfo -> Get UTCTime
getUTCTime TypeInfo
vt) ByteString
bs
  fromRawBytes TypeInfo
ti RawBytes
Nothing = TypeInfo -> (TypeInfo -> UTCTime) -> UTCTime
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidUTCTime TypeInfo
ti ((TypeInfo -> UTCTime) -> UTCTime)
-> (TypeInfo -> UTCTime) -> UTCTime
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ -> String -> UTCTime
forall a. HasCallStack => String -> a
error String
"UTCTime.fromRawBytes: Null value is not convertible to UTCTime"
  toRawBytes :: TypeInfo -> UTCTime -> RawBytes
toRawBytes TypeInfo
ti UTCTime
dt = TypeInfo -> (TypeInfo -> RawBytes) -> RawBytes
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidUTCTime TypeInfo
ti ((TypeInfo -> RawBytes) -> RawBytes)
-> (TypeInfo -> RawBytes) -> RawBytes
forall a b. (a -> b) -> a -> b
$ \TypeInfo
vt -> ByteString -> RawBytes
forall a. a -> Maybe a
Just (ByteString -> RawBytes) -> ByteString -> RawBytes
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ TypeInfo -> UTCTime -> Put
putUTCTime TypeInfo
vt UTCTime
dt

instance Data Float where
  fromRawBytes :: TypeInfo -> RawBytes -> Float
fromRawBytes TypeInfo
ti (Just ByteString
bs) = TypeInfo -> (TypeInfo -> Float) -> Float
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidFloat TypeInfo
ti ((TypeInfo -> Float) -> Float) -> (TypeInfo -> Float) -> Float
forall a b. (a -> b) -> a -> b
$ \TypeInfo
vt -> Get Float -> ByteString -> Float
forall a. Get a -> ByteString -> a
runGet (TypeInfo -> Get Float
forall a. Fractional a => TypeInfo -> Get a
getFloat TypeInfo
vt) ByteString
bs
  fromRawBytes TypeInfo
ti RawBytes
Nothing = TypeInfo -> (TypeInfo -> Float) -> Float
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidFloat TypeInfo
ti ((TypeInfo -> Float) -> Float) -> (TypeInfo -> Float) -> Float
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ -> String -> Float
forall a. HasCallStack => String -> a
error String
"Float.fromRawBytes: Null value is not convertible to Float"
  toRawBytes :: TypeInfo -> Float -> RawBytes
toRawBytes TypeInfo
ti Float
f = TypeInfo -> (TypeInfo -> RawBytes) -> RawBytes
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidFloat TypeInfo
ti ((TypeInfo -> RawBytes) -> RawBytes)
-> (TypeInfo -> RawBytes) -> RawBytes
forall a b. (a -> b) -> a -> b
$ \TypeInfo
vt -> ByteString -> RawBytes
forall a. a -> Maybe a
Just (ByteString -> RawBytes) -> ByteString -> RawBytes
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ TypeInfo -> Float -> Put
forall a. Real a => TypeInfo -> a -> Put
putFloat TypeInfo
vt Float
f

instance Data Double where
  fromRawBytes :: TypeInfo -> RawBytes -> Double
fromRawBytes TypeInfo
ti (Just ByteString
bs) = TypeInfo -> (TypeInfo -> Double) -> Double
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidDouble TypeInfo
ti ((TypeInfo -> Double) -> Double) -> (TypeInfo -> Double) -> Double
forall a b. (a -> b) -> a -> b
$ \TypeInfo
vt -> Get Double -> ByteString -> Double
forall a. Get a -> ByteString -> a
runGet (TypeInfo -> Get Double
forall a. Fractional a => TypeInfo -> Get a
getFloat TypeInfo
vt) ByteString
bs
  fromRawBytes TypeInfo
ti RawBytes
Nothing = TypeInfo -> (TypeInfo -> Double) -> Double
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidDouble TypeInfo
ti ((TypeInfo -> Double) -> Double) -> (TypeInfo -> Double) -> Double
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ -> String -> Double
forall a. HasCallStack => String -> a
error String
"Double.fromRawBytes: Null value is not convertible to Double"
  toRawBytes :: TypeInfo -> Double -> RawBytes
toRawBytes TypeInfo
ti Double
f = TypeInfo -> (TypeInfo -> RawBytes) -> RawBytes
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidDouble TypeInfo
ti ((TypeInfo -> RawBytes) -> RawBytes)
-> (TypeInfo -> RawBytes) -> RawBytes
forall a b. (a -> b) -> a -> b
$ \TypeInfo
vt -> ByteString -> RawBytes
forall a. a -> Maybe a
Just (ByteString -> RawBytes) -> ByteString -> RawBytes
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ TypeInfo -> Double -> Put
forall a. Real a => TypeInfo -> a -> Put
putFloat TypeInfo
vt Double
f


instance (HasResolution a) => Data (Fixed a) where
  fromRawBytes :: TypeInfo -> RawBytes -> Fixed a
fromRawBytes TypeInfo
ti (Just ByteString
bs) = TypeInfo -> (TypeInfo -> Fixed a) -> Fixed a
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidFixed TypeInfo
ti ((TypeInfo -> Fixed a) -> Fixed a)
-> (TypeInfo -> Fixed a) -> Fixed a
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ ->
    Get (Fixed a) -> ByteString -> Fixed a
forall a. Get a -> ByteString -> a
runGet (Int -> Get (Fixed a)
forall a. HasResolution a => Int -> Get (Fixed a)
getFixed (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
LB.length ByteString
bs)) ByteString
bs
  fromRawBytes TypeInfo
ti RawBytes
Nothing = TypeInfo -> (TypeInfo -> Fixed a) -> Fixed a
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidFixed TypeInfo
ti ((TypeInfo -> Fixed a) -> Fixed a)
-> (TypeInfo -> Fixed a) -> Fixed a
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ -> String -> Fixed a
forall a. HasCallStack => String -> a
error String
"Fixed.fromRawBytes: Null value is not convertible to Fixed"
  toRawBytes :: TypeInfo -> Fixed a -> RawBytes
toRawBytes TypeInfo
ti Fixed a
f = TypeInfo -> (TypeInfo -> RawBytes) -> RawBytes
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidFixed TypeInfo
ti ((TypeInfo -> RawBytes) -> RawBytes)
-> (TypeInfo -> RawBytes) -> RawBytes
forall a b. (a -> b) -> a -> b
$ \TypeInfo
vt -> ByteString -> RawBytes
forall a. a -> Maybe a
Just (ByteString -> RawBytes) -> ByteString -> RawBytes
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ TypeInfo -> Fixed a -> Put
forall a. HasResolution a => TypeInfo -> Fixed a -> Put
putFixed TypeInfo
vt Fixed a
f
    
instance Data UUID where
  fromRawBytes :: TypeInfo -> RawBytes -> UUID
fromRawBytes TypeInfo
ti (Just ByteString
bs) = TypeInfo -> (TypeInfo -> UUID) -> UUID
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidUUID TypeInfo
ti ((TypeInfo -> UUID) -> UUID) -> (TypeInfo -> UUID) -> UUID
forall a b. (a -> b) -> a -> b
$ \TypeInfo
vt -> case Get (Maybe UUID) -> ByteString -> Maybe UUID
forall a. Get a -> ByteString -> a
runGet (TypeInfo -> Get (Maybe UUID)
getUUID TypeInfo
vt) ByteString
bs of
                                                          Maybe UUID
Nothing -> String -> UUID
forall a. HasCallStack => String -> a
error String
"UUID.fromRawBytes: UUID.fromBtyteString error"
                                                          Just (UUID
uuid) -> UUID
uuid
  fromRawBytes TypeInfo
ti RawBytes
Nothing = TypeInfo -> (TypeInfo -> UUID) -> UUID
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidUUID TypeInfo
ti ((TypeInfo -> UUID) -> UUID) -> (TypeInfo -> UUID) -> UUID
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ -> String -> UUID
forall a. HasCallStack => String -> a
error String
"UUID.fromRawBytes: Null value is not convertible to UUID"
  toRawBytes :: TypeInfo -> UUID -> RawBytes
toRawBytes TypeInfo
ti UUID
uuid = TypeInfo -> (TypeInfo -> RawBytes) -> RawBytes
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidUUID TypeInfo
ti ((TypeInfo -> RawBytes) -> RawBytes)
-> (TypeInfo -> RawBytes) -> RawBytes
forall a b. (a -> b) -> a -> b
$ \TypeInfo
vt -> ByteString -> RawBytes
forall a. a -> Maybe a
Just (ByteString -> RawBytes) -> ByteString -> RawBytes
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ TypeInfo -> UUID -> Put
putUUID TypeInfo
vt UUID
uuid

instance Data B.ByteString where
  fromRawBytes :: TypeInfo -> RawBytes -> ByteString
fromRawBytes TypeInfo
ti (Just ByteString
bs) = TypeInfo -> (TypeInfo -> ByteString) -> ByteString
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidByteString TypeInfo
ti ((TypeInfo -> ByteString) -> ByteString)
-> (TypeInfo -> ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ -> ByteString -> ByteString
LB.toStrict ByteString
bs
  fromRawBytes TypeInfo
ti RawBytes
Nothing = TypeInfo -> (TypeInfo -> ByteString) -> ByteString
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidByteString TypeInfo
ti ((TypeInfo -> ByteString) -> ByteString)
-> (TypeInfo -> ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ -> String -> ByteString
forall a. HasCallStack => String -> a
error String
"ByteString.fromRawBytes: Null value is not convertible to ByteString"
  toRawBytes :: TypeInfo -> ByteString -> RawBytes
toRawBytes TypeInfo
ti ByteString
bs = TypeInfo -> (TypeInfo -> RawBytes) -> RawBytes
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidByteString TypeInfo
ti ((TypeInfo -> RawBytes) -> RawBytes)
-> (TypeInfo -> RawBytes) -> RawBytes
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ -> ByteString -> RawBytes
forall a. a -> Maybe a
Just (ByteString -> RawBytes) -> ByteString -> RawBytes
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LB.fromStrict ByteString
bs

instance Data T.Text where
  fromRawBytes :: TypeInfo -> RawBytes -> Text
fromRawBytes TypeInfo
ti (Just ByteString
bs) = TypeInfo -> (TypeInfo -> Text) -> Text
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidText TypeInfo
ti ((TypeInfo -> Text) -> Text) -> (TypeInfo -> Text) -> Text
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ -> ByteString -> Text
T.decodeUtf16LE (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LB.toStrict ByteString
bs
  fromRawBytes TypeInfo
ti RawBytes
Nothing = TypeInfo -> (TypeInfo -> Text) -> Text
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidText TypeInfo
ti ((TypeInfo -> Text) -> Text) -> (TypeInfo -> Text) -> Text
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ -> String -> Text
forall a. HasCallStack => String -> a
error String
"Text.fromRawBytes: Null value is not convertible to Text"
  toRawBytes :: TypeInfo -> Text -> RawBytes
toRawBytes TypeInfo
ti Text
t = TypeInfo -> (TypeInfo -> RawBytes) -> RawBytes
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidText TypeInfo
ti ((TypeInfo -> RawBytes) -> RawBytes)
-> (TypeInfo -> RawBytes) -> RawBytes
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ -> ByteString -> RawBytes
forall a. a -> Maybe a
Just (ByteString -> RawBytes) -> ByteString -> RawBytes
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LB.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf16LE Text
t

instance Data LB.ByteString where
  fromRawBytes :: TypeInfo -> RawBytes -> ByteString
fromRawBytes TypeInfo
ti (Just ByteString
bs) = TypeInfo -> (TypeInfo -> ByteString) -> ByteString
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidByteString TypeInfo
ti ((TypeInfo -> ByteString) -> ByteString)
-> (TypeInfo -> ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ -> ByteString
bs
  fromRawBytes TypeInfo
ti RawBytes
Nothing = TypeInfo -> (TypeInfo -> ByteString) -> ByteString
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidByteString TypeInfo
ti ((TypeInfo -> ByteString) -> ByteString)
-> (TypeInfo -> ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ -> String -> ByteString
forall a. HasCallStack => String -> a
error String
"ByteString.fromRawBytes: Null value is not convertible to ByteString"
  toRawBytes :: TypeInfo -> ByteString -> RawBytes
toRawBytes TypeInfo
ti ByteString
bs = TypeInfo -> (TypeInfo -> RawBytes) -> RawBytes
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidByteString TypeInfo
ti ((TypeInfo -> RawBytes) -> RawBytes)
-> (TypeInfo -> RawBytes) -> RawBytes
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ -> ByteString -> RawBytes
forall a. a -> Maybe a
Just ByteString
bs

instance Data LT.Text where
  fromRawBytes :: TypeInfo -> RawBytes -> Text
fromRawBytes TypeInfo
ti (Just ByteString
bs) = TypeInfo -> (TypeInfo -> Text) -> Text
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidText TypeInfo
ti ((TypeInfo -> Text) -> Text) -> (TypeInfo -> Text) -> Text
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ -> ByteString -> Text
LT.decodeUtf16LE ByteString
bs
  fromRawBytes TypeInfo
ti RawBytes
Nothing = TypeInfo -> (TypeInfo -> Text) -> Text
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidText TypeInfo
ti ((TypeInfo -> Text) -> Text) -> (TypeInfo -> Text) -> Text
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ -> String -> Text
forall a. HasCallStack => String -> a
error String
"Text.fromRawBytes: Null value is not convertible to Text"
  toRawBytes :: TypeInfo -> Text -> RawBytes
toRawBytes TypeInfo
ti Text
t = TypeInfo -> (TypeInfo -> RawBytes) -> RawBytes
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidText TypeInfo
ti ((TypeInfo -> RawBytes) -> RawBytes)
-> (TypeInfo -> RawBytes) -> RawBytes
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ -> ByteString -> RawBytes
forall a. a -> Maybe a
Just (ByteString -> RawBytes) -> ByteString -> RawBytes
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
LT.encodeUtf16LE Text
t

instance Data String where
  fromRawBytes :: TypeInfo -> RawBytes -> String
fromRawBytes TypeInfo
ti (Just ByteString
bs) = TypeInfo -> (TypeInfo -> String) -> String
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidString TypeInfo
ti ((TypeInfo -> String) -> String) -> (TypeInfo -> String) -> String
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ -> Text -> String
LT.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
LT.decodeUtf16LE ByteString
bs
  fromRawBytes TypeInfo
ti RawBytes
Nothing = TypeInfo -> (TypeInfo -> String) -> String
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidString TypeInfo
ti ((TypeInfo -> String) -> String) -> (TypeInfo -> String) -> String
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ -> ShowS
forall a. HasCallStack => String -> a
error String
"String.fromRawBytes: Null value is not convertible to String"
  toRawBytes :: TypeInfo -> String -> RawBytes
toRawBytes TypeInfo
ti String
s = TypeInfo -> (TypeInfo -> RawBytes) -> RawBytes
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidString TypeInfo
ti ((TypeInfo -> RawBytes) -> RawBytes)
-> (TypeInfo -> RawBytes) -> RawBytes
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ -> ByteString -> RawBytes
forall a. a -> Maybe a
Just (ByteString -> RawBytes) -> ByteString -> RawBytes
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
LT.encodeUtf16LE (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> Text
LT.pack String
s



instance Data (Maybe Bool) where
  fromRawBytes :: TypeInfo -> RawBytes -> Maybe Bool
fromRawBytes TypeInfo
ti RawBytes
rb = TypeInfo -> (TypeInfo -> Maybe Bool) -> Maybe Bool
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidBool TypeInfo
ti ((TypeInfo -> Maybe Bool) -> Maybe Bool)
-> (TypeInfo -> Maybe Bool) -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ \TypeInfo
vt -> TypeInfo -> ByteString -> Bool
runGetBool TypeInfo
vt (ByteString -> Bool) -> RawBytes -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawBytes
rb
  toRawBytes :: TypeInfo -> Maybe Bool -> RawBytes
toRawBytes TypeInfo
ti Maybe Bool
b = TypeInfo -> (TypeInfo -> RawBytes) -> RawBytes
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidBool TypeInfo
ti ((TypeInfo -> RawBytes) -> RawBytes)
-> (TypeInfo -> RawBytes) -> RawBytes
forall a b. (a -> b) -> a -> b
$ \TypeInfo
vt ->
                    case Maybe Bool
b of
                      Maybe Bool
Nothing | (Bool -> Bool
not (Bool -> Bool) -> (TypeInfo -> Bool) -> TypeInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeInfo -> Bool
isIntegralN) TypeInfo
vt -> String -> RawBytes
forall a. HasCallStack => String -> a
error (String -> RawBytes) -> String -> RawBytes
forall a b. (a -> b) -> a -> b
$ String
"(Maybe Bool).toRawBytes: Nothing is not convertible to " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (TypeInfo -> String
forall a. Show a => a -> String
show TypeInfo
vt)
                      Maybe Bool
_ -> TypeInfo -> Bool -> ByteString
runPutBool TypeInfo
vt (Bool -> ByteString) -> Maybe Bool -> RawBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
b

instance Data (Maybe Int) where
  fromRawBytes :: TypeInfo -> RawBytes -> Maybe Int
fromRawBytes TypeInfo
ti RawBytes
rb = TypeInfo -> (TypeInfo -> Maybe Int) -> Maybe Int
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidInt TypeInfo
ti ((TypeInfo -> Maybe Int) -> Maybe Int)
-> (TypeInfo -> Maybe Int) -> Maybe Int
forall a b. (a -> b) -> a -> b
$ \TypeInfo
vt -> (Get Int -> ByteString -> Int
forall a. Get a -> ByteString -> a
runGet (TypeInfo -> Get Int
forall a. Integral a => TypeInfo -> Get a
getIntegral TypeInfo
vt)) (ByteString -> Int) -> RawBytes -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawBytes
rb
  toRawBytes :: TypeInfo -> Maybe Int -> RawBytes
toRawBytes TypeInfo
ti Maybe Int
i = TypeInfo -> (TypeInfo -> RawBytes) -> RawBytes
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidInt TypeInfo
ti ((TypeInfo -> RawBytes) -> RawBytes)
-> (TypeInfo -> RawBytes) -> RawBytes
forall a b. (a -> b) -> a -> b
$ \TypeInfo
vt -> 
                    case Maybe Int
i of
                      Maybe Int
Nothing | (Bool -> Bool
not (Bool -> Bool) -> (TypeInfo -> Bool) -> TypeInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeInfo -> Bool
isIntegralN) TypeInfo
vt -> String -> RawBytes
forall a. HasCallStack => String -> a
error (String -> RawBytes) -> String -> RawBytes
forall a b. (a -> b) -> a -> b
$ String
"(Maybe Int).toRawBytes: Nothing is not convertible to " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (TypeInfo -> String
forall a. Show a => a -> String
show TypeInfo
vt)
                      Maybe Int
_ -> Put -> ByteString
runPut (Put -> ByteString) -> (Int -> Put) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeInfo -> Int -> Put
forall a. Integral a => TypeInfo -> a -> Put
putIntegral TypeInfo
vt) (Int -> ByteString) -> Maybe Int -> RawBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
i

instance Data (Maybe Integer) where
  fromRawBytes :: TypeInfo -> RawBytes -> Maybe Integer
fromRawBytes TypeInfo
ti RawBytes
rb = TypeInfo -> (TypeInfo -> Maybe Integer) -> Maybe Integer
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidInteger TypeInfo
ti ((TypeInfo -> Maybe Integer) -> Maybe Integer)
-> (TypeInfo -> Maybe Integer) -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ \TypeInfo
vt -> (Get Integer -> ByteString -> Integer
forall a. Get a -> ByteString -> a
runGet (TypeInfo -> Get Integer
forall a. Integral a => TypeInfo -> Get a
getIntegral TypeInfo
vt)) (ByteString -> Integer) -> RawBytes -> Maybe Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawBytes
rb
  toRawBytes :: TypeInfo -> Maybe Integer -> RawBytes
toRawBytes TypeInfo
ti Maybe Integer
i = TypeInfo -> (TypeInfo -> RawBytes) -> RawBytes
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidInteger TypeInfo
ti ((TypeInfo -> RawBytes) -> RawBytes)
-> (TypeInfo -> RawBytes) -> RawBytes
forall a b. (a -> b) -> a -> b
$ \TypeInfo
vt->
                    case Maybe Integer
i of
                      Maybe Integer
Nothing | (Bool -> Bool
not (Bool -> Bool) -> (TypeInfo -> Bool) -> TypeInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeInfo -> Bool
isIntegralN) TypeInfo
vt -> String -> RawBytes
forall a. HasCallStack => String -> a
error (String -> RawBytes) -> String -> RawBytes
forall a b. (a -> b) -> a -> b
$ String
"(Maybe Integer).toRawBytes: Nothing is not convertible to " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (TypeInfo -> String
forall a. Show a => a -> String
show TypeInfo
vt)
                      Maybe Integer
_ -> Put -> ByteString
runPut (Put -> ByteString) -> (Integer -> Put) -> Integer -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeInfo -> Integer -> Put
forall a. Integral a => TypeInfo -> a -> Put
putIntegral TypeInfo
vt) (Integer -> ByteString) -> Maybe Integer -> RawBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
i

instance Data (Maybe Money) where
  fromRawBytes :: TypeInfo -> RawBytes -> Maybe Money
fromRawBytes TypeInfo
ti RawBytes
rb = TypeInfo -> (TypeInfo -> Maybe Money) -> Maybe Money
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidMoney TypeInfo
ti ((TypeInfo -> Maybe Money) -> Maybe Money)
-> (TypeInfo -> Maybe Money) -> Maybe Money
forall a b. (a -> b) -> a -> b
$ \TypeInfo
vt -> (Get Money -> ByteString -> Money
forall a. Get a -> ByteString -> a
runGet (TypeInfo -> Get Money
getMoney TypeInfo
vt)) (ByteString -> Money) -> RawBytes -> Maybe Money
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawBytes
rb
  toRawBytes :: TypeInfo -> Maybe Money -> RawBytes
toRawBytes TypeInfo
ti Maybe Money
m = TypeInfo -> (TypeInfo -> RawBytes) -> RawBytes
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidMoney TypeInfo
ti ((TypeInfo -> RawBytes) -> RawBytes)
-> (TypeInfo -> RawBytes) -> RawBytes
forall a b. (a -> b) -> a -> b
$ \TypeInfo
vt -> 
                    case Maybe Money
m of
                      Maybe Money
Nothing | (Bool -> Bool
not (Bool -> Bool) -> (TypeInfo -> Bool) -> TypeInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeInfo -> Bool
isMoneyN) TypeInfo
vt -> String -> RawBytes
forall a. HasCallStack => String -> a
error (String -> RawBytes) -> String -> RawBytes
forall a b. (a -> b) -> a -> b
$ String
"(Maybe Money).toRawBytes: Nothing is not convertible to " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (TypeInfo -> String
forall a. Show a => a -> String
show TypeInfo
vt)
                      Maybe Money
_ -> Put -> ByteString
runPut (Put -> ByteString) -> (Money -> Put) -> Money -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeInfo -> Money -> Put
putMoney TypeInfo
vt) (Money -> ByteString) -> Maybe Money -> RawBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Money
m

instance Data (Maybe UTCTime) where
  fromRawBytes :: TypeInfo -> RawBytes -> Maybe UTCTime
fromRawBytes TypeInfo
ti RawBytes
rb = TypeInfo -> (TypeInfo -> Maybe UTCTime) -> Maybe UTCTime
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidUTCTime TypeInfo
ti ((TypeInfo -> Maybe UTCTime) -> Maybe UTCTime)
-> (TypeInfo -> Maybe UTCTime) -> Maybe UTCTime
forall a b. (a -> b) -> a -> b
$ \TypeInfo
vt -> (Get UTCTime -> ByteString -> UTCTime
forall a. Get a -> ByteString -> a
runGet (TypeInfo -> Get UTCTime
getUTCTime TypeInfo
vt)) (ByteString -> UTCTime) -> RawBytes -> Maybe UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawBytes
rb
  toRawBytes :: TypeInfo -> Maybe UTCTime -> RawBytes
toRawBytes TypeInfo
ti Maybe UTCTime
dt = TypeInfo -> (TypeInfo -> RawBytes) -> RawBytes
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidUTCTime TypeInfo
ti ((TypeInfo -> RawBytes) -> RawBytes)
-> (TypeInfo -> RawBytes) -> RawBytes
forall a b. (a -> b) -> a -> b
$ \TypeInfo
vt ->
                     case Maybe UTCTime
dt of
                       Maybe UTCTime
Nothing | (Bool -> Bool
not (Bool -> Bool) -> (TypeInfo -> Bool) -> TypeInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeInfo -> Bool
isUTCTimeN) TypeInfo
vt -> String -> RawBytes
forall a. HasCallStack => String -> a
error (String -> RawBytes) -> String -> RawBytes
forall a b. (a -> b) -> a -> b
$ String
"(Maybe UTCTime).toRawBytes: Nothing is not convertible to " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (TypeInfo -> String
forall a. Show a => a -> String
show TypeInfo
vt)
                       Maybe UTCTime
_ -> Put -> ByteString
runPut (Put -> ByteString) -> (UTCTime -> Put) -> UTCTime -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeInfo -> UTCTime -> Put
putUTCTime TypeInfo
vt) (UTCTime -> ByteString) -> Maybe UTCTime -> RawBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UTCTime
dt

instance Data (Maybe Float) where
  fromRawBytes :: TypeInfo -> RawBytes -> Maybe Float
fromRawBytes TypeInfo
ti RawBytes
rb = TypeInfo -> (TypeInfo -> Maybe Float) -> Maybe Float
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidFloat TypeInfo
ti ((TypeInfo -> Maybe Float) -> Maybe Float)
-> (TypeInfo -> Maybe Float) -> Maybe Float
forall a b. (a -> b) -> a -> b
$ \TypeInfo
vt -> (Get Float -> ByteString -> Float
forall a. Get a -> ByteString -> a
runGet (TypeInfo -> Get Float
forall a. Fractional a => TypeInfo -> Get a
getFloat TypeInfo
vt)) (ByteString -> Float) -> RawBytes -> Maybe Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawBytes
rb
  toRawBytes :: TypeInfo -> Maybe Float -> RawBytes
toRawBytes TypeInfo
ti Maybe Float
f = TypeInfo -> (TypeInfo -> RawBytes) -> RawBytes
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidFloat TypeInfo
ti ((TypeInfo -> RawBytes) -> RawBytes)
-> (TypeInfo -> RawBytes) -> RawBytes
forall a b. (a -> b) -> a -> b
$ \TypeInfo
vt ->
                    case Maybe Float
f of
                      Maybe Float
Nothing | (Bool -> Bool
not (Bool -> Bool) -> (TypeInfo -> Bool) -> TypeInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeInfo -> Bool
isFloatN) TypeInfo
vt -> String -> RawBytes
forall a. HasCallStack => String -> a
error (String -> RawBytes) -> String -> RawBytes
forall a b. (a -> b) -> a -> b
$ String
"(Maybe Float).toRawBytes: Nothing is not convertible to " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (TypeInfo -> String
forall a. Show a => a -> String
show TypeInfo
vt)
                      Maybe Float
_ -> Put -> ByteString
runPut (Put -> ByteString) -> (Float -> Put) -> Float -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeInfo -> Float -> Put
forall a. Real a => TypeInfo -> a -> Put
putFloat TypeInfo
vt) (Float -> ByteString) -> Maybe Float -> RawBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Float
f

instance Data (Maybe Double) where
  fromRawBytes :: TypeInfo -> RawBytes -> Maybe Double
fromRawBytes TypeInfo
ti RawBytes
rb = TypeInfo -> (TypeInfo -> Maybe Double) -> Maybe Double
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidDouble TypeInfo
ti ((TypeInfo -> Maybe Double) -> Maybe Double)
-> (TypeInfo -> Maybe Double) -> Maybe Double
forall a b. (a -> b) -> a -> b
$ \TypeInfo
vt -> (Get Double -> ByteString -> Double
forall a. Get a -> ByteString -> a
runGet (TypeInfo -> Get Double
forall a. Fractional a => TypeInfo -> Get a
getFloat TypeInfo
vt)) (ByteString -> Double) -> RawBytes -> Maybe Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawBytes
rb
  toRawBytes :: TypeInfo -> Maybe Double -> RawBytes
toRawBytes TypeInfo
ti Maybe Double
f = TypeInfo -> (TypeInfo -> RawBytes) -> RawBytes
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidDouble TypeInfo
ti ((TypeInfo -> RawBytes) -> RawBytes)
-> (TypeInfo -> RawBytes) -> RawBytes
forall a b. (a -> b) -> a -> b
$ \TypeInfo
vt ->
                    case Maybe Double
f of
                      Maybe Double
Nothing | (Bool -> Bool
not (Bool -> Bool) -> (TypeInfo -> Bool) -> TypeInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeInfo -> Bool
isFloatN) TypeInfo
vt -> String -> RawBytes
forall a. HasCallStack => String -> a
error (String -> RawBytes) -> String -> RawBytes
forall a b. (a -> b) -> a -> b
$ String
"(Maybe Double).toRawBytes: Nothing is not convertible to " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (TypeInfo -> String
forall a. Show a => a -> String
show TypeInfo
vt)
                      Maybe Double
_ -> Put -> ByteString
runPut (Put -> ByteString) -> (Double -> Put) -> Double -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeInfo -> Double -> Put
forall a. Real a => TypeInfo -> a -> Put
putFloat TypeInfo
vt) (Double -> ByteString) -> Maybe Double -> RawBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Double
f


instance (HasResolution a) => Data (Maybe (Fixed a)) where
  fromRawBytes :: TypeInfo -> RawBytes -> Maybe (Fixed a)
fromRawBytes TypeInfo
ti RawBytes
rb = TypeInfo -> (TypeInfo -> Maybe (Fixed a)) -> Maybe (Fixed a)
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidFixed TypeInfo
ti ((TypeInfo -> Maybe (Fixed a)) -> Maybe (Fixed a))
-> (TypeInfo -> Maybe (Fixed a)) -> Maybe (Fixed a)
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ ->
    (\ByteString
bs -> Get (Fixed a) -> ByteString -> Fixed a
forall a. Get a -> ByteString -> a
runGet (Int -> Get (Fixed a)
forall a. HasResolution a => Int -> Get (Fixed a)
getFixed (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
LB.length ByteString
bs)) ByteString
bs) (ByteString -> Fixed a) -> RawBytes -> Maybe (Fixed a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawBytes
rb
  toRawBytes :: TypeInfo -> Maybe (Fixed a) -> RawBytes
toRawBytes TypeInfo
ti Maybe (Fixed a)
f = TypeInfo -> (TypeInfo -> RawBytes) -> RawBytes
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidFixed TypeInfo
ti ((TypeInfo -> RawBytes) -> RawBytes)
-> (TypeInfo -> RawBytes) -> RawBytes
forall a b. (a -> b) -> a -> b
$ \TypeInfo
vt -> Put -> ByteString
runPut (Put -> ByteString) -> (Fixed a -> Put) -> Fixed a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeInfo -> Fixed a -> Put
forall a. HasResolution a => TypeInfo -> Fixed a -> Put
putFixed TypeInfo
vt (Fixed a -> ByteString) -> Maybe (Fixed a) -> RawBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Fixed a)
f

instance Data (Maybe UUID) where
  fromRawBytes :: TypeInfo -> RawBytes -> Maybe UUID
fromRawBytes TypeInfo
ti RawBytes
rb = TypeInfo -> (TypeInfo -> Maybe UUID) -> Maybe UUID
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidUUID TypeInfo
ti ((TypeInfo -> Maybe UUID) -> Maybe UUID)
-> (TypeInfo -> Maybe UUID) -> Maybe UUID
forall a b. (a -> b) -> a -> b
$ \TypeInfo
vt -> TypeInfo -> ByteString -> UUID
f TypeInfo
vt (ByteString -> UUID) -> RawBytes -> Maybe UUID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawBytes
rb
    where
      f :: TypeInfo -> LB.ByteString -> UUID
      f :: TypeInfo -> ByteString -> UUID
f TypeInfo
vt ByteString
bs = case (Get (Maybe UUID) -> ByteString -> Maybe UUID
forall a. Get a -> ByteString -> a
runGet (TypeInfo -> Get (Maybe UUID)
getUUID TypeInfo
vt)) ByteString
bs of
                  Maybe UUID
Nothing -> String -> UUID
forall a. HasCallStack => String -> a
error String
"(Maybe UUID).fromRawBytes: UUID.fromBtyteString error"
                  Just (UUID
uuid) -> UUID
uuid
  toRawBytes :: TypeInfo -> Maybe UUID -> RawBytes
toRawBytes TypeInfo
ti Maybe UUID
m = TypeInfo -> (TypeInfo -> RawBytes) -> RawBytes
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidUUID TypeInfo
ti ((TypeInfo -> RawBytes) -> RawBytes)
-> (TypeInfo -> RawBytes) -> RawBytes
forall a b. (a -> b) -> a -> b
$ \TypeInfo
vt -> Put -> ByteString
runPut (Put -> ByteString) -> (UUID -> Put) -> UUID -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeInfo -> UUID -> Put
putUUID TypeInfo
vt (UUID -> ByteString) -> Maybe UUID -> RawBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UUID
m

instance Data (Maybe B.ByteString) where
  fromRawBytes :: TypeInfo -> RawBytes -> Maybe ByteString
fromRawBytes TypeInfo
ti RawBytes
rb = TypeInfo -> (TypeInfo -> Maybe ByteString) -> Maybe ByteString
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidByteString TypeInfo
ti ((TypeInfo -> Maybe ByteString) -> Maybe ByteString)
-> (TypeInfo -> Maybe ByteString) -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ -> ByteString -> ByteString
LB.toStrict (ByteString -> ByteString) -> RawBytes -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawBytes
rb
  toRawBytes :: TypeInfo -> Maybe ByteString -> RawBytes
toRawBytes TypeInfo
ti Maybe ByteString
bs = TypeInfo -> (TypeInfo -> RawBytes) -> RawBytes
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidByteString TypeInfo
ti ((TypeInfo -> RawBytes) -> RawBytes)
-> (TypeInfo -> RawBytes) -> RawBytes
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ -> ByteString -> ByteString
LB.fromStrict (ByteString -> ByteString) -> Maybe ByteString -> RawBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
bs
  
instance Data (Maybe T.Text) where
  fromRawBytes :: TypeInfo -> RawBytes -> Maybe Text
fromRawBytes TypeInfo
ti RawBytes
rb = TypeInfo -> (TypeInfo -> Maybe Text) -> Maybe Text
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidText TypeInfo
ti ((TypeInfo -> Maybe Text) -> Maybe Text)
-> (TypeInfo -> Maybe Text) -> Maybe Text
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ -> ByteString -> Text
T.decodeUtf16LE (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LB.toStrict (ByteString -> Text) -> RawBytes -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawBytes
rb 
  toRawBytes :: TypeInfo -> Maybe Text -> RawBytes
toRawBytes TypeInfo
ti Maybe Text
t = TypeInfo -> (TypeInfo -> RawBytes) -> RawBytes
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidText TypeInfo
ti ((TypeInfo -> RawBytes) -> RawBytes)
-> (TypeInfo -> RawBytes) -> RawBytes
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ -> ByteString -> ByteString
LB.fromStrict (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf16LE (Text -> ByteString) -> Maybe Text -> RawBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
t

instance Data (Maybe LB.ByteString) where
  fromRawBytes :: TypeInfo -> RawBytes -> RawBytes
fromRawBytes TypeInfo
ti RawBytes
rb = TypeInfo -> (TypeInfo -> RawBytes) -> RawBytes
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidByteString TypeInfo
ti ((TypeInfo -> RawBytes) -> RawBytes)
-> (TypeInfo -> RawBytes) -> RawBytes
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ -> RawBytes
rb
  toRawBytes :: TypeInfo -> RawBytes -> RawBytes
toRawBytes TypeInfo
ti RawBytes
bs = TypeInfo -> (TypeInfo -> RawBytes) -> RawBytes
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidByteString TypeInfo
ti ((TypeInfo -> RawBytes) -> RawBytes)
-> (TypeInfo -> RawBytes) -> RawBytes
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ -> RawBytes
bs
  
instance Data (Maybe LT.Text) where
  fromRawBytes :: TypeInfo -> RawBytes -> Maybe Text
fromRawBytes TypeInfo
ti RawBytes
rb = TypeInfo -> (TypeInfo -> Maybe Text) -> Maybe Text
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidText TypeInfo
ti ((TypeInfo -> Maybe Text) -> Maybe Text)
-> (TypeInfo -> Maybe Text) -> Maybe Text
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ -> ByteString -> Text
LT.decodeUtf16LE (ByteString -> Text) -> RawBytes -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawBytes
rb 
  toRawBytes :: TypeInfo -> Maybe Text -> RawBytes
toRawBytes TypeInfo
ti Maybe Text
t = TypeInfo -> (TypeInfo -> RawBytes) -> RawBytes
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidText TypeInfo
ti ((TypeInfo -> RawBytes) -> RawBytes)
-> (TypeInfo -> RawBytes) -> RawBytes
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ -> Text -> ByteString
LT.encodeUtf16LE (Text -> ByteString) -> Maybe Text -> RawBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
t

instance Data (Maybe String) where
  fromRawBytes :: TypeInfo -> RawBytes -> Maybe String
fromRawBytes TypeInfo
ti RawBytes
rb = TypeInfo -> (TypeInfo -> Maybe String) -> Maybe String
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidString TypeInfo
ti ((TypeInfo -> Maybe String) -> Maybe String)
-> (TypeInfo -> Maybe String) -> Maybe String
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ -> Text -> String
LT.unpack (Text -> String) -> (ByteString -> Text) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
LT.decodeUtf16LE (ByteString -> String) -> RawBytes -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawBytes
rb 
  toRawBytes :: TypeInfo -> Maybe String -> RawBytes
toRawBytes TypeInfo
ti Maybe String
s = TypeInfo -> (TypeInfo -> RawBytes) -> RawBytes
forall a. TypeInfo -> (TypeInfo -> a) -> a
withValidString TypeInfo
ti ((TypeInfo -> RawBytes) -> RawBytes)
-> (TypeInfo -> RawBytes) -> RawBytes
forall a b. (a -> b) -> a -> b
$ \TypeInfo
_ -> Text -> ByteString
LT.encodeUtf16LE (Text -> ByteString) -> (String -> Text) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
LT.pack (String -> ByteString) -> Maybe String -> RawBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
s