Derive Functor, Traversable and Foldable instances

cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs

+{-# LANGUAGE DeriveFunctor #-}
 module Distribution.Client.Dependency.Modular.Dependency where
 
 import Prelude hiding (pi)
@@ -19,18 +20,13 @@ import Distribution.Client.Dependency.Modular.Version
 -- TODO: This isn't the ideal location to declare the type,
 -- but we need them for constrained instances.
 data Var qpn = P qpn | F (FN qpn) | S (SN qpn)
-  deriving (Eq, Ord, Show)
+  deriving (Eq, Ord, Show, Functor)
 
 showVar :: Var QPN -> String
 showVar (P qpn) = showQPN qpn
 showVar (F qfn) = showQFN qfn
 showVar (S qsn) = showQSN qsn
 
-instance Functor Var where
-  fmap f (P n)  = P (f n)
-  fmap f (F fn) = F (fmap f fn)
-  fmap f (S sn) = S (fmap f sn)
-
 type ConflictSet qpn = Set (Var qpn)
 
 showCS :: ConflictSet QPN -> String
@@ -41,11 +37,7 @@ showCS = intercalate ", " . L.map showVar . S.toList
 -- is for convenience. Otherwise, it is a list of version ranges paired with
 -- the goals / variables that introduced them.
 data CI qpn = Fixed I (Goal qpn) | Constrained [VROrigin qpn]
-  deriving (Eq, Show)
-
-instance Functor CI where
-  fmap f (Fixed i g)       = Fixed i (fmap f g)
-  fmap f (Constrained vrs) = Constrained (L.map (\ (x, y) -> (x, fmap f y)) vrs)
+  deriving (Eq, Show, Functor)
 
 instance ResetGoal CI where
   resetGoal g (Fixed i _)       = Fixed i g
@@ -98,13 +90,7 @@ data FlaggedDep qpn =
     Flagged (FN qpn) FInfo (TrueFlaggedDeps qpn) (FalseFlaggedDeps qpn)
   | Stanza  (SN qpn)       (TrueFlaggedDeps qpn)
   | Simple (Dep qpn)
-  deriving (Eq, Show)
-
-instance Functor FlaggedDep where
-  fmap f (Flagged x y tt ff) = Flagged (fmap f x) y
-                                       (fmap (fmap f) tt) (fmap (fmap f) ff)
-  fmap f (Stanza x tt)       = Stanza (fmap f x) (fmap (fmap f) tt)
-  fmap f (Simple d)          = Simple (fmap f d)
+  deriving (Eq, Show, Functor)
 
 type TrueFlaggedDeps  qpn = FlaggedDeps qpn
 type FalseFlaggedDeps qpn = FlaggedDeps qpn
@@ -112,7 +98,7 @@ type FalseFlaggedDeps qpn = FlaggedDeps qpn
 -- | A dependency (constraint) associates a package name with a
 -- constrained instance.
 data Dep qpn = Dep qpn (CI qpn)
-  deriving (Eq, Show)
+  deriving (Eq, Show, Functor)
 
 showDep :: Dep QPN -> String
 showDep (Dep qpn (Fixed i (Goal v _))          ) =
@@ -123,9 +109,6 @@ showDep (Dep qpn (Constrained [(vr, Goal v _)])) =
 showDep (Dep qpn ci                            ) =
   showQPN qpn ++ showCI ci
 
-instance Functor Dep where
-  fmap f (Dep x y) = Dep (f x) (fmap f y)
-
 instance ResetGoal Dep where
   resetGoal g (Dep qpn ci) = Dep qpn (resetGoal g ci)
 
@@ -136,10 +119,7 @@ type RevDepMap = Map QPN [QPN]
 -- | Goals are solver variables paired with information about
 -- why they have been introduced.
 data Goal qpn = Goal (Var qpn) (GoalReasonChain qpn)
-  deriving (Eq, Show)
-
-instance Functor Goal where
-  fmap f (Goal v grs) = Goal (fmap f v) (fmap (fmap f) grs)
+  deriving (Eq, Show, Functor)
 
 class ResetGoal f where
   resetGoal :: Goal qpn -> f qpn -> f qpn
@@ -158,13 +138,7 @@ data GoalReason qpn =
   | PDependency (PI qpn)
   | FDependency (FN qpn) Bool
   | SDependency (SN qpn)
-  deriving (Eq, Show)
-
-instance Functor GoalReason where
-  fmap _ UserGoal           = UserGoal
-  fmap f (PDependency pi)   = PDependency (fmap f pi)
-  fmap f (FDependency fn b) = FDependency (fmap f fn) b
-  fmap f (SDependency sn)   = SDependency (fmap f sn)
+  deriving (Eq, Show, Functor)
 
 -- | The first element is the immediate reason. The rest are the reasons
 -- for the reasons ...

cabal-install/Distribution/Client/Dependency/Modular/Flag.hs

+{-# LANGUAGE DeriveFunctor #-}
 module Distribution.Client.Dependency.Modular.Flag where
 
 import Data.Map as M
@@ -10,15 +11,12 @@ import Distribution.Client.Types (OptionalStanza(..))
 
 -- | Flag name. Consists of a package instance and the flag identifier itself.
 data FN qpn = FN (PI qpn) Flag
-  deriving (Eq, Ord, Show)
+  deriving (Eq, Ord, Show, Functor)
 
 -- | Extract the package name from a flag name.
 getPN :: FN qpn -> qpn
 getPN (FN (PI qpn _) _) = qpn
 
-instance Functor FN where
-  fmap f (FN x y) = FN (fmap f x) y
-
 -- | Flag identifier. Just a string.
 type Flag = FlagName
 
@@ -39,10 +37,7 @@ type QFN = FN QPN
 
 -- | Stanza name. Paired with a package name, much like a flag.
 data SN qpn = SN (PI qpn) OptionalStanza
-  deriving (Eq, Ord, Show)
-
-instance Functor SN where
-  fmap f (SN x y) = SN (fmap f x) y
+  deriving (Eq, Ord, Show, Functor)
 
 -- | Qualified stanza name.
 type QSN = SN QPN

cabal-install/Distribution/Client/Dependency/Modular/PSQ.hs

+{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveFoldable, DeriveTraversable #-}
 module Distribution.Client.Dependency.Modular.PSQ where
 
 -- Priority search queues.
@@ -7,7 +8,6 @@ module Distribution.Client.Dependency.Modular.PSQ where
 -- (inefficiently implemented) lookup, because I think that queue-based
 -- operations and sorting turn out to be more efficiency-critical in practice.
 
-import Control.Applicative
 import Data.Foldable
 import Data.Function
 import Data.List as S hiding (foldr)
@@ -15,16 +15,7 @@ import Data.Traversable
 import Prelude hiding (foldr)
 
 newtype PSQ k v = PSQ [(k, v)]
-  deriving (Eq, Show)
-
-instance Functor (PSQ k) where
-  fmap f (PSQ xs) = PSQ (fmap (\ (k, v) -> (k, f v)) xs)
-
-instance Foldable (PSQ k) where
-  foldr op e (PSQ xs) = foldr op e (fmap snd xs)
-
-instance Traversable (PSQ k) where
-  traverse f (PSQ xs) = PSQ <$> traverse (\ (k, v) -> (\ x -> (k, x)) <$> f v) xs
+  deriving (Eq, Show, Functor, Foldable, Traversable)
 
 keys :: PSQ k v -> [k]
 keys (PSQ xs) = fmap fst xs

cabal-install/Distribution/Client/Dependency/Modular/Package.hs

+{-# LANGUAGE DeriveFunctor #-}
 module Distribution.Client.Dependency.Modular.Package
   (module Distribution.Client.Dependency.Modular.Package,
    module Distribution.Package) where
@@ -51,7 +52,7 @@ showI (I v (Inst (InstalledPackageId i))) = showVer v ++ "/installed" ++ shortId
 
 -- | Package instance. A package name and an instance.
 data PI qpn = PI qpn I
-  deriving (Eq, Ord, Show)
+  deriving (Eq, Ord, Show, Functor)
 
 -- | String representation of a package instance.
 showPI :: PI QPN -> String
@@ -66,9 +67,6 @@ instI :: I -> Bool
 instI (I _ (Inst _)) = True
 instI _              = False
 
-instance Functor PI where
-  fmap f (PI x y) = PI (f x) y
-
 -- | Package path. (Stored in "reverse" order.)
 type PP = [PN]
 

cabal-install/Distribution/Client/Dependency/Modular/Tree.hs

+{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
 module Distribution.Client.Dependency.Modular.Tree where
 
-import Control.Applicative
 import Control.Monad hiding (mapM)
 import Data.Foldable
 import Data.Traversable
@@ -20,7 +20,7 @@ data Tree a =
   | GoalChoice                  (PSQ OpenGoal (Tree a)) -- PSQ should never be empty
   | Done        RevDepMap
   | Fail        (ConflictSet QPN) FailReason
-  deriving (Eq, Show)
+  deriving (Eq, Show, Functor)
   -- Above, a choice is called trivial if it clearly does not matter. The
   -- special case of triviality we actually consider is if there are no new
   -- dependencies introduced by this node.
@@ -30,14 +30,6 @@ data Tree a =
   -- the system, as opposed to flags that are used to explicitly enable or
   -- disable some functionality.
 
-instance Functor Tree where
-  fmap  f (PChoice qpn i     xs) = PChoice qpn (f i)     (fmap (fmap f) xs)
-  fmap  f (FChoice qfn i b m xs) = FChoice qfn (f i) b m (fmap (fmap f) xs)
-  fmap  f (SChoice qsn i b   xs) = SChoice qsn (f i) b   (fmap (fmap f) xs)
-  fmap  f (GoalChoice        xs) = GoalChoice            (fmap (fmap f) xs)
-  fmap _f (Done    rdm         ) = Done    rdm
-  fmap _f (Fail    cs fr       ) = Fail    cs fr
-
 data FailReason = InconsistentInitialConstraints
                 | Conflicting [Dep QPN]
                 | CannotInstall
@@ -64,6 +56,7 @@ data TreeF a b =
   | GoalChoiceF                 (PSQ OpenGoal b)
   | DoneF       RevDepMap
   | FailF       (ConflictSet QPN) FailReason
+  deriving (Functor, Foldable, Traversable)
 
 out :: Tree a -> TreeF a (Tree a)
 out (PChoice    p i     ts) = PChoiceF    p i     ts
@@ -81,30 +74,6 @@ inn (GoalChoiceF         ts) = GoalChoice         ts
 inn (DoneF       x         ) = Done       x
 inn (FailF       c x       ) = Fail       c x
 
-instance Functor (TreeF a) where
-  fmap f (PChoiceF    p i     ts) = PChoiceF    p i     (fmap f ts)
-  fmap f (FChoiceF    p i b m ts) = FChoiceF    p i b m (fmap f ts)
-  fmap f (SChoiceF    p i b   ts) = SChoiceF    p i b   (fmap f ts)
-  fmap f (GoalChoiceF         ts) = GoalChoiceF         (fmap f ts)
-  fmap _ (DoneF       x         ) = DoneF       x
-  fmap _ (FailF       c x       ) = FailF       c x
-
-instance Foldable (TreeF a) where
-  foldr op e (PChoiceF    _ _     ts) = foldr op e ts
-  foldr op e (FChoiceF    _ _ _ _ ts) = foldr op e ts
-  foldr op e (SChoiceF    _ _ _   ts) = foldr op e ts
-  foldr op e (GoalChoiceF         ts) = foldr op e ts
-  foldr _  e (DoneF       _         ) = e
-  foldr _  e (FailF       _ _       ) = e
-
-instance Traversable (TreeF a) where
-  traverse f (PChoiceF    p i     ts) = PChoiceF    <$> pure p <*> pure i <*>                       traverse f ts
-  traverse f (FChoiceF    p i b m ts) = FChoiceF    <$> pure p <*> pure i <*> pure b <*> pure m <*> traverse f ts
-  traverse f (SChoiceF    p i b   ts) = SChoiceF    <$> pure p <*> pure i <*> pure b <*>            traverse f ts
-  traverse f (GoalChoiceF         ts) = GoalChoiceF <$>                                             traverse f ts
-  traverse _ (DoneF       x         ) = DoneF       <$> pure x
-  traverse _ (FailF       c x       ) = FailF       <$> pure c <*> pure x
-
 -- | Determines whether a tree is active, i.e., isn't a failure node.
 active :: Tree a -> Bool
 active (Fail _ _) = False

cabal-install/Distribution/Client/Dependency/Types.hs

+{-# LANGUAGE DeriveFunctor #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Distribution.Client.Dependency.Types
@@ -221,6 +222,7 @@ isAllowNewer AllowNewerAll      = True
 data Progress step fail done = Step step (Progress step fail done)
                              | Fail fail
                              | Done done
+  deriving Functor
 
 -- | Consume a 'Progress' calculation. Much like 'foldr' for lists but with two
 -- base cases, one for a final result and one for failure.
@@ -236,9 +238,6 @@ foldProgress step fail done = fold
         fold (Fail f)   = fail f
         fold (Done r)   = done r
 
-instance Functor (Progress step fail) where
-  fmap f = foldProgress Step Fail (Done . f)
-
 instance Monad (Progress step fail) where
   return a = Done a
   p >>= f  = foldProgress Step Fail f p

cabal-install/Distribution/Client/PackageIndex.hs

+{-# LANGUAGE DeriveFunctor #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Distribution.Client.PackageIndex
@@ -87,10 +88,7 @@ newtype PackageIndex pkg = PackageIndex
   --
   (Map PackageName [pkg])
 
-  deriving (Show, Read)
-
-instance Functor PackageIndex where
-  fmap f (PackageIndex m) = PackageIndex (fmap (map f) m)
+  deriving (Show, Read, Functor)
 
 instance Package pkg => Monoid (PackageIndex pkg) where
   mempty  = PackageIndex Map.empty

cabal-install/Distribution/Client/Tar.hs

+{-# LANGUAGE DeriveFunctor #-}
 {-# OPTIONS_GHC -fno-warn-unused-imports #-}
 -----------------------------------------------------------------------------
 -- |
@@ -673,14 +674,12 @@ getString off len = BS.Char8.unpack . BS.Char8.takeWhile (/='\0')
                     . getBytes off len
 
 data Partial a = Error String | Ok a
+  deriving Functor
 
 partial :: Partial a -> Either String a
 partial (Error msg) = Left msg
 partial (Ok x)      = Right x
 
-instance Functor Partial where
-    fmap          = liftM
-
 instance Applicative Partial where
     pure          = return
     (<*>)         = ap

cabal-install/Distribution/Client/Types.hs

+{-# LANGUAGE DeriveFunctor #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Distribution.Client.Types
@@ -172,14 +173,7 @@ data PackageLocation local =
 --TODO:
 --  * add support for darcs and other SCM style remote repos with a local cache
 --  | ScmPackage
-  deriving Show
-
-instance Functor PackageLocation where
-  fmap _ (LocalUnpackedPackage dir)      = LocalUnpackedPackage dir
-  fmap _ (LocalTarballPackage  file)     = LocalTarballPackage  file
-  fmap f (RemoteTarballPackage uri x)    = RemoteTarballPackage uri    (f x)
-  fmap f (RepoTarballPackage repo pkg x) = RepoTarballPackage repo pkg (f x)
-
+  deriving (Show, Functor)
 
 data LocalRepo = LocalRepo
   deriving (Show,Eq)