    {-# LANGUAGE CPP #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE FlexibleContexts #-}

    {-# OPTIONS_GHC -Wall #-}

    -------------------------------------------------------------------------
    -- |
    -- Module      :  Data.Boolean.Numbers
    -- Copyright   :  (c) Jan Bracker 2013
    -- License     :  BSD3
    --
    -- Maintainer  :  jbra@informatik.uni-kiel.de
    -- Stability   :  experimental
    --
    -- A generalized version of the class hirarchy for numbers. All
    -- functions that would break a potential deep embedding are removed
    -- or generalized to support deep embeddings.
    --
    -- The class hierarchy for numeric types keeps as close as possible to the
    -- 'Prelude' hierarchy. A great part of the default implementation and comments
    -- are copied and adopted from 'Prelude'.
    --
    -------------------------------------------------------------------------

    module Data.Boolean.Numbers
      ( NumB(..)
      , IntegralB(..)
      , RealFracB(..)
      , RealFloatB(..)
      , evenB, oddB
      , fromIntegralB
      ) where

    import Prelude hiding
      ( quotRem, divMod
      , quot, rem
      , div, mod
      , properFraction
      , fromInteger, toInteger )
    import qualified Prelude as P

    import Control.Arrow (first)

    import Data.Boolean

    {--------------------------------------------------------------------
        Misc
    --------------------------------------------------------------------}

    infixr 9 .:

    -- Double composition. (Aka "result.result". See semantic editor combinators.)
    (.:) :: (c -> c') -> (a -> b -> c) -> (a -> b -> c')
    .: :: forall c c' a b. (c -> c') -> (a -> b -> c) -> a -> b -> c'
    (.:) = ((b -> c) -> b -> c') -> (a -> b -> c) -> a -> b -> c'
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    (.)(((b -> c) -> b -> c') -> (a -> b -> c) -> a -> b -> c')
    -> ((c -> c') -> (b -> c) -> b -> c')
    -> (c -> c')
    -> (a -> b -> c)
    -> a
    -> b
    -> c'
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(c -> c') -> (b -> c) -> b -> c'
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    (.)

    (##) :: (a -> b -> c) -> (a -> b -> d) -> a -> b -> (c,d)
    (a -> b -> c
    f ## :: forall a b c d. (a -> b -> c) -> (a -> b -> d) -> a -> b -> (c, d)
    ## a -> b -> d
    g) a
    x b
    y = (a -> b -> c
    f a
    x b
    y, a -> b -> d
    g a
    x b
    y)

    -- -----------------------------------------------------------------------
    -- Generalized Number Class Hirarchy
    -- -----------------------------------------------------------------------

    -- | An extension of 'Num' that supplies the integer type of a
    --   given number type and a way to create that number from the
    --   integer.
    class Num a => NumB a where
      -- | The accociated integer type of the number.
      type IntegerOf a
      -- | Construct the number from the associated integer.
      fromIntegerB :: IntegerOf a -> a

    -- | A deep embedded version of 'Integral'.
    --   Integral numbers, supporting integer division.
    --
    --   Minimal complete definition is either 'quotRem' and 'divMod'
    --   or the other four functions. Besides that 'toIntegerB' always
    --   has to be implemented.
    class (NumB a, OrdB a) => IntegralB a where
      -- | Integer division truncated towards zero.
      quot :: a -> a -> a
      quot = (a, a) -> a
    forall a b. (a, b) -> a
    fst ((a, a) -> a) -> (a -> a -> (a, a)) -> a -> a -> a
    forall c c' a b. (c -> c') -> (a -> b -> c) -> a -> b -> c'
    .: a -> a -> (a, a)
    forall a. IntegralB a => a -> a -> (a, a)
    quotRem
      -- | Integer reminder, satisfying:
      --   @(x `quot` y) * y + (x `rem` y) == x@
      rem :: a -> a -> a
      rem = (a, a) -> a
    forall a b. (a, b) -> b
    snd ((a, a) -> a) -> (a -> a -> (a, a)) -> a -> a -> a
    forall c c' a b. (c -> c') -> (a -> b -> c) -> a -> b -> c'
    .: a -> a -> (a, a)
    forall a. IntegralB a => a -> a -> (a, a)
    quotRem
      -- | Integer division truncated toward negative infinity.
      div :: a -> a -> a
      div = (a, a) -> a
    forall a b. (a, b) -> a
    fst ((a, a) -> a) -> (a -> a -> (a, a)) -> a -> a -> a
    forall c c' a b. (c -> c') -> (a -> b -> c) -> a -> b -> c'
    .: a -> a -> (a, a)
    forall a. IntegralB a => a -> a -> (a, a)
    divMod
      -- | Integer modulus, satisfying:
      --   @(x `div` y) * y + (x `mod` y) == x@
      mod :: a -> a -> a
      mod = (a, a) -> a
    forall a b. (a, b) -> b
    snd ((a, a) -> a) -> (a -> a -> (a, a)) -> a -> a -> a
    forall c c' a b. (c -> c') -> (a -> b -> c) -> a -> b -> c'
    .: a -> a -> (a, a)
    forall a. IntegralB a => a -> a -> (a, a)
    divMod
      -- | Simultaneous 'quot' and 'rem'.
      quotRem :: a -> a -> (a,a)
      quotRem = a -> a -> a
    forall a. IntegralB a => a -> a -> a
    quot (a -> a -> a) -> (a -> a -> a) -> a -> a -> (a, a)
    forall a b c d. (a -> b -> c) -> (a -> b -> d) -> a -> b -> (c, d)
    ## a -> a -> a
    forall a. IntegralB a => a -> a -> a
    rem
      -- | Simultaneous 'div' and 'mod'.
      divMod :: a -> a -> (a,a)
      divMod  = a -> a -> a
    forall a. IntegralB a => a -> a -> a
    div (a -> a -> a) -> (a -> a -> a) -> a -> a -> (a, a)
    forall a b c d. (a -> b -> c) -> (a -> b -> d) -> a -> b -> (c, d)
    ## a -> a -> a
    forall a. IntegralB a => a -> a -> a
    mod
      -- | Create a integer from this integral.
      toIntegerB :: a -> IntegerOf a

    -- | Deep embedded version of 'RealFloat'.
    --   Extracting components of fractions.
    --
    --   Minimal complete definition: 'properFraction',
    --   'round', 'floor' and 'ceiling'.
    class (NumB a, OrdB a, Fractional a) => RealFracB a where
      -- | The function 'properFraction' takes a real fractional number @x@
      -- and returns a pair @(n,f)@ such that @x = n+f@, and:
      --
      -- * @n@ is an integral number with the same sign as @x@; and
      --
      -- * @f@ is a fraction with the same type and sign as @x@,
      --   and with absolute value less than @1@.
      --
      -- The default definitions of the 'ceiling', 'floor', 'truncate'
      -- and 'round' functions are in terms of 'properFraction'.
      properFraction :: (IntegerOf a ~ IntegerOf b, IntegralB b) => a -> (b, a)
      -- | @'truncate' x@ returns the integer nearest @x@ between zero and @x@
      truncate :: (IntegerOf a ~ IntegerOf b, IntegralB b) => a -> b
      truncate = (b, a) -> b
    forall a b. (a, b) -> a
    fst ((b, a) -> b) -> (a -> (b, a)) -> a -> b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> (b, a)
    forall b. (IntegerOf a ~ IntegerOf b, IntegralB b) => a -> (b, a)
    forall a b.
    (RealFracB a, IntegerOf a ~ IntegerOf b, IntegralB b) =>
    a -> (b, a)
    properFraction
      -- | @'round' x@ returns the nearest integer to @x@;
      --   the even integer if @x@ is equidistant between two integers
      round :: (IntegerOf a ~ IntegerOf b, IntegralB b) => a -> b
      -- | @'ceiling' x@ returns the least integer not less than @x@
      ceiling :: (IntegerOf a ~ IntegerOf b, IntegralB b) => a -> b
      -- | @'floor' x@ returns the greatest integer not greater than @x@.
      floor :: (IntegerOf a ~ IntegerOf b, IntegralB b) => a -> b

    -- | Deep embedded version of 'RealFloat'.
    --   Efficient, machine-independent access to the components of a
    --   floating-point number.
    --
    --   A complete definition has to define all functions.
    class (Boolean (BooleanOf a), RealFracB a, Floating a) => RealFloatB a where
      -- | 'true' if the argument is an IEEE \"not-a-number\" (NaN) value.
      isNaN :: a -> BooleanOf a
      -- | 'true' if the argument is an IEEE infinity or negative infinity.
      isInfinite :: a -> BooleanOf a
      -- | 'true' if the argument is an IEEE negative zero.
      isNegativeZero :: a -> BooleanOf a
      -- | 'true' if the argument is an IEEE floating point number.
      isIEEE :: a -> BooleanOf a
      -- | a version of arctangent taking two real floating-point arguments.
      --   For real floating @x@ and @y@, @'atan2' y x@ computes the angle
      --   (from the positive x-axis) of the vector from the origin to the
      --   point @(x,y)@.  @'atan2' y x@ returns a value in the range [@-pi@,
      --   @pi@].  It follows the Common Lisp semantics for the origin when
      --   signed zeroes are supported.  @'atan2' y 1@, with @y@ in a type
      --   that is 'RealFloatB', should return the same value as @'atan' y@.
      atan2 :: a -> a -> a

    -- -----------------------------------------------------------------------
    -- Generalized Number Utility Functions
    -- -----------------------------------------------------------------------

    -- | Variant of 'even' for generalized booleans.
    evenB :: (IfB a, EqB a, IntegralB a) => a -> BooleanOf a
    evenB :: forall a. (IfB a, EqB a, IntegralB a) => a -> BooleanOf a
    evenB a
    n = a
    n a -> a -> a
    forall a. IntegralB a => a -> a -> a
    `rem` a
    2 a -> a -> BooleanOf a
    forall bool. (bool ~ BooleanOf a) => a -> a -> bool
    forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
    ==* a
    0

    -- | Variant of 'odd' for generalized booleans.
    oddB :: (IfB a, EqB a, IntegralB a) => a -> BooleanOf a
    oddB :: forall a. (IfB a, EqB a, IntegralB a) => a -> BooleanOf a
    oddB = BooleanOf a -> BooleanOf a
    forall b. Boolean b => b -> b
    notB (BooleanOf a -> BooleanOf a)
    -> (a -> BooleanOf a) -> a -> BooleanOf a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> BooleanOf a
    forall a. (IfB a, EqB a, IntegralB a) => a -> BooleanOf a
    evenB

    -- | Variant of 'fromIntegral' for generalized booleans.
    fromIntegralB :: (IntegerOf a ~ IntegerOf b, IntegralB a, NumB b) => a -> b
    fromIntegralB :: forall a b.
    (IntegerOf a ~ IntegerOf b, IntegralB a, NumB b) =>
    a -> b
    fromIntegralB = IntegerOf b -> b
    forall a. NumB a => IntegerOf a -> a
    fromIntegerB (IntegerOf b -> b) -> (a -> IntegerOf b) -> a -> b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> IntegerOf a
    a -> IntegerOf b
    forall a. IntegralB a => a -> IntegerOf a
    toIntegerB

    -- -----------------------------------------------------------------------
    -- Default Class Instances for Basic Types
    -- -----------------------------------------------------------------------

    -- | Only for internal use.
    fromInteger' :: (Integer ~ IntegerOf b, NumB b) => Integer -> b
    fromInteger' :: forall b. (Integer ~ IntegerOf b, NumB b) => Integer -> b
    fromInteger' = Integer -> b
    forall a b.
    (IntegerOf a ~ IntegerOf b, IntegralB a, NumB b) =>
    a -> b
    fromIntegralB

    #define DefaultNumBInstance(Ty) \
    instance NumB (Ty) where {\
      type IntegerOf (Ty) = Integer ;\
      fromIntegerB = P.fromInteger }

    #define DefaultIntegralBInstance(Ty) \
    instance IntegralB (Ty) where {\
      quotRem = P.quotRem ;\
      divMod = P.divMod ;\
      toIntegerB = P.toInteger }

    #define DefaultRealFracFloatBInstance(Ty) \
    instance RealFracB (Ty) where {\
      properFraction = first fromInteger' . P.properFraction ;\
      round          = fromInteger' . P.round ;\
      floor          = fromInteger' . P.floor ;\
      ceiling        = fromInteger' . P.ceiling };\
    instance RealFloatB (Ty) where {\
      isNaN          = P.isNaN ;\
      isInfinite     = P.isInfinite ;\
      isNegativeZero = P.isNegativeZero ;\
      isIEEE         = P.isIEEE ;\
      atan2          = P.atan2 }

    DefaultNumBInstance(Int)
    DefaultNumBInstance(Integer)
    DefaultNumBInstance(Float)
    DefaultNumBInstance(Double)

    DefaultIntegralBInstance(Int)
    DefaultIntegralBInstance(Integer)

    DefaultRealFracFloatBInstance(Float)
    DefaultRealFracFloatBInstance(Double)