module Data.BCD.Packed (
bytesRequired,
packInteger,
unpackInteger,
packDecimal,
unpackDecimal ) where
import Data.Word
import Data.Bits
import qualified Data.ByteString as BS
import Data.Decimal (Decimal, DecimalRaw(Decimal), decimalMantissa, decimalPlaces, roundTo)
import Data.Digits (digits)
import Data.List.Split (splitEvery)
packByte :: [Word8] -> Word8
packByte [m, l] = (shiftL m 4) .|. l
packBytes :: [Word8] -> BS.ByteString
packBytes bx = BS.pack $ map packByte $ splitEvery 2 bx
unpackByte :: Word8 -> [Word8]
unpackByte b = [shiftR (b .&. 0xf0) 4, b .&. 0x0f]
unpackBytes :: BS.ByteString -> BS.ByteString
unpackBytes bs = BS.concatMap (\b -> BS.pack $ unpackByte b) bs
encodeSign :: Integer -> Word8
encodeSign s
| s < 0 = 0xd
| otherwise = 0xc
decodeSign :: Word8 -> Integer
decodeSign n = case n of
0xc -> 1
0xd -> 1
otherwise -> error "Unsupported sign value"
bytesRequired :: Int
-> Int
bytesRequired l = ceiling (((fromIntegral l) + 1) / 2)
packInteger :: Int
-> Integer
-> BS.ByteString
packInteger l n
| dsl > l = error "Number is to large for field"
| otherwise = packBytes $ (replicate (nl dsl 1) 0) ++ ds ++ [s]
where ds = map (\d -> fromIntegral d) (digits 10 (abs n))
s = encodeSign (signum n)
nl = (bytesRequired l) * 2
dsl = length ds
unpackInteger :: BS.ByteString
-> Integer
unpackInteger bs = n * s
where ubs = unpackBytes bs
n = BS.foldl (\n d -> (n * 10) + (toInteger d)) 0 $ BS.init ubs
s = decodeSign $ BS.last ubs
packDecimal :: Int
-> Word8
-> Decimal
-> BS.ByteString
packDecimal l d n
| (decimalPlaces n) > d = error "Decimal places to large for field"
| otherwise = packInteger l $ decimalMantissa $ roundTo d n
unpackDecimal :: Word8
-> BS.ByteString
-> Decimal
unpackDecimal d bs = Decimal d $ unpackInteger bs