{-# OPTIONS_HADDOCK hide #-}
module Database.Tds.Primitives.Decimal ( Precision (..)
, Scale (..)
, precisionToLen
, bytesToFixed
, fixedToBytes
) where
import Data.Monoid ((<>))
import Data.Word (Word8(..))
import Data.Fixed (Fixed(..),HasResolution(..))
import Data.Bits ((.|.),shift)
import qualified Data.ByteString as B
type Precision = Word8
type Scale = Word8
precisionToLen :: Precision -> Word8
precisionToLen :: Precision -> Precision
precisionToLen Precision
p =
case Precision
p of
Precision
_ | Precision
1 Precision -> Precision -> Bool
forall a. Ord a => a -> a -> Bool
<= Precision
p Bool -> Bool -> Bool
&& Precision
p Precision -> Precision -> Bool
forall a. Ord a => a -> a -> Bool
<= Precision
9 -> Precision
4
Precision
_ | Precision
10 Precision -> Precision -> Bool
forall a. Ord a => a -> a -> Bool
<= Precision
p Bool -> Bool -> Bool
&& Precision
p Precision -> Precision -> Bool
forall a. Ord a => a -> a -> Bool
<= Precision
19 -> Precision
8
Precision
_ | Precision
20 Precision -> Precision -> Bool
forall a. Ord a => a -> a -> Bool
<= Precision
p Bool -> Bool -> Bool
&& Precision
p Precision -> Precision -> Bool
forall a. Ord a => a -> a -> Bool
<= Precision
28 -> Precision
12
Precision
_ | Precision
29 Precision -> Precision -> Bool
forall a. Ord a => a -> a -> Bool
<= Precision
p Bool -> Bool -> Bool
&& Precision
p Precision -> Precision -> Bool
forall a. Ord a => a -> a -> Bool
<= Precision
38 -> Precision
16
Precision
_ -> [Char] -> Precision
forall a. HasCallStack => [Char] -> a
error [Char]
"precisionToLen: invalid Precision"
bytesToInteger :: B.ByteString -> Integer
bytesToInteger :: ByteString -> Integer
bytesToInteger = (Integer -> Precision -> Integer)
-> Integer -> ByteString -> Integer
forall a. (a -> Precision -> a) -> a -> ByteString -> a
B.foldl' Integer -> Precision -> Integer
forall a a. (Bits a, Integral a, Num a) => a -> a -> a
f Integer
0 (ByteString -> Integer)
-> (ByteString -> ByteString) -> ByteString -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B.reverse
where
f :: a -> a -> a
f a
a a
b = a
a a -> Int -> a
forall a. Bits a => a -> Int -> a
`shift` Int
8 a -> a -> a
forall a. Bits a => a -> a -> a
.|. a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
b
bytesToFixed :: (HasResolution a) => Word8 -> B.ByteString -> Fixed a
bytesToFixed :: Precision -> ByteString -> Fixed a
bytesToFixed Precision
sign ByteString
bs =
let
sign' :: Integer
sign' = if Precision
sign Precision -> Precision -> Bool
forall a. Eq a => a -> a -> Bool
== Precision
0x01 then Integer
1 else -Integer
1
i :: Integer
i = ByteString -> Integer
bytesToInteger ByteString
bs
in Integer -> Fixed a
forall k (a :: k). Integer -> Fixed a
MkFixed (Integer -> Fixed a) -> Integer -> Fixed a
forall a b. (a -> b) -> a -> b
$ Integer
sign' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
i
integerToBytes :: Word8 -> Integer -> B.ByteString
integerToBytes :: Precision -> Integer -> ByteString
integerToBytes Precision
len Integer
i = [Precision] -> ByteString
B.pack ([Precision] -> ByteString) -> [Precision] -> ByteString
forall a b. (a -> b) -> a -> b
$ Precision -> Integer -> [Precision]
f Precision
len Integer
i
where
f :: Word8 -> Integer -> [Word8]
f :: Precision -> Integer -> [Precision]
f Precision
0 Integer
_ = []
f Precision
len Integer
i =
let
(Integer
d,Integer
m) = Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
divMod Integer
i Integer
0x100
in (Integer -> Precision
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
m) Precision -> [Precision] -> [Precision]
forall a. a -> [a] -> [a]
: Precision -> Integer -> [Precision]
f (Precision
lenPrecision -> Precision -> Precision
forall a. Num a => a -> a -> a
-Precision
1) Integer
d
fixedToBytes :: (HasResolution a) => Precision -> Fixed a -> (Word8,B.ByteString)
fixedToBytes :: Precision -> Fixed a -> (Precision, ByteString)
fixedToBytes Precision
p (MkFixed Integer
i) =
let
sign :: Precision
sign = if Integer -> Integer
forall a. Num a => a -> a
signum Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== -Integer
1 then Precision
0x00 else Precision
0x01
bs :: ByteString
bs = Precision -> Integer -> ByteString
integerToBytes (Precision -> Precision
precisionToLen Precision
p) (Integer -> ByteString) -> Integer -> ByteString
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Num a => a -> a
abs Integer
i
in (Precision
sign,ByteString
bs)