ms-tds 0.3.0.1 → 0.4.0.0

raw patch · 5 files changed

+47/−141 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ms-tds.cabal +2/−2
• src/Database/Tds/Message.hs +0/−9
• src/Database/Tds/Message/DataStream.hs +27/−27
• src/Database/Tds/Primitives/Decimal.hs +12/−98
• src/Database/Tds/Primitives/Money.hs +6/−5

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: e73f8134a0778c8c83faddfeb4f635f7a931c6d2d51ff8069aae2428a0390f0a+-- hash: 39ad5bcc1d6b5813f6dc3250a9265ff3720a2d22df6fea325640a0185540a0ab  name:           ms-tds-version:        0.3.0.1+version:        0.4.0.0 synopsis:       TDS Protocol implemented in Haskell description:    Please see the README on GitHub at <https://github.com/mitsuji/ms-tds#readme> category:       Database

@@ -125,16 +125,7 @@                                                          , Precision (..)                             , Scale (..)-                            , Decimal (..)                             , Money (..)-                            , decimal0,decimal1,decimal2,decimal3,decimal4-                            , decimal5,decimal6,decimal7,decimal8,decimal9-                            , decimal10,decimal11,decimal12,decimal13,decimal14-                            , decimal15,decimal16,decimal17,decimal18,decimal19-                            , decimal20,decimal21,decimal22,decimal23,decimal24-                            , decimal25,decimal26,decimal27,decimal28,decimal29-                            , decimal30,decimal31,decimal32,decimal33,decimal34-                            , decimal35,decimal36,decimal37,decimal38                                                          , Collation (..)                             , Collation32 (..)

@@ -34,6 +34,8 @@ 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@@ -669,26 +671,30 @@   -withValidDecimal :: TypeInfo -> (TypeInfo -> a) -> a-withValidDecimal  = f+++++withValidFixed :: TypeInfo -> (TypeInfo -> a) -> a+withValidFixed  = f   where     f :: TypeInfo -> (TypeInfo -> a) -> a     f ti@(TIDecimalN _ _) g = g ti     f ti@(TINumericN _ _) g = g ti-    f ti _ = error $ "withValidDecimal: " <> (show ti) <> " is not convertible from/to Decimal"+    f ti _ = error $ "withValidFixed: " <> (show ti) <> " is not convertible from/to Fixed"  -- https://msdn.microsoft.com/en-us/library/ee780893.aspx -- [MEMO] sign byte + signed bytes-getDecimal :: Int -> Scale -> Get Decimal-getDecimal len s = -  bytesToDecimal s <$> Get.getWord8 <*> (Get.getByteString $ fromIntegral $ len -1)+getFixed :: (HasResolution a) => Int -> Get (Fixed a)+getFixed len =+  bytesToFixed <$> Get.getWord8 <*> (Get.getByteString $ fromIntegral $ len -1) -putDecimal :: TypeInfo -> Decimal -> Put-putDecimal (TIDecimalN p _) dec = do -- [TODO] test-  let (s,bs) = decimalToBytes p dec+putFixed :: (HasResolution a) => TypeInfo -> Fixed a -> Put+putFixed (TIDecimalN p _) f = do -- [TODO] test+  let (s,bs) = fixedToBytes p f   Put.putWord8 s   Put.putByteString bs-putDecimal (TINumericN p s) dec = putDecimal (TIDecimalN p s) dec+putFixed (TINumericN p s) f = putFixed (TIDecimalN p s) f   @@ -801,15 +807,12 @@   fromRawBytes ti Nothing = withValidDouble ti $ \_ -> error "Double.fromRawBytes: Null value is not convertible to Double"   toRawBytes ti f = withValidDouble ti $ \vt -> Just $ runPut $ putFloat vt f -instance Data Decimal where-  fromRawBytes ti (Just bs) = withValidDecimal ti $ \vt ->-    runGet (getDecimal (fromIntegral $ LB.length bs) (scale vt)) bs-    where-      scale :: TypeInfo -> Scale-      scale (TIDecimalN _ s) = s-      scale (TINumericN _ s) = s-  fromRawBytes ti Nothing = withValidDecimal ti $ \_ -> error "Decimal.fromRawBytes: Null value is not convertible to Decimal"-  toRawBytes ti dec = withValidDecimal ti $ \_ -> Just $ runPut $ putDecimal ti dec++instance (HasResolution a) => Data (Fixed a) where+  fromRawBytes ti (Just bs) = withValidFixed ti $ \vt ->+    runGet (getFixed (fromIntegral $ LB.length bs)) bs+  fromRawBytes ti Nothing = withValidFixed ti $ \_ -> error "Fixed.fromRawBytes: Null value is not convertible to Fixed"+  toRawBytes ti f = withValidFixed ti $ \_ -> Just $ runPut $ putFixed ti f      instance Data UUID where   fromRawBytes ti (Just bs) = withValidUUID ti $ \_ -> case UUID.fromByteString bs of@@ -894,14 +897,11 @@                       Nothing | (not . isFloatN) vt -> error $ "(Maybe Double).toRawBytes: Nothing is not convertible to " <> (show vt)                       _ -> runPut . (putFloat vt) <$> f -instance Data (Maybe Decimal) where-  fromRawBytes ti rb = withValidDecimal ti $ \vt ->-    (\bs -> runGet (getDecimal (fromIntegral $ LB.length bs) (scale vt)) bs) <$> rb-    where-      scale :: TypeInfo -> Scale-      scale (TIDecimalN _ s) = s-      scale (TINumericN _ s) = s-  toRawBytes ti dec = withValidDecimal ti $ \_ -> runPut . putDecimal ti <$>  dec++instance (HasResolution a) => Data (Maybe (Fixed a)) where+  fromRawBytes ti rb = withValidFixed ti $ \vt ->+    (\bs -> runGet (getFixed (fromIntegral $ LB.length bs)) bs) <$> rb+  toRawBytes ti f = withValidFixed ti $ \_ -> runPut . putFixed ti <$> f  instance Data (Maybe UUID) where   fromRawBytes ti rb = withValidUUID ti $ \_ -> f <$> rb

@@ -1,35 +1,19 @@ {-# OPTIONS_HADDOCK hide #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE TemplateHaskell #-} -- https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-tds/5e02042c-a741-4b5a-b91d-af5e236c5252  module Database.Tds.Primitives.Decimal ( Precision (..)                                        , Scale (..)-                                       , Decimal (..)                                        , precisionToLen-                                       , bytesToDecimal-                                       , decimalToBytes-                                       , decimal0,decimal1,decimal2,decimal3,decimal4-                                       , decimal5,decimal6,decimal7,decimal8,decimal9-                                       , decimal10,decimal11,decimal12,decimal13,decimal14-                                       , decimal15,decimal16,decimal17,decimal18,decimal19-                                       , decimal20,decimal21,decimal22,decimal23,decimal24-                                       , decimal25,decimal26,decimal27,decimal28,decimal29-                                       , decimal30,decimal31,decimal32,decimal33,decimal34-                                       , decimal35,decimal36,decimal37,decimal38+                                       , bytesToFixed+                                       , fixedToBytes                                        ) where  import Data.Monoid ((<>)) import Data.Word (Word8(..))-import Data.Int (Int32(..))-import Data.Fixed (Fixed(..))-import Data.Bits ((.&.),(.|.),shift)+import Data.Fixed (Fixed(..),HasResolution(..))+import Data.Bits ((.|.),shift) import qualified Data.ByteString as B-import Database.Tds.Primitives.Fixed -import Language.Haskell.TH-import Language.Haskell.TH.Syntax (returnQ)- type Precision = Word8 type Scale = Word8 @@ -44,59 +28,19 @@     _ -> error "precisionToLen: invalid Precision"  --- data Decimal = DecimalS0 !Fixed0---             ...---             | DecimalS38 !Fixed38---             deriving (Show)-#if MIN_VERSION_template_haskell(2,12,0)-returnQ [-  DataD [] (mkName "Decimal") [] Nothing-  ((flip map) [0..38] $ \i -> NormalC (mkName $ "DecimalS" <> show i) [(Bang NoSourceUnpackedness SourceStrict,ConT (mkName $ "Fixed" <> show i))] )-  [DerivClause Nothing [ConT ''Show]]-  ]-#elif MIN_VERSION_template_haskell(2,11,0)-returnQ [-  DataD [] (mkName "Decimal") [] Nothing-  ((flip map) [0..38] $ \i -> NormalC (mkName $ "DecimalS" <> show i) [(Bang NoSourceUnpackedness SourceStrict,ConT (mkName $ "Fixed" <> show i))] )-  [ConT ''Show]-  ]-#else-returnQ [-  DataD [] (mkName "Decimal") []-  ((flip map) [0..38] $ \i -> NormalC (mkName $ "DecimalS" <> show i) [(IsStrict,ConT (mkName $ "Fixed" <> show i))] )-  [''Show]-  ]-#endif --bytesToDecimal :: Scale -> Word8 -> B.ByteString -> Decimal-bytesToDecimal s sign bs =-  let-    sign' = if sign == 0x01 then 1 else -1-    i = bytesToInteger bs-  in integerToDecimal s $ sign' * i-- -- [MEMO] signed, little endian bytesToInteger :: B.ByteString -> Integer bytesToInteger = B.foldl' f 0 . B.reverse   where     f a b = a `shift` 8 .|. fromIntegral b -integerToDecimal :: Scale -> Integer -> Decimal-integerToDecimal s i =---  case s of---    0 -> DecimalS0 $ MkFixed i---    ...---    38 -> DecimalS38 $ MkFixed i---    _ -> error "integerToDecimal: invalid scale"-  $(returnQ $ CaseE (VarE 's) $-     (-       (flip map) [0..38] $ \j ->-         Match (LitP $ IntegerL j) (NormalB $ AppE (ConE $ mkName $ "DecimalS" <> show j) $ AppE (ConE $ mkName "MkFixed") (VarE 'i) ) []-     )-     <> [Match WildP (NormalB $ AppE (VarE 'error) (LitE $ StringL "integerToDecimal: invalid scale")) []]-   )+bytesToFixed :: (HasResolution a) => Word8 -> B.ByteString -> Fixed a+bytesToFixed sign bs =+  let+    sign' = if sign == 0x01 then 1 else -1+    i = bytesToInteger bs+  in MkFixed $ sign' * i   @@ -112,41 +56,11 @@       in (fromIntegral m) : f (len-1) d  ---    int :: Decimal -> Integer---    int (DecimalS0  (MkFixed i)) = i---    ...---    int (DecimalS38 (MkFixed i)) = i-returnQ [-  (FunD $ mkName "int")-  $ (flip map) [0..38] $ \j->-      Clause [ConP (mkName $ "DecimalS" <> show j) [ConP (mkName "MkFixed") [VarP $ mkName "i"]]]-      (NormalB $ VarE $ mkName "i")-      []-  ]--decimalToBytes :: Precision -> Decimal -> (Word8,B.ByteString)-decimalToBytes p dec =+fixedToBytes :: (HasResolution a) => Precision -> Fixed a -> (Word8,B.ByteString)+fixedToBytes p (MkFixed i) =   let-    i = int dec     sign = if signum i == -1 then 0x00 else 0x01     bs = integerToBytes (precisionToLen p) $ abs i   in (sign,bs)------ decimal0 :: Decimal -> Fixed0--- decimal0 (DecimalS0 f) = f--- decimal0 _ = error "decimal0: scale mismatch"-returnQ $ (flip map) [0..38] $ \i ->-  (FunD $ mkName $ "decimal" <> show i)-  [-    Clause [ConP (mkName $ "DecimalS" <> show i) [VarP $ mkName "f"]]-    (NormalB $ VarE $ mkName "f")-    []-  ,-    Clause [WildP]-    (NormalB $ AppE (VarE 'error) (LitE $ StringL $ "decimal" <> show i <> ": scale mismatch"))-    []-  ]  

@@ -13,24 +13,25 @@ import Data.Bits ((.&.),shift) import Database.Tds.Primitives.Fixed -type Money = Fixed4+newtype Money = Money Fixed4+              deriving (Show)  bytesToMoney4 :: Int32 -> Money-bytesToMoney4 i = MkFixed $ fromIntegral i+bytesToMoney4 i = Money $ MkFixed $ fromIntegral i  bytesToMoney8 :: Int32 -> Int32 -> Money bytesToMoney8 m l =   let     m' = fromIntegral m     l' = fromIntegral l-  in MkFixed $ (shift m' 32) + l'+  in Money $ MkFixed $ (shift m' 32) + l'   moneyToBytes4 :: Money -> Int32-moneyToBytes4 (MkFixed i) = fromIntegral i+moneyToBytes4 (Money (MkFixed i)) = fromIntegral i  moneyToBytes8 :: Money -> (Int32,Int32)-moneyToBytes8 (MkFixed i) =+moneyToBytes8 (Money (MkFixed i)) =   let     m = shift i (-32)     l = i .&. 0xffffffff