{-# OPTIONS_HADDOCK hide #-}
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"
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
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"
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)