{-# 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 :: Word8 -> Word8
precisionToLen Word8
p =
  case Word8
p of
    Word8
_ | Word8
1  Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
p Bool -> Bool -> Bool
&& Word8
p Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
9  -> Word8
4
    Word8
_ | Word8
10 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
p Bool -> Bool -> Bool
&& Word8
p Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
19 -> Word8
8
    Word8
_ | Word8
20 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
p Bool -> Bool -> Bool
&& Word8
p Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
28 -> Word8
12
    Word8
_ | Word8
29 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
p Bool -> Bool -> Bool
&& Word8
p Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
38 -> Word8
16
    Word8
_ -> [Char] -> Word8
forall a. HasCallStack => [Char] -> a
error [Char]
"precisionToLen: invalid Precision"



-- [MEMO] signed, little endian
bytesToInteger :: B.ByteString -> Integer
bytesToInteger :: ByteString -> Integer
bytesToInteger = (Integer -> Word8 -> Integer) -> Integer -> ByteString -> Integer
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl' Integer -> Word8 -> 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 :: forall a. HasResolution a => Word8 -> ByteString -> Fixed a
bytesToFixed Word8
sign ByteString
bs =
  let
    sign' :: Integer
sign' = if Word8
sign Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
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 :: Word8 -> Integer -> ByteString
integerToBytes Word8
len Integer
i = [Word8] -> ByteString
B.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ Word8 -> Integer -> [Word8]
f Word8
len Integer
i
  where
    f :: Word8 -> Integer -> [Word8]
    f :: Word8 -> Integer -> [Word8]
f Word8
0 Integer
_ = []
    f Word8
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 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
m) Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: Word8 -> Integer -> [Word8]
f (Word8
lenWord8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
-Word8
1) Integer
d


fixedToBytes :: (HasResolution a) => Precision -> Fixed a -> (Word8,B.ByteString)
fixedToBytes :: forall a.
HasResolution a =>
Word8 -> Fixed a -> (Word8, ByteString)
fixedToBytes Word8
p (MkFixed Integer
i) =
  let
    sign :: Word8
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 Word8
0x00 else Word8
0x01
    bs :: ByteString
bs = Word8 -> Integer -> ByteString
integerToBytes (Word8 -> Word8
precisionToLen Word8
p) (Integer -> ByteString) -> Integer -> ByteString
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Num a => a -> a
abs Integer
i
  in (Word8
sign,ByteString
bs)