{-# OPTIONS_HADDOCK hide #-}
-- https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-tds/1266679d-cd6e-492a-b2b2-3a9ba004196d

module Database.Tds.Primitives.Money ( Money (..)
                                     , moneyToBytes4
                                     , moneyToBytes8
                                     , bytesToMoney4
                                     , bytesToMoney8
                                     ) where

import Data.Int (Int32(..))
import Data.Fixed (Fixed(..))
import Data.Bits ((.&.),shift)
import Database.Tds.Primitives.Fixed

newtype Money = Money Fixed4
              deriving (Int -> Money -> ShowS
[Money] -> ShowS
Money -> String
(Int -> Money -> ShowS)
-> (Money -> String) -> ([Money] -> ShowS) -> Show Money
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Money] -> ShowS
$cshowList :: [Money] -> ShowS
show :: Money -> String
$cshow :: Money -> String
showsPrec :: Int -> Money -> ShowS
$cshowsPrec :: Int -> Money -> ShowS
Show)

bytesToMoney4 :: Int32 -> Money
bytesToMoney4 :: Int32 -> Money
bytesToMoney4 Int32
i = Fixed4 -> Money
Money (Fixed4 -> Money) -> Fixed4 -> Money
forall a b. (a -> b) -> a -> b
$ Integer -> Fixed4
forall k (a :: k). Integer -> Fixed a
MkFixed (Integer -> Fixed4) -> Integer -> Fixed4
forall a b. (a -> b) -> a -> b
$ Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i

bytesToMoney8 :: Int32 -> Int32 -> Money
bytesToMoney8 :: Int32 -> Int32 -> Money
bytesToMoney8 Int32
m Int32
l =
  let
    m' :: Integer
m' = Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
m
    l' :: Integer
l' = Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
l
  in Fixed4 -> Money
Money (Fixed4 -> Money) -> Fixed4 -> Money
forall a b. (a -> b) -> a -> b
$ Integer -> Fixed4
forall k (a :: k). Integer -> Fixed a
MkFixed (Integer -> Fixed4) -> Integer -> Fixed4
forall a b. (a -> b) -> a -> b
$ (Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
shift Integer
m' Int
32) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
l'


moneyToBytes4 :: Money -> Int32
moneyToBytes4 :: Money -> Int32
moneyToBytes4 (Money (MkFixed Integer
i)) = Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i

moneyToBytes8 :: Money -> (Int32,Int32)
moneyToBytes8 :: Money -> (Int32, Int32)
moneyToBytes8 (Money (MkFixed Integer
i)) =
  let
    m :: Integer
m = Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
shift Integer
i (-Int
32)
    l :: Integer
l = Integer
i Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
0xffffffff
  in (Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
m, Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
l)