Split Data.NumInstances into two modules, one for function instances and one for tuples

NumInstances.cabal

@@ -1,6 +1,10 @@
 Name:                NumInstances
 Version:             1.0
 Synopsis:            Instances of numeric classes for functions and tuples
+Description:         Instances of numeric classes for functions and tuples.
+                     Import "Data.NumInstances" to get all the instances.
+                     If you want only function or only tuple instances, import
+                     "Data.NumInstances.Function" or "Data.NumInstances.Tuple".
 License:             BSD3
 License-file:        LICENSE
 Author:              Conal Elliott
@@ -12,8 +16,8 @@ Package-Url:         http://github.com/conal/NumInstances
 
 Library
   hs-Source-Dirs:      src
-  Exposed-modules:     Data.NumInstances
+  Exposed-modules:     Data.NumInstances, Data.NumInstances.Function, Data.NumInstances.Tuple
   Build-Depends:       base<5
-  -- Other-modules:       
-  
+  Other-modules:       Data.NumInstances.Util
+
 -- This module used to be part of vector-space

src/Data/NumInstances.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
-{-# LANGUAGE StandaloneDeriving, ScopedTypeVariables #-}
 {-# OPTIONS_GHC -Wall -fno-warn-orphans #-}
 ----------------------------------------------------------------------
 -- |
@@ -15,240 +13,5 @@
 
 module Data.NumInstances () where
 
-import Control.Applicative
-
-noOv :: String -> String -> a
-noOv ty meth = error $ meth ++ ": No overloading for " ++ ty
-
-noFun :: String -> a
-noFun = noOv "function"
-
--- Eq & Show are prerequisites for Num, so they need to be faked here
-instance Eq (a->b) where
-  (==) = noFun "(==)"
-  (/=) = noFun "(/=)"
-
-instance Ord b => Ord (a->b) where
-  min = liftA2 min
-  max = liftA2 max
-
-instance Show (a->b) where
-  show      = noFun "show"
-  showsPrec = noFun "showsPrec"
-  showList  = noFun "showList"
-
-instance Num b => Num (a->b) where
-  negate      = fmap negate
-  (+)         = liftA2 (+)
-  (*)         = liftA2 (*)
-  fromInteger = pure . fromInteger
-  abs         = fmap abs
-  signum      = fmap signum
-
-instance Fractional b => Fractional (a->b) where
-  recip        = fmap recip
-  fromRational = pure . fromRational
-
-instance Floating b => Floating (a->b) 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
-
-
------ Tuples
-
-lift2 :: (a->u) -> (b->v) -> (a,b) -> (u,v)
-lift2 f g (a,b) = (f a, g b)
-
-noPair :: String -> a
-noPair = noOv "pair"
-
--- Equivalently, lift2 = (***)
-
-instance (Num a, Num b) => Num (a,b) where
-  fromInteger n   = (fromInteger n, fromInteger n)
-  (a,b) + (a',b') = (a+a',b+b')
-  (a,b) - (a',b') = (a-a',b-b')
-  (a,b) * (a',b') = (a*a',b*b')
-  negate = lift2 negate negate
-  abs    = lift2 abs abs
-  signum = lift2 signum signum
-
-instance (Fractional a, Fractional b) => Fractional (a,b) where
-  fromRational x = (fromRational x, fromRational x)
-  recip = lift2 recip recip
-
-instance (Floating a, Floating b) => Floating (a,b) where
-  pi    = (pi,pi)
-  exp   = lift2 exp exp
-  log   = lift2 log log
-  sqrt  = lift2 sqrt sqrt
-  sin   = lift2 sin sin
-  cos   = lift2 cos cos
-  sinh  = lift2 sinh sinh
-  cosh  = lift2 cosh cosh
-  asin  = lift2 asin asin
-  acos  = lift2 acos acos
-  atan  = lift2 atan atan
-  asinh = lift2 asinh asinh
-  acosh = lift2 acosh acosh
-  atanh = lift2 atanh atanh
-
-instance (Num a, Num b, Num c) => Num (a,b,c) where
-  fromInteger n = (fromInteger n, fromInteger n, fromInteger n)
-  (a,b,c) + (a',b',c') = (a+a',b+b',c+c')
-  (a,b,c) - (a',b',c') = (a-a',b-b',c-c')
-  (a,b,c) * (a',b',c') = (a*a',b*b',c*c')
-  negate = lift3 negate negate negate
-  abs    = lift3 abs abs abs
-  signum = lift3 signum signum signum
-
-instance (Fractional a, Fractional b, Fractional c)
-    => Fractional (a,b,c) where
-  fromRational x = (fromRational x, fromRational x, fromRational x)
-  recip = lift3 recip recip recip
-
-
-lift3 :: (a->u) -> (b->v) -> (c->w) -> (a,b,c) -> (u,v,w)
-lift3 f g h (a,b,c) = (f a, g b, h c)
-
-instance (Floating a, Floating b, Floating c)
-    => Floating (a,b,c) where
-  pi    = (pi,pi,pi)
-  exp   = lift3 exp exp exp
-  log   = lift3 log log log
-  sqrt  = lift3 sqrt sqrt sqrt
-  sin   = lift3 sin sin sin
-  cos   = lift3 cos cos cos
-  sinh  = lift3 sinh sinh sinh
-  cosh  = lift3 cosh cosh cosh
-  asin  = lift3 asin asin asin
-  acos  = lift3 acos acos acos
-  atan  = lift3 atan atan atan
-  asinh = lift3 asinh asinh asinh
-  acosh = lift3 acosh acosh acosh
-  atanh = lift3 atanh atanh atanh
-
-
-
-lift4 :: (a->u) -> (b->v) -> (c->w) -> (d->x)
-      -> (a,b,c,d) -> (u,v,w,x)
-lift4 f g h k (a,b,c,d) = (f a, g b, h c, k d)
-
-instance (Num a, Num b, Num c, Num d) => Num (a,b,c,d) where
-  fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n)
-  (a,b,c,d) + (a',b',c',d') = (a+a',b+b',c+c',d+d')
-  (a,b,c,d) - (a',b',c',d') = (a-a',b-b',c-c',d-d')
-  (a,b,c,d) * (a',b',c',d') = (a*a',b*b',c*c',d*d')
-  negate = lift4 negate negate negate negate
-  abs    = lift4 abs abs abs abs
-  signum = lift4 signum signum signum signum
-
-instance (Fractional a, Fractional b, Fractional c, Fractional d)
-    => Fractional (a,b,c,d) where
-  fromRational x = (fromRational x, fromRational x, fromRational x, fromRational x)
-  recip = lift4 recip recip recip recip
-
-instance (Floating a, Floating b, Floating c, Floating d)
-    => Floating (a,b,c,d) where
-  pi    = (pi,pi,pi,pi)
-  exp   = lift4 exp exp exp exp
-  log   = lift4 log log log log
-  sqrt  = lift4 sqrt sqrt sqrt sqrt
-  sin   = lift4 sin sin sin sin
-  cos   = lift4 cos cos cos cos
-  sinh  = lift4 sinh sinh sinh sinh
-  cosh  = lift4 cosh cosh cosh cosh
-  asin  = lift4 asin asin asin asin
-  acos  = lift4 acos acos acos acos
-  atan  = lift4 atan atan atan atan
-  asinh = lift4 asinh asinh asinh asinh
-  acosh = lift4 acosh acosh acosh acosh
-  atanh = lift4 atanh atanh atanh atanh
-
-
-{--------------------------------------------------------------------
-    Some experiments in Enum and Integral instances for tuples
---------------------------------------------------------------------}
-
-{-
-
--- Integral needs Enum
-
-instance (Enum a, Enum b, Bounded b) => Enum (a,b) where
-  toEnum = noPair "toEnum"
-  fromEnum = noPair "fromEnum"
-  -- enumerate consistently with Ord
-  enumFromTo (alo,blo) (ahi,bhi) = 
-       [ (alo,b) | b <- [blo .. maxBound] ]
-    ++ [ (a  ,b) | a <- [succ alo .. pred ahi], b <- [minBound .. maxBound] ]
-    ++ [ (ahi,b) | b <- [minBound .. bhi] ]
-  -- To do: replace enumFromTo def with an enumFromThenTo def
-
--- deriving instance (Enum a, Enum b) => Enum (a,b)
--- 
---     The data constructors of `(,)' are not all in scope
---       so you cannot derive an instance for it
-
--- To do: toEnum and fromEnum
-
-{-
--- Test:
-
-data Foo = A | B | C | D deriving (Enum,Bounded,Show)
-
-t1 :: [(Foo,Foo)]
-t1 = [(B,C) .. (C,C)]
--}
-
-instance (Real a, Real b) => Real (a,b) where
-  toRational = noPair "toRational"
-
-
-instance (Integral a, Integral b, Bounded b) => Integral (a,b) where
---   (a,b) `quotRem` (a',b') = ((qa,qb),(ra,rb))
---     where
---       (qa,ra) = a `quotRem` a'
---       (qb,rb) = b `quotRem` b'
-  (a,b) `quotRem` (a',b') = transpose (a `quotRem` a' , b `quotRem` b')
-    where
-      transpose ((w,x),(y,z)) = ((w,y),(x,z)) -- to-do: pretty point-free
-  toInteger (a , b::b) = toInteger a * widthB + toInteger b
-   where
-     widthB = toInteger (maxBound :: b) - toInteger (minBound :: b)
-
-{-
-t2 :: ((Int,Int),(Int,Int))
-t2 = (7,8) `quotRem` (2,3)
-
-t3 :: (Int,Int)
-t3 = (7,8) `quot` (2,3)
-
-t4 :: (Int,Int)
-t4 = (7,8) `rem` (2,3)
--}
-
-{-
-  (a,b) `quot` (a',b') = (a `quot` a', b `quot` b')
-
-
-  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)
--}
-
--}
+import Data.NumInstances.Function ()
+import Data.NumInstances.Tuple ()

src/Data/NumInstances/Function.hs

@@ -0,0 +1,60 @@
+{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}
+----------------------------------------------------------------------
+-- |
+-- Module      :  Data.NumInstances.Function
+-- Copyright   :  (c) Conal Elliott 2008
+-- License     :  BSD3
+--
+-- Maintainer  :  conal@conal.net
+-- Stability   :  experimental
+--
+-- Number class instances for functions
+----------------------------------------------------------------------
+
+module Data.NumInstances.Function () where
+
+import Control.Applicative
+
+import Data.NumInstances.Util
+
+-- Eq & Show are prerequisites for Num, so they need to be faked here
+instance Eq (a->b) where
+  (==) = noFun "(==)"
+  (/=) = noFun "(/=)"
+
+instance Ord b => Ord (a->b) where
+  min = liftA2 min
+  max = liftA2 max
+
+instance Show (a->b) where
+  show      = noFun "show"
+  showsPrec = noFun "showsPrec"
+  showList  = noFun "showList"
+
+instance Num b => Num (a->b) where
+  negate      = fmap negate
+  (+)         = liftA2 (+)
+  (*)         = liftA2 (*)
+  fromInteger = pure . fromInteger
+  abs         = fmap abs
+  signum      = fmap signum
+
+instance Fractional b => Fractional (a->b) where
+  recip        = fmap recip
+  fromRational = pure . fromRational
+
+instance Floating b => Floating (a->b) 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