{-# 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 (..)
                                       , 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"



-- [MEMO] signed, little endian
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



-- [MEMO] signed, little endian
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)