module IPS.Word24 (Word24) where

import Data.Word
import Data.Maybe
import Data.Bits


newtype Word24 = W24 Word32
  deriving newtype (Eq, Ord, Show)

maxW24I :: Int
maxW24I = 0xFFFFFF

maxW24 :: Word32
maxW24 = 0xFFFFFF

mkW24 :: Word32 -> Word24
mkW24 x = W24 $ x .&. maxW24

instance Read Word24 where
  readsPrec d str = mapMaybe isW24 $ readsPrec d str where
    isW24 (x, r) | x <= maxW24 = Just (W24 x, r)
                 | otherwise   = Nothing

instance Bounded Word24 where
  minBound = W24 0
  maxBound = W24 maxW24

instance Enum Word24 where
  succ (W24 x) | x >= maxW24 = error "succ @Word24: maxBound"
               | otherwise   = W24 $ succ x

  pred (W24 x) | x <= 0    = error "pred @Word24: 0"
               | otherwise = W24 $ pred x

  toEnum x | x >= 0 && x <= maxW24I = W24 $ fromIntegral x
           | otherwise              = error "toEnum @Word24: out of range"

  fromEnum (W24 x) = fromEnum x

instance Num Word24 where
  (+) = clamp2 (+)
  (*) = clamp2 (*)
  (-) = clamp2 (-)

  abs            = id
  signum (W24 x) = mkW24 $ signum x
  fromInteger x  = mkW24 $ fromInteger x

instance Real Word24 where
  toRational (W24 x) = toRational x

instance Integral Word24 where
  W24 x `quotRem` W24 y = let (q, r) = x `quotRem` y in (mkW24 q, mkW24 r)
  toInteger (W24 x) = toInteger x

instance Bits Word24 where
  (.&.) = clamp2 (.&.)
  (.|.) = clamp2 (.|.)
  xor   = clamp2 xor

  complement = clamp1 complement

  shift (W24 x) i = mkW24 $ shift x i

  rotate x       0 = x
  rotate (W24 x) i = mkW24 $ (x `shiftL` i) .|. (x `shiftR` (24 - i))

  bitSize      = finiteBitSize
  bitSizeMaybe = Just . finiteBitSize
  isSigned _   = False

  testBit = testBitDefault
  bit     = bitDefault

  popCount (W24 x) = popCount x

instance FiniteBits Word24 where
  finiteBitSize _ = 24


clamp1 :: (Word32 -> Word32) -> (Word24 -> Word24)
clamp1 f (W24 x) = mkW24 $ f x

clamp2 :: (Word32 -> Word32 -> Word32) -> (Word24 -> Word24 -> Word24)
clamp2 (·) (W24 x) (W24 y) = mkW24 $ x · y