-*- markdown -*-

Meta-Module :  ApplicativeNumeric-inc
Copyright   :  (c) Conal Elliott 2008
License     :  BSD3

Maintainer  :  conal@conal.net
Stability   :  experimental

This meta-module is just like ApplicativeNumeric-inc.hs, but is suitable
for including into literate sources. I don't know how to avoid redundancy.

> 

#ifndef CONSTRAINTS
#define CONSTRAINTS
#endif

#ifndef noOv_DEFINED

> noOv :: String -> a
> noOv meth = error $ meth ++ ": No overloading"

#define noOv_DEFINED
#endif

TODO: splice APPLICATIVE into the error message.  I don't have the CPP chops.

Eq & Show are prerequisites for Num, so they have to be provided somehow

Hack: the Functor [] is a no-op that allows for a ","-terminated CONSTRAINTS
Requires FlexibleContexts

#ifdef INSTANCE_Eq
> instance (CONSTRAINTS Functor []) => Eq (APPLICATIVE applicative_arg) where (==) = noOv "(==)"
#endif

#ifdef INSTANCE_Ord
> instance (CONSTRAINTS Ord applicative_arg) => Ord (APPLICATIVE applicative_arg) where
>   { min = liftA2 min ; max = liftA2 max }
#endif

#ifdef INSTANCE_Show
> instance Show (APPLICATIVE applicative_arg) where
>   { show      = noOv "show"
>   ; showsPrec = noOv "showsPrec"
>   ; showList  = noOv "showList"
>   }
#endif

#ifdef INSTANCE_Enum
> instance (CONSTRAINTS Enum applicative_arg) => Enum (APPLICATIVE applicative_arg) where
>   { succ           = fmap succ
>   ; pred           = fmap pred
>   ; toEnum         = pure . toEnum
>   ; fromEnum       = noOv "fromEnum"
>   ; enumFrom       = noOv "enumFrom"
>   ; enumFromThen   = noOv "enumFromThen"
>   ; enumFromTo     = noOv "enumFromTo"
>   ; enumFromThenTo = noOv "enumFromThenTo"
>   }
#endif

> instance (CONSTRAINTS Num applicative_arg) => Num (APPLICATIVE applicative_arg) where
>   negate      = fmap negate
>   (+)         = liftA2 (+)
>   (*)         = liftA2 (*)
>   fromInteger = pure . fromInteger
>   abs         = fmap abs
>   signum      = fmap signum

> instance (CONSTRAINTS Num applicative_arg, Ord applicative_arg) => Real (APPLICATIVE applicative_arg) where
>   toRational = noOv "toRational"

> instance (CONSTRAINTS Integral applicative_arg) => Integral (APPLICATIVE applicative_arg) where
>   quot          = liftA2 quot
>   rem           = liftA2 rem
>   div           = liftA2 div
>   mod           = liftA2 mod
>   toInteger     = noOv "toInteger"
>   x `quotRem` y = (x `quot` y, x `rem` y)
>   x `divMod`  y = (x `div`  y, x `mod` y)

> instance (CONSTRAINTS Fractional applicative_arg) => Fractional (APPLICATIVE applicative_arg) where
>   recip        = fmap recip
>   fromRational = pure . fromRational

> instance (CONSTRAINTS Floating applicative_arg) => Floating (APPLICATIVE applicative_arg) where
>   pi    = pure pi
>   sqrt  = fmap sqrt
>   exp   = fmap exp
>   log   = fmap log
>   sin   = fmap sin
>   cos   = fmap cos
>   asin  = fmap asin
>   atan  = fmap atan
>   acos  = fmap acos
>   sinh  = fmap sinh
>   cosh  = fmap cosh
>   asinh = fmap asinh
>   atanh = fmap atanh
>   acosh = fmap acosh

> instance (CONSTRAINTS RealFrac applicative_arg) => RealFrac (APPLICATIVE applicative_arg) where
>   properFraction = noOv "properFraction"
>   truncate       = noOv "truncate"
>   round          = noOv "round"
>   ceiling        = noOv "ceiling"
>   floor          = noOv "floor"

> instance (CONSTRAINTS RealFloat applicative_arg) => RealFloat (APPLICATIVE applicative_arg) where
>   floatRadix     = noOv "floatRadix"
>   floatDigits    = noOv "floatDigits"
>   floatRange     = noOv "floatRange"
>   decodeFloat    = noOv "decodeFloat"
>   encodeFloat    = ((.).(.)) pure encodeFloat
>   exponent       = noOv "exponent"
>   significand    = noOv "significand"
>   scaleFloat n   = fmap (scaleFloat n)
>   isNaN          = noOv "isNaN"
>   isInfinite     = noOv "isInfinite"
>   isDenormalized = noOv "isDenormalized"
>   isNegativeZero = noOv "isNegativeZero"
>   isIEEE         = noOv "isIEEE"
>   atan2          = liftA2 atan2

#undef APPLICATIVE