{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MagicHash #-}
module Data.Word12.Internal where

import GHC.Enum
import GHC.Arr

import Data.Bits
import Data.Word
import Data.Monoid
import Data.ByteString.Lazy.Builder

newtype Word12 = W12# Word16
  deriving (Eq, Ord, Real, Integral)
-- ^ 12-bit unsigned integer type

narrow12Word :: Word16 -> Word16
narrow12Word a = 0xfff .&. a

instance Num Word12 where
  W12# x + W12# y = W12# $ narrow12Word $ x + y
  W12# x * W12# y = W12# $ narrow12Word $ x * y
  W12# x - W12# y = W12# $ narrow12Word $ x - y
  negate (W12# x) = W12# $ narrow12Word $ negate x
  abs    (W12# x) = W12# $ narrow12Word $ abs x
  signum (W12# x) = W12# $ narrow12Word $ signum x
  fromInteger i   = W12# $ narrow12Word $ fromInteger i

instance Bounded Word12 where
  maxBound = 0xfff
  minBound = 0x000

instance Bits Word12 where
  W12# x .&. W12# y   = W12# $ x .&. y
  W12# x .|. W12# y   = W12# $ x .|. y
  W12# x `xor` W12# y = W12# $ x `xor` y
  complement x = x `xor` maxBound
  shift (W12# x) i
    | i >= 0    = W12# $ narrow12Word $ shiftL x i
    | otherwise = W12# $ shiftR x (-i)
  bitSize _ = 12
  popCount (W12# x) = popCount x
  bit = bitDefault
  isSigned _ = False
  testBit = testBitDefault
  rotate w i
    | r == 0 = w
    | otherwise = w `shiftL` r .|. w `shiftR` (12 - r)
    where
      r = i `mod` 12

#if MIN_VERSION_base(4,7,0)
  bitSizeMaybe _ = Just 12
#endif

instance Enum Word12 where
  succ x
    | x /= maxBound  = x + 1
    | otherwise      = succError "Word12"
  pred x
    | x /= minBound  = x - 1
    | otherwise      = predError "Word12"
  toEnum i
    | i >= 0 && i <= 0xfff
                     = W12# $ toEnum i
    | otherwise      = toEnumError "Word12" i (0, 0xfff :: Word16)
  fromEnum (W12# x)  = fromEnum x
  enumFrom           = boundedEnumFrom
  enumFromThen       = boundedEnumFromThen

#if MIN_VERSION_base(4,7,0)
instance FiniteBits Word12 where
  finiteBitSize _ = 12
#endif

instance Show Word12 where
  show (W12# x) = show x

instance Read Word12 where
  readsPrec i s = [(fromIntegral (x :: Int), r) | (x, r) <- readsPrec i s]

instance Ix Word12 where
  range       (x, y)   = [x..y]
  unsafeIndex (x, _) z = fromIntegral $ z - x
  inRange     (x, y) z = x <= z && z <= y

-- | Serialize a list of Word12s in little endian format.
--
-- >>> fromWord12sle [0x123, 0x456]
-- [0x23, 0x61, 0x45]
-- >>> fromWord12sle [0x123]
-- [0x23, 0x01]
-- >>> fromWord12sle [0x023]
-- [0x23, 0x00]
fromWord12sle :: [Word12] -> Builder
fromWord12sle = go
  where
    go (w12 : v12 : ws) = word8 w8
      <> word8 (w4 .|. v4)
      <> word8 v8
      <> go ws
      where
        (w4, w8) = split4'8 w12
        (v8, v4) = split8'4 v12
    go [w12] = word8 w8 <> word8 w4
      where
        (w4, w8) = split4'8 w12
    go [] = mempty
{-# INLINE fromWord12sle #-}

-- | Serialize a list of Word12s in big endian format.
--
-- >>> fromWord12sbe [0x123, 0x456]
-- [0x12, 0x34, 0x56]
-- >>> fromWord12sbe [0x123]
-- [0x12, 0x30]
-- >>> fromWord12sbe [0x120]
-- [0x12, 0x00]
fromWord12sbe :: [Word12] -> Builder
fromWord12sbe = go
  where
    go (w12 : v12 : ws) = word8 w8
      <> word8 (w4 .|. v4)
      <> word8 v8
      <> go ws
      where
        (w8, w4) = split8'4 w12
        (v4, v8) = split4'8 v12
    go [w12] = word8 w8 <> word8 w4
      where
        (w8, w4) = split8'4 w12
    go [] = mempty
{-# INLINE fromWord12sbe #-}

split4'8 :: Word12 -> (Word8, Word8)
split4'8 w12 = (w4, w8)
  where
    w4 = fromIntegral $ shiftR (w12 .&. 0xf00) 8
    w8 = fromIntegral $ w12 .&. 0x0ff
{-# INLINE split4'8 #-}

split8'4 :: Word12 -> (Word8, Word8)
split8'4 w12 = (w8, w4)
  where
    w4 = fromIntegral $ shiftL (w12 .&. 0x00f) 4
    w8 = fromIntegral $ shiftR (w12 .&. 0xff0) 4
{-# INLINE split8'4 #-}