{-
 - Copyright (C) 2009 Nick Bowler.
 -
 - License BSD2:  2-clause BSD license.  See LICENSE for full terms.
 - This is free software: you are free to change and redistribute it.
 - There is NO WARRANTY, to the extent permitted by law.
 -}

-- | Generic classes for floating point types.  The interface is loosely based
-- off of the C math library.
module Data.Floating.Classes where

import Prelude hiding (Floating(..), RealFloat(..), RealFrac(..), Ord(..))
import Data.Ratio
import Data.Poset

-- | Classification of floating point values.
data FPClassification = FPInfinite | FPNaN | FPNormal | FPSubNormal | FPZero
    deriving (Show, Read, Eq, Enum, Bounded)

-- | Class for types which can be rounded to integers.  The rounding functions
-- in the Prelude are inadequate for floating point because they shoehorn their
-- results into an integral type.
--
-- Minimal complete definition: 'toIntegral' and 'round'.
class (Fractional a, Poset a) => Roundable a where
    -- | Discards the fractional component from a value.  Results in 'Nothing'
    -- if the result cannot be represented as an integer, such as if the input
    -- is infinite or NaN.
    toIntegral :: Integral b => a -> Maybe b
    ceiling    :: a -> a
    floor      :: a -> a
    truncate   :: a -> a
    round      :: a -> a

    floor x
        | round x == x = x
        | otherwise = round $ x - fromRational (1%2)
    ceiling x
        | round x == x = x
        | otherwise = round $ x + fromRational (1%2)
    truncate x
        | x < 0 = ceiling x
        | x > 0 = floor x
        | otherwise = x

-- | Class for floating point types (real or complex-valued).
--
-- Minimal complete definition: everything.
class Fractional a => Floating a where
    (**)  :: a -> a -> a
    sqrt  :: a -> a
    acos  :: a -> a
    asin  :: a -> a
    atan  :: a -> a
    cos   :: a -> a
    sin   :: a -> a
    tan   :: a -> a
    acosh :: a -> a
    asinh :: a -> a
    atanh :: a -> a
    cosh  :: a -> a
    sinh  :: a -> a
    tanh  :: a -> a
    exp   :: a -> a
    log   :: a -> a

-- | Class for real-valued floating point types.
--
-- Minimal complete definition: all except 'pi', 'infinity' and 'nan'.
class Floating a => RealFloat a where
    fma       :: a -> a -> a -> a
    copysign  :: a -> a -> a
    nextafter :: a -> a -> a
    atan2     :: a -> a -> a
    fmod      :: a -> a -> a
    frem      :: a -> a -> a
    fquotRem  :: a -> a -> (Int, a)
    hypot     :: a -> a -> a
    cbrt      :: a -> a
    exp2      :: a -> a
    expm1     :: a -> a
    log10     :: a -> a
    log1p     :: a -> a
    log2      :: a -> a
    logb      :: a -> a
    erf       :: a -> a
    erfc      :: a -> a
    lgamma    :: a -> a
    tgamma    :: a -> a
    classify  :: a -> FPClassification
    infinity  :: a
    nan       :: a
    pi        :: a

    infinity = 1/0
    nan      = 0/0
    pi       = 4 * atan 1