Rounding.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE Rank2Types #-}
{-# OPTIONS_HADDOCK not-home #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Numeric.Rounded.Rounding
-- Copyright   :  (C) 2012-2014 Edward Kmett
-- License     :  BSD3
-- Maintainer  :  Claude Heiland-Allen <claude@mathr.co.uk>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Various rounding modes
----------------------------------------------------------------------------
module Numeric.Rounded.Rounding
  ( Rounding(..)
  , RoundingMode(..)
  , reifyRounding
  ) where

import Data.Data

import Numeric.MPFR.Types

data RoundingMode
  = TowardNearestWithTiesAwayFromZero -- ^ currently unsupported placeholder
  | TowardNearest -- ^ roundTiesToEven in IEEE 754-2008
  | TowardZero    -- ^ roundTowardZero in IEEE 754-2008
  | TowardInf     -- ^ roundTowardPositive in IEEE 754-2008
  | TowardNegInf  -- ^ roundTowardNegative in IEEE 754-2008
  | AwayFromZero  -- ^ round away from zero
  | Faithfully    -- ^ currently unsupported placeholder
  deriving (Eq,Ord,Show,Read,Data,Typeable)

class Rounding (r :: RoundingMode) where rounding :: Proxy r -> RoundingMode
instance Rounding TowardNearest where rounding _ = TowardNearest
instance Rounding TowardZero    where rounding _ = TowardZero
instance Rounding TowardInf     where rounding _ = TowardInf
instance Rounding TowardNegInf  where rounding _ = TowardNegInf
instance Rounding AwayFromZero  where rounding _ = AwayFromZero
instance Rounding Faithfully    where rounding _ = Faithfully
instance Rounding TowardNearestWithTiesAwayFromZero where rounding _ = TowardNearestWithTiesAwayFromZero

instance Enum RoundingMode where
  toEnum MPFR_RNDNA = TowardNearestWithTiesAwayFromZero
  toEnum MPFR_RNDN = TowardNearest
  toEnum MPFR_RNDZ = TowardZero
  toEnum MPFR_RNDU = TowardInf
  toEnum MPFR_RNDD = TowardNegInf
  toEnum MPFR_RNDA = AwayFromZero
  toEnum MPFR_RNDF = Faithfully
  toEnum _ = error "out of range"

  fromEnum TowardNearestWithTiesAwayFromZero = MPFR_RNDNA
  fromEnum TowardNearest = MPFR_RNDN
  fromEnum TowardZero = MPFR_RNDZ
  fromEnum TowardInf = MPFR_RNDU
  fromEnum TowardNegInf = MPFR_RNDD
  fromEnum AwayFromZero = MPFR_RNDA
  fromEnum Faithfully = MPFR_RNDF

instance Bounded RoundingMode where
  minBound = TowardNearestWithTiesAwayFromZero
  maxBound = Faithfully

reifyRounding :: RoundingMode -> (forall s. Rounding s => Proxy s -> r) -> r
reifyRounding TowardNearestWithTiesAwayFromZero f = f (Proxy :: Proxy TowardNearestWithTiesAwayFromZero)
reifyRounding TowardNearest                     f = f (Proxy :: Proxy TowardNearest)
reifyRounding TowardZero                        f = f (Proxy :: Proxy TowardZero)
reifyRounding TowardInf                         f = f (Proxy :: Proxy TowardInf)
reifyRounding TowardNegInf                      f = f (Proxy :: Proxy TowardNegInf)
reifyRounding AwayFromZero                      f = f (Proxy :: Proxy AwayFromZero)
reifyRounding Faithfully                        f = f (Proxy :: Proxy Faithfully)
{-# INLINE reifyRounding #-}