From 8d585f7c5ad8c4b46f9ca58931e1379abbd359af Mon Sep 17 00:00:00 2001
From: Ian Lynagh <igloo@earth.li>
Date: Sat, 16 Aug 2008 12:22:53 +0000
Subject: [PATCH] Eliminate orphan rules and instances in the array package

---
 Data/Foldable.hs    |   11 +++++++++++
 Data/Traversable.hs |   11 +++++++++++
 Data/Typeable.hs    |    7 ++++---
 3 files changed, 26 insertions(+), 3 deletions(-)

diff --git a/Data/Foldable.hs b/Data/Foldable.hs
index f2baddf..9d5502c 100644
--- a/Data/Foldable.hs
+++ b/Data/Foldable.hs
@@ -72,6 +72,12 @@ import Control.Arrow (ArrowZero(..)) -- work around nhc98 typechecker problem
 import GHC.Exts (build)
 #endif
 
+#if defined(__GLASGOW_HASKELL__)
+import GHC.Arr
+#elif defined(__HUGS__)
+import Hugs.Array
+#endif
+
 -- | Data structures that can be folded.
 --
 -- Minimal complete definition: 'foldMap' or 'foldr'.
@@ -147,6 +153,11 @@ instance Foldable [] where
         foldr1 = Prelude.foldr1
         foldl1 = Prelude.foldl1
 
+#ifndef __NHC__
+instance Ix i => Foldable (Array i) where
+    foldr f z = Prelude.foldr f z . elems
+#endif
+
 -- | Fold over the elements of a structure,
 -- associating to the right, but strictly.
 foldr' :: Foldable t => (a -> b -> b) -> b -> t a -> b
diff --git a/Data/Traversable.hs b/Data/Traversable.hs
index 7ad3991..df10679 100644
--- a/Data/Traversable.hs
+++ b/Data/Traversable.hs
@@ -43,6 +43,12 @@ import Control.Applicative
 import Data.Foldable (Foldable())
 import Data.Monoid (Monoid)
 
+#if defined(__GLASGOW_HASKELL__)
+import GHC.Arr
+#elif defined(__HUGS__)
+import Hugs.Array
+#endif
+
 -- | Functors representing data structures that can be traversed from
 -- left to right.
 --
@@ -104,6 +110,11 @@ instance Traversable [] where
 
         mapM = Prelude.mapM
 
+#ifndef __NHC__
+instance Ix i => Traversable (Array i) where
+    traverse f arr = listArray (bounds arr) `fmap` traverse f (elems arr)
+#endif
+
 -- general functions
 
 -- | 'for' is 'traverse' with its arguments flipped.
diff --git a/Data/Typeable.hs b/Data/Typeable.hs
index 606c8cc..ee9e89a 100644
--- a/Data/Typeable.hs
+++ b/Data/Typeable.hs
@@ -100,7 +100,7 @@ import GHC.IOBase       (IORef,newIORef,unsafePerformIO)
 -- These imports are so we can define Typeable instances
 -- It'd be better to give Typeable instances in the modules themselves
 -- but they all have to be compiled before Typeable
-import GHC.IOBase       ( IO, MVar, Handle, block )
+import GHC.IOBase       ( IOArray, IO, MVar, Handle, block )
 import GHC.ST           ( ST )
 import GHC.STRef        ( STRef )
 import GHC.Ptr          ( Ptr, FunPtr )
@@ -118,11 +118,12 @@ import Hugs.IORef       ( IORef, newIORef, readIORef, writeIORef )
 import Hugs.IOExts      ( unsafePerformIO )
         -- For the Typeable instance
 import Hugs.Array       ( Array )
+import Hugs.IOArray
 import Hugs.ConcBase    ( MVar )
 #endif
 
 #ifdef __NHC__
-import NHC.IOExtras (IORef,newIORef,readIORef,writeIORef,unsafePerformIO)
+import NHC.IOExtras (IOArray,IORef,newIORef,readIORef,writeIORef,unsafePerformIO)
 import IO (Handle)
 import Ratio (Ratio)
         -- For the Typeable instance
@@ -491,8 +492,8 @@ INSTANCE_TYPEABLE1(IO,ioTc,"IO")
 INSTANCE_TYPEABLE1(MVar,mvarTc,"MVar" )
 #endif
 
--- Types defined in GHC.Arr
 INSTANCE_TYPEABLE2(Array,arrayTc,"Array")
+INSTANCE_TYPEABLE2(IOArray,iOArrayTc,"IOArray")
 
 #ifdef __GLASGOW_HASKELL__
 -- Hugs has these too, but their Typeable<n> instances are defined
-- 
1.7.10.4