module Nums.Fractionals
  (towardZero
  ,towardInf
  ,towardNegInf
  ,awayFromZero
  ,nearestTowardZero
  ,nearestTowardInf
  ,nearestTowardNegInf
  ,nearestAwayFromZero
  ,nearestBanker
  ,isHalf
  )
  where

{-# INLINE towardZero          #-}
{-# INLINE towardInf           #-}
{-# INLINE towardNegInf        #-}
{-# INLINE awayFromZero        #-}
{-# INLINE nearestTowardZero   #-}
{-# INLINE nearestTowardInf    #-}
{-# INLINE nearestTowardNegInf #-}
{-# INLINE nearestAwayFromZero #-}
{-# INLINE nearestBanker       #-}
{-# INLINE isHalf              #-}

-- | Round toward zero (truncate).
towardZero :: (Integral b, RealFrac a) => a -> b
towardZero = truncate

-- | Round upwards (ceiling).
towardInf :: (Integral b, RealFrac a) => a -> b
towardInf = ceiling

-- | Round backwards (floor).
towardNegInf :: (Integral b, RealFrac a) => a -> b
towardNegInf = floor

-- | Round away from zero (ceiling if positive, floor otherwise).
awayFromZero :: (Integral b, RealFrac a) => a -> b
awayFromZero v = if v > 0 then ceiling v else floor v

-- | Round torwards zero (if half go towards zero, otherwise up to 1).
nearestTowardZero :: (Integral b, RealFrac a) => a -> b
nearestTowardZero v = if isHalf v then towardZero   v else round v

-- | Same as "nearestTowardZero" but to infinity instead of zero.
nearestTowardInf :: (Integral b, RealFrac a) => a -> b
nearestTowardInf v = if isHalf v then towardInf    v else round v

-- | Same as "nearestTowardZero" but towards negative instead of zero.
nearestTowardNegInf :: (Integral b, RealFrac a) => a -> b
nearestTowardNegInf v = if isHalf v then towardNegInf v else round v

-- | Same as "nearestTowardZero" but rounds away from zero (by positive or negative).
nearestAwayFromZero :: (Integral b, RealFrac a) => a -> b
nearestAwayFromZero v = if isHalf v then awayFromZero v else round v

-- | Round up (round).
nearestBanker :: (Integral b, RealFrac a) => a -> b
nearestBanker = round

-- | Is a number x.5?
isHalf :: RealFrac a => a -> Bool
isHalf v = v - fromInteger (towardNegInf v) == 0.5