Packed.hs

{- |
Module      :  Data.BCD.Packed
Copyright   :  Andrew Kay, 2012
License:    :  MIT

Maintainer  :  andrewjkay@gmail.com
Stability   :  experimental
Portability :  portable

A module containing packed binary-coded decimal (BCD) serialization functions
-}

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)

-- | Pack two digits into a byte
packByte :: [Word8] -> Word8
packByte [m, l] = (shiftL m 4) .|. l

-- | Pack every pair of two digits into a byte resulting in a ByteString half as long as
--   the input
packBytes :: [Word8] -> BS.ByteString
packBytes bx = BS.pack $ map packByte $ splitEvery 2 bx

-- | Unpack two digits from a byte
unpackByte :: Word8 -> [Word8]
unpackByte b = [shiftR (b .&. 0xf0) 4, b .&. 0x0f]

-- | Unpack two digits from every byte in a ByteString resulting in a new ByteString twice
--   as long as the input
unpackBytes :: BS.ByteString -> BS.ByteString
unpackBytes bs = BS.concatMap (\b -> BS.pack $ unpackByte b) bs

-- | Encode the sign
encodeSign :: Integer -> Word8
encodeSign s
    | s < 0     = 0xd
    | otherwise = 0xc

-- | Decode the sign
decodeSign :: Word8 -> Integer
decodeSign n = case n of
    0xc -> 1
    0xd -> -1
    otherwise -> error "Unsupported sign value"

-- | Calculate the bytes required to store a number of digits
bytesRequired :: Int    -- ^ Number of digits (including leading zeros)
              -> Int    -- ^ Number of bytes required
bytesRequired l = ceiling (((fromIntegral l) + 1) / 2)

-- | Pack an Integer into a ByteString
packInteger :: Int              -- ^ Number of digits (including leading zeros)
            -> Integer          -- ^ Value 
            -> BS.ByteString    -- ^ Packed BCD
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

-- | Unpack an Integer from a ByteString
unpackInteger :: BS.ByteString    -- ^ Packed BCD
              -> Integer          -- ^ Value
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

-- | Pack a Decimal into a ByteString
packDecimal :: Int              -- ^ Number of digits (including leading zeros and decimal places)
            -> Word8            -- ^ Number of decimal places
            -> Decimal          -- ^ Value
            -> BS.ByteString    -- ^ Packed BCD
packDecimal l d n
    | (decimalPlaces n) > d = error "Decimal places to large for field"
    | otherwise = packInteger l $ decimalMantissa $ roundTo d n

-- | Unpack a Decimal from a ByteString
unpackDecimal :: Word8            -- ^ Number of decimal places
              -> BS.ByteString    -- ^ Packed BCD
              -> Decimal          -- ^ Value
unpackDecimal d bs = Decimal d $ unpackInteger bs