{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Boopadoop.Discrete where

import Data.Int
import Data.Bits

-- | @'Discrete' x@ represents @x/'discFactor'@ as a floating point number in [-1,1].
newtype Discrete = Discrete {unDiscrete :: Int32} deriving (Eq,Ord)

instance Show Discrete where
  show (Discrete x) = "Discrete {unDiscrete = " ++ show x ++ ", value = " ++ show (fromIntegral x / discFactor :: Double) ++ "}"

-- | Breaks when the double is not in [-1,1]
doubleToDiscrete :: Double -> Discrete
doubleToDiscrete x = Discrete . properFloor $ x * discFactor

-- | Convert @'Discrete'@ to the @'Double'@ it represents.
discreteToDouble :: Discrete -> Double
discreteToDouble (Discrete x) = fromIntegral x / discFactor

-- | This is the conversion factor between the internal value of a @'Discrete'@ and the value it represents.
discFactor :: Num a => a
discFactor = fromIntegral $ (maxBound :: Int32)

-- | Round toward zero
properFloor :: RealFrac a => a -> Int32
properFloor x = if x >= 0 then floor x else ceiling x
--properFloor = floor

instance Num Discrete where
  (Discrete a) + (Discrete b) = Discrete $ let s = a + b in if signum a == signum b && signum a /= signum s then error ("Discrete overflow! " ++ show (Discrete a) ++ " + " ++ show (Discrete b) ++ " /= " ++ show (Discrete s)) else s
  a - b = a + negate b
  (*) = multiplyDiscrete --(Discrete a) * (Discrete b) = Discrete . properFloor $ ((fromIntegral a / discFactor :: Double) * (fromIntegral b :: Double))
  negate (Discrete a) = Discrete (negate a)
  abs (Discrete a) = Discrete (abs a)
  signum (Discrete a) = Discrete (signum a)
  fromInteger i = if i `elem` [-1,0,1]
    then Discrete $ discFactor * (fromInteger i :: Int32)
    else error $ "(fromInteger " ++ show i ++ " :: Discrete)"

-- | Perform fast @'Discrete'@ multiplication.
multiplyDiscrete :: Discrete -> Discrete -> Discrete
multiplyDiscrete (Discrete a) (Discrete b) = let m = Discrete . fromIntegral $ ((fromIntegral a :: Int64) * (fromIntegral b :: Int64)) `div` (discFactor + 1) in if signum m /= 0 && signum a * signum b /= signum (unDiscrete m) then error ("Discrete multiply overflow!! " ++ show (Discrete a) ++ " * " ++ show (Discrete b) ++ " /= " ++ show m) else m

instance Fractional Discrete where
  (Discrete a) / (Discrete b) = let d = Discrete . fromIntegral $ ((fromIntegral a :: Int64) * (discFactor + 1)) `div` fromIntegral b in if signum d /= 0 && signum a * signum b /= signum (unDiscrete d) then error ("Discrete division overflow!! " ++ show (Discrete a) ++ " / " ++ show (Discrete b) ++ " /= " ++ show d) else d
  fromRational r = if r <= 1 && r >= -1
    then Discrete . properFloor $ discFactor * r
    else error $ "(fromRational " ++ show r ++ " :: Discrete)"

instance Bounded Discrete where
  minBound = -1
  maxBound = 1

-- | Make a function of doubles a function of discretes
disguise :: (Double -> Double) -> Discrete -> Discrete
disguise f (Discrete x) = Discrete . properFloor $ f (fromIntegral x / discFactor :: Double) * discFactor

-- | A discrete representation of time. See @'Boopadoop.tickTable'@ for the sampling rate.
newtype Tick = Tick {unTick :: Int32} deriving (Enum,Num,Ord,Eq,Real,Integral)

instance Show Tick where
  show (Tick a) = "Tick[" ++ show a ++ "]"

--cisDiscrete :: Double -> Complex Discrete
--cisDiscrete t = let (a :+ b) = cis t in doubleToDiscrete a :+ doubleToDiscrete b