{-# OPTIONS_HADDOCK hide #-} -- 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 ) where import Data.Word (Word8(..)) import Data.Int (Int32(..)) import Data.Fixed (Fixed(..)) import Data.Bits ((.&.),(.|.),shift) import qualified Data.ByteString as B import Database.Tds.Primitives.Fixed type Precision = Word8 type Scale = Word8 precisionToLen :: Precision -> Word8 precisionToLen p = case p of _ | 1 <= p && p <= 9 -> 4 _ | 10 <= p && p <= 19 -> 8 _ | 20 <= p && p <= 28 -> 12 _ | 29 <= p && p <= 38 -> 16 _ -> error "precisionToLen: invalid Precision" -- [MEMO] Correctness is not sure... -- [TODO] Test data Decimal = DecimalS0 !Precision !Fixed0 | DecimalS1 !Precision !Fixed1 | DecimalS2 !Precision !Fixed2 | DecimalS3 !Precision !Fixed3 | DecimalS4 !Precision !Fixed4 | DecimalS5 !Precision !Fixed5 | DecimalS6 !Precision !Fixed6 | DecimalS7 !Precision !Fixed7 | DecimalS8 !Precision !Fixed8 | DecimalS9 !Precision !Fixed9 | DecimalS10 !Precision !Fixed10 | DecimalS11 !Precision !Fixed11 | DecimalS12 !Precision !Fixed12 | DecimalS13 !Precision !Fixed13 | DecimalS14 !Precision !Fixed14 | DecimalS15 !Precision !Fixed15 | DecimalS16 !Precision !Fixed16 | DecimalS17 !Precision !Fixed17 | DecimalS18 !Precision !Fixed18 | DecimalS19 !Precision !Fixed19 | DecimalS20 !Precision !Fixed20 | DecimalS21 !Precision !Fixed21 | DecimalS22 !Precision !Fixed22 | DecimalS23 !Precision !Fixed23 | DecimalS24 !Precision !Fixed24 | DecimalS25 !Precision !Fixed25 | DecimalS26 !Precision !Fixed26 | DecimalS27 !Precision !Fixed27 | DecimalS28 !Precision !Fixed28 | DecimalS29 !Precision !Fixed29 | DecimalS30 !Precision !Fixed30 | DecimalS31 !Precision !Fixed31 | DecimalS32 !Precision !Fixed32 | DecimalS33 !Precision !Fixed33 | DecimalS34 !Precision !Fixed34 | DecimalS35 !Precision !Fixed35 | DecimalS36 !Precision !Fixed36 | DecimalS37 !Precision !Fixed37 | DecimalS38 !Precision !Fixed38 deriving (Show) bytesToDecimal :: Precision -> Scale -> Word8 -> B.ByteString -> Decimal bytesToDecimal p s sign bs = let sign' = if sign == 0x01 then 1 else -1 i = bytesToInteger bs in integerToDecimal p 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 :: Precision -> Scale -> Integer -> Decimal integerToDecimal p s i = case s of 0 -> DecimalS0 p $ MkFixed i 1 -> DecimalS1 p $ MkFixed i 2 -> DecimalS2 p $ MkFixed i 3 -> DecimalS3 p $ MkFixed i 4 -> DecimalS4 p $ MkFixed i 5 -> DecimalS5 p $ MkFixed i 6 -> DecimalS6 p $ MkFixed i 7 -> DecimalS7 p $ MkFixed i 8 -> DecimalS8 p $ MkFixed i 9 -> DecimalS9 p $ MkFixed i 10 -> DecimalS10 p $ MkFixed i 11 -> DecimalS11 p $ MkFixed i 12 -> DecimalS12 p $ MkFixed i 13 -> DecimalS13 p $ MkFixed i 14 -> DecimalS14 p $ MkFixed i 15 -> DecimalS15 p $ MkFixed i 16 -> DecimalS16 p $ MkFixed i 17 -> DecimalS17 p $ MkFixed i 18 -> DecimalS18 p $ MkFixed i 19 -> DecimalS19 p $ MkFixed i 20 -> DecimalS20 p $ MkFixed i 21 -> DecimalS21 p $ MkFixed i 22 -> DecimalS22 p $ MkFixed i 23 -> DecimalS23 p $ MkFixed i 24 -> DecimalS24 p $ MkFixed i 25 -> DecimalS25 p $ MkFixed i 26 -> DecimalS26 p $ MkFixed i 27 -> DecimalS27 p $ MkFixed i 28 -> DecimalS28 p $ MkFixed i 29 -> DecimalS29 p $ MkFixed i 30 -> DecimalS30 p $ MkFixed i 31 -> DecimalS31 p $ MkFixed i 32 -> DecimalS32 p $ MkFixed i 33 -> DecimalS33 p $ MkFixed i 34 -> DecimalS34 p $ MkFixed i 35 -> DecimalS35 p $ MkFixed i 36 -> DecimalS36 p $ MkFixed i 37 -> DecimalS37 p $ MkFixed i 38 -> DecimalS38 p $ MkFixed i _ -> error "integerToDecimal: invalid scale" -- [MEMO] signed, little endian integerToBytes :: Word8 -> Integer -> B.ByteString integerToBytes len i = B.pack $ f len i where f :: Word8 -> Integer -> [Word8] f 0 _ = [] f len i = let (d,m) = divMod i 0xff in (fromIntegral m) : f (len-1) d decimalToBytes :: Decimal -> (Word8,B.ByteString) decimalToBytes dec = let (p,i) = int dec sign = if signum i == -1 then 0x00 else 0x01 bs = integerToBytes (precisionToLen p) $ abs i in (sign,bs) where int :: Decimal -> (Precision,Integer) int (DecimalS0 p (MkFixed i)) = (p,i) int (DecimalS1 p (MkFixed i)) = (p,i) int (DecimalS2 p (MkFixed i)) = (p,i) int (DecimalS3 p (MkFixed i)) = (p,i) int (DecimalS4 p (MkFixed i)) = (p,i) int (DecimalS5 p (MkFixed i)) = (p,i) int (DecimalS6 p (MkFixed i)) = (p,i) int (DecimalS7 p (MkFixed i)) = (p,i) int (DecimalS8 p (MkFixed i)) = (p,i) int (DecimalS9 p (MkFixed i)) = (p,i) int (DecimalS10 p (MkFixed i)) = (p,i) int (DecimalS11 p (MkFixed i)) = (p,i) int (DecimalS12 p (MkFixed i)) = (p,i) int (DecimalS13 p (MkFixed i)) = (p,i) int (DecimalS14 p (MkFixed i)) = (p,i) int (DecimalS15 p (MkFixed i)) = (p,i) int (DecimalS16 p (MkFixed i)) = (p,i) int (DecimalS17 p (MkFixed i)) = (p,i) int (DecimalS18 p (MkFixed i)) = (p,i) int (DecimalS19 p (MkFixed i)) = (p,i) int (DecimalS20 p (MkFixed i)) = (p,i) int (DecimalS21 p (MkFixed i)) = (p,i) int (DecimalS22 p (MkFixed i)) = (p,i) int (DecimalS23 p (MkFixed i)) = (p,i) int (DecimalS24 p (MkFixed i)) = (p,i) int (DecimalS25 p (MkFixed i)) = (p,i) int (DecimalS26 p (MkFixed i)) = (p,i) int (DecimalS27 p (MkFixed i)) = (p,i) int (DecimalS28 p (MkFixed i)) = (p,i) int (DecimalS29 p (MkFixed i)) = (p,i) int (DecimalS30 p (MkFixed i)) = (p,i) int (DecimalS31 p (MkFixed i)) = (p,i) int (DecimalS32 p (MkFixed i)) = (p,i) int (DecimalS33 p (MkFixed i)) = (p,i) int (DecimalS34 p (MkFixed i)) = (p,i) int (DecimalS35 p (MkFixed i)) = (p,i) int (DecimalS36 p (MkFixed i)) = (p,i) int (DecimalS37 p (MkFixed i)) = (p,i) int (DecimalS38 p (MkFixed i)) = (p,i)