Fix a TODO in the compiler

AnnProvenance now has Functor, Foldable, Traversable instances.

2 files changed, 8 insertions, 13 deletions

diff --git a/compiler/hsSyn/HsDecls.lhs b/compiler/hsSyn/HsDecls.lhs
index 13638a0a57..ce391c73e2 100644
--- a/compiler/hsSyn/HsDecls.lhs
+++ b/compiler/hsSyn/HsDecls.lhs
@@ -4,7 +4,8 @@
 %
 
 \begin{code}
-{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, DeriveFoldable,
+             DeriveTraversable #-}
 
 -- | Abstract syntax of global declarations.
 --
@@ -54,7 +55,7 @@ module HsDecls (
   WarnDecl(..),  LWarnDecl,
   -- ** Annotations
   AnnDecl(..), LAnnDecl, 
-  AnnProvenance(..), annProvenanceName_maybe, modifyAnnProvenanceNameM,
+  AnnProvenance(..), annProvenanceName_maybe,
 
   -- * Grouping
   HsGroup(..),  emptyRdrGroup, emptyRnGroup, appendGroups
@@ -84,8 +85,9 @@ import SrcLoc
 import FastString
 
 import Bag
-import Control.Monad    ( liftM )
 import Data.Data        hiding (TyCon)
+import Data.Foldable (Foldable)
+import Data.Traversable
 \end{code}
 
 %************************************************************************
@@ -1359,21 +1361,13 @@ instance (OutputableBndr name) => Outputable (AnnDecl name) where
 data AnnProvenance name = ValueAnnProvenance name
                         | TypeAnnProvenance name
                         | ModuleAnnProvenance
-  deriving (Data, Typeable)
+  deriving (Data, Typeable, Functor, Foldable, Traversable)
 
 annProvenanceName_maybe :: AnnProvenance name -> Maybe name
 annProvenanceName_maybe (ValueAnnProvenance name) = Just name
 annProvenanceName_maybe (TypeAnnProvenance name)  = Just name
 annProvenanceName_maybe ModuleAnnProvenance       = Nothing
 
--- TODO: Replace with Traversable instance when GHC bootstrap version rises high enough
-modifyAnnProvenanceNameM :: Monad m => (before -> m after) -> AnnProvenance before -> m (AnnProvenance after)
-modifyAnnProvenanceNameM fm prov =
-    case prov of
-            ValueAnnProvenance name -> liftM ValueAnnProvenance (fm name)
-            TypeAnnProvenance name -> liftM TypeAnnProvenance (fm name)
-            ModuleAnnProvenance -> return ModuleAnnProvenance
-
 pprAnnProvenance :: OutputableBndr name => AnnProvenance name -> SDoc
 pprAnnProvenance ModuleAnnProvenance       = ptext (sLit "ANN module")
 pprAnnProvenance (ValueAnnProvenance name) = ptext (sLit "ANN") <+> ppr name
diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs
index 7ff473f8c7..cc410388df 100644
--- a/compiler/rename/RnSource.lhs
+++ b/compiler/rename/RnSource.lhs
@@ -44,6 +44,7 @@ import Digraph          ( SCC, flattenSCC, stronglyConnCompFromEdgedVertices )
 
 import Control.Monad
 import Data.List( partition )
+import Data.Traversable (traverse)
 import Maybes( orElse )
 \end{code}
 
@@ -339,7 +340,7 @@ rnAnnDecl (HsAnnotation provenance expr) = do
 
 rnAnnProvenance :: AnnProvenance RdrName -> RnM (AnnProvenance Name, FreeVars)
 rnAnnProvenance provenance = do
-    provenance' <- modifyAnnProvenanceNameM lookupTopBndrRn provenance
+    provenance' <- traverse lookupTopBndrRn provenance
     return (provenance', maybe emptyFVs unitFV (annProvenanceName_maybe provenance'))
 \end{code}