Make cabal-install compilable with NoImplicitPrelude

I.e. find out where we don't yet
used `Distribution.Client.Compat.Prelude`.

- If the module is small I added direct `Prelude` imports.
- Add Exception, deepseq stuff to Cabal Prelude
- Add Parsec, Pretty and Verbosity to Client Prelude
- use for, for_, traverse and traverse_ (removes need for Control.Monad)

Author: phadej

Cabal/Distribution/Backpack/LinkedComponent.hs

@@ -43,11 +43,8 @@ import Distribution.Utils.LogProgress
 
 import qualified Data.Set as Set
 import qualified Data.Map as Map
-import Data.Traversable
-    ( mapM )
 import Distribution.Pretty (pretty)
-import Text.PrettyPrint
-import Data.Either
+import Text.PrettyPrint (Doc, hang, text, vcat, ($+$), hsep, quotes)
 
 -- | A linked component is a component that has been mix-in linked, at
 -- which point we have determined how all the dependencies of the
@@ -187,19 +184,19 @@ toLinkedComponent verbosity db this_pid pkg_map ConfiguredComponent {
                 m_u <- convertModule (OpenModule this_uid m)
                 return (Map.singleton m [WithSource (from m) m_u], Map.empty)
         -- Handle 'exposed-modules'
-        exposed_mod_shapes_u <- mapM (convertMod FromExposedModules) src_provs
+        exposed_mod_shapes_u <- traverse (convertMod FromExposedModules) src_provs
         -- Handle 'other-modules'
-        other_mod_shapes_u <- mapM (convertMod FromOtherModules) src_hidden
+        other_mod_shapes_u <- traverse (convertMod FromOtherModules) src_hidden
 
         -- Handle 'signatures'
         let convertReq :: ModuleName -> UnifyM s (ModuleScopeU s)
             convertReq req = do
                 req_u <- convertModule (OpenModuleVar req)
                 return (Map.empty, Map.singleton req [WithSource (FromSignatures req) req_u])
-        req_shapes_u <- mapM convertReq src_reqs
+        req_shapes_u <- traverse convertReq src_reqs
 
         -- Handle 'mixins'
-        (incl_shapes_u, all_includes_u) <- fmap unzip (mapM convertInclude unlinked_includes)
+        (incl_shapes_u, all_includes_u) <- fmap unzip (traverse convertInclude unlinked_includes)
 
         failIfErrs -- Prevent error cascade
         -- Mix-in link everything!  mixLink is the real workhorse.
@@ -208,7 +205,7 @@ toLinkedComponent verbosity db this_pid pkg_map ConfiguredComponent {
                           ++ req_shapes_u
                           ++ incl_shapes_u
 
-        -- src_reqs_u <- mapM convertReq src_reqs
+        -- src_reqs_u <- traverse convertReq src_reqs
         -- Read out all the final results by converting back
         -- into a pure representation.
         let convertIncludeU (ComponentInclude dep_aid rns i) = do
@@ -220,8 +217,8 @@ toLinkedComponent verbosity db this_pid pkg_map ConfiguredComponent {
                         })
         shape <- convertModuleScopeU shape_u
         let (includes_u, sig_includes_u) = partitionEithers all_includes_u
-        incls <- mapM convertIncludeU includes_u
-        sig_incls <- mapM convertIncludeU sig_includes_u
+        incls <- traverse convertIncludeU includes_u
+        sig_incls <- traverse convertIncludeU sig_includes_u
         return (shape, incls, sig_incls)
 
     let isNotLib (CLib _) = False

Cabal/Distribution/Backpack/ReadyComponent.hs

@@ -39,9 +39,6 @@ import Distribution.ModuleName
 import Distribution.Package
 import Distribution.Simple.Utils
 
-import qualified Control.Applicative as A
-import qualified Data.Traversable as T
-
 import Control.Monad
 import Text.PrettyPrint
 import qualified Data.Map as Map
@@ -198,14 +195,14 @@ instance Functor InstM where
     fmap f (InstM m) = InstM $ \s -> let (x, s') = m s
                                      in (f x, s')
 
-instance A.Applicative InstM where
+instance Applicative InstM where
     pure a = InstM $ \s -> (a, s)
     InstM f <*> InstM x = InstM $ \s -> let (f', s') = f s
                                             (x', s'') = x s'
                                         in (f' x', s'')
 
 instance Monad InstM where
-    return = A.pure
+    return = pure
     InstM m >>= f = InstM $ \s -> let (x, s') = m s
                                   in runInstM (f x) s'
 
@@ -259,20 +256,20 @@ toReadyComponents pid_map subst0 comps
         -> InstM (Maybe ReadyComponent)
     instantiateComponent uid cid insts
       | Just lc <- Map.lookup cid cmap = do
-            provides <- T.mapM (substModule insts) (modShapeProvides (lc_shape lc))
+            provides <- traverse (substModule insts) (modShapeProvides (lc_shape lc))
             -- NB: lc_sig_includes is omitted here, because we don't
             -- need them to build
             includes <- forM (lc_includes lc) $ \ci -> do
                 uid' <- substUnitId insts (ci_id ci)
                 return ci { ci_ann_id = fmap (const uid') (ci_ann_id ci) }
-            exe_deps <- mapM (substExeDep insts) (lc_exe_deps lc)
+            exe_deps <- traverse (substExeDep insts) (lc_exe_deps lc)
             s <- InstM $ \s -> (s, s)
             let getDep (Module dep_def_uid _)
                     | let dep_uid = unDefUnitId dep_def_uid
                     -- Lose DefUnitId invariant for rc_depends
                     = [(dep_uid,
                           fromMaybe err_pid $
-                            Map.lookup dep_uid pid_map A.<|>
+                            Map.lookup dep_uid pid_map <|>
                             fmap rc_munged_id (join (Map.lookup dep_uid s)))]
                   where
                     err_pid = MungedPackageId
@@ -313,7 +310,7 @@ toReadyComponents pid_map subst0 comps
     substSubst :: Map ModuleName Module
                -> Map ModuleName OpenModule
                -> InstM (Map ModuleName Module)
-    substSubst subst insts = T.mapM (substModule subst) insts
+    substSubst subst insts = traverse (substModule subst) insts
 
     substModule :: Map ModuleName Module -> OpenModule -> InstM Module
     substModule subst (OpenModuleVar mod_name)
@@ -346,7 +343,7 @@ toReadyComponents pid_map subst0 comps
                     then do uid' <- substUnitId Map.empty (ci_id ci)
                             return $ ci { ci_ann_id = fmap (const (DefiniteUnitId uid')) (ci_ann_id ci) }
                     else return ci
-            exe_deps <- mapM (substExeDep Map.empty) (lc_exe_deps lc)
+            exe_deps <- traverse (substExeDep Map.empty) (lc_exe_deps lc)
             let indefc = IndefiniteComponent {
                         indefc_requires = map fst (lc_insts lc),
                         indefc_provides = modShapeProvides (lc_shape lc),

Cabal/Distribution/Backpack/UnifyM.hs

@@ -70,7 +70,6 @@ import qualified Data.Map as Map
 import qualified Data.Set as Set
 import Data.IntMap (IntMap)
 import qualified Data.IntMap as IntMap
-import qualified Data.Traversable as T
 import Text.PrettyPrint
 
 -- TODO: more detailed trace output on high verbosity would probably
@@ -321,7 +320,7 @@ convertUnitId' _ (DefiniteUnitId uid) =
 convertUnitId' stk (IndefFullUnitId cid insts) = do
     fs <- fmap unify_uniq getUnifEnv
     x <- liftST $ UnionFind.fresh (error "convertUnitId") -- tie the knot later
-    insts_u <- T.forM insts $ convertModule' (extendMuEnv stk x)
+    insts_u <- for insts $ convertModule' (extendMuEnv stk x)
     u <- readUnifRef fs
     writeUnifRef fs (u+1)
     y <- liftST $ UnionFind.fresh (UnitIdU u cid insts_u)
@@ -359,11 +358,11 @@ type ModuleSubstU s = Map ModuleName (ModuleU s)
 
 -- | Conversion of 'ModuleSubst' to 'ModuleSubstU'
 convertModuleSubst :: Map ModuleName OpenModule -> UnifyM s (Map ModuleName (ModuleU s))
-convertModuleSubst = T.mapM convertModule
+convertModuleSubst = traverse convertModule
 
 -- | Conversion of 'ModuleSubstU' to 'ModuleSubst'
 convertModuleSubstU :: ModuleSubstU s -> UnifyM s OpenModuleSubst
-convertModuleSubstU = T.mapM convertModuleU
+convertModuleSubstU = traverse convertModuleU
 
 -----------------------------------------------------------------------
 -- Conversion from the unifiable data types
@@ -400,7 +399,7 @@ convertUnitIdU' stk uid_u = do
                     failWith (text "Unsupported mutually recursive unit identifier")
                     -- return (UnitIdVar i)
                 Nothing -> do
-                    insts <- T.forM insts_u $ convertModuleU' (extendMooEnv stk u)
+                    insts <- for insts_u $ convertModuleU' (extendMooEnv stk u)
                     return (IndefFullUnitId cid insts)
 
 convertModuleU' :: MooEnv -> ModuleU s -> UnifyM s OpenModule
@@ -615,11 +614,11 @@ convertModuleScopeU (provs_u, reqs_u) = do
 
 -- | Convert a 'ModuleProvides' to a 'ModuleProvidesU'
 convertModuleProvides :: ModuleProvides -> UnifyM s (ModuleProvidesU s)
-convertModuleProvides = T.mapM (mapM (T.mapM convertModule))
+convertModuleProvides = traverse (traverse (traverse convertModule))
 
 -- | Convert a 'ModuleProvidesU' to a 'ModuleProvides'
 convertModuleProvidesU :: ModuleProvidesU s -> UnifyM s ModuleProvides
-convertModuleProvidesU = T.mapM (mapM (T.mapM convertModuleU))
+convertModuleProvidesU = traverse (traverse (traverse convertModuleU))
 
 convertModuleRequires :: ModuleRequires -> UnifyM s (ModuleRequiresU s)
 convertModuleRequires = convertModuleProvides

Cabal/Distribution/Compat/CopyFile.hs

@@ -14,13 +14,11 @@ module Distribution.Compat.CopyFile (
 import Prelude ()
 import Distribution.Compat.Prelude
 
-import Distribution.Compat.Exception
-
 #ifndef mingw32_HOST_OS
 import Distribution.Compat.Internal.TempFile
 
 import Control.Exception
-         ( bracketOnError, throwIO )
+         ( bracketOnError )
 import qualified Data.ByteString.Lazy as BSL
 import System.IO.Error
          ( ioeSetLocation )
@@ -43,8 +41,6 @@ import Foreign.C
 
 #else /* else mingw32_HOST_OS */
 
-import Control.Exception
-  ( throwIO )
 import qualified Data.ByteString.Lazy as BSL
 import System.IO.Error
   ( ioeSetLocation )

Cabal/Distribution/Compat/Exception.hs

@@ -6,22 +6,32 @@ module Distribution.Compat.Exception (
   displayException,
   ) where
 
+#ifdef MIN_VERSION_base
+#define MINVER_base_48 MIN_VERSION_base(4,8,0)
+#else
+#define MINVER_base_48 (__GLASGOW_HASKELL__ >= 710)
+#endif
+
 import System.Exit
 import qualified Control.Exception as Exception
-#if __GLASGOW_HASKELL__ >= 710
+
+#if MINVER_base_48
 import Control.Exception (displayException)
 #endif
 
+-- | Try 'IOException'.
 tryIO :: IO a -> IO (Either Exception.IOException a)
 tryIO = Exception.try
 
+-- | Catch 'IOException'.
 catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a
 catchIO = Exception.catch
 
+-- | Catch 'ExitCode'
 catchExit :: IO a -> (ExitCode -> IO a) -> IO a
 catchExit = Exception.catch
 
-#if __GLASGOW_HASKELL__ < 710
+#if !MINVER_base_48
 displayException :: Exception.Exception e => e -> String
 displayException = show
 #endif

Cabal/Distribution/Compat/Graph.hs

@@ -88,7 +88,6 @@ import Distribution.Compat.Prelude hiding (empty, lookup, null, toList)
 import Prelude ()
 
 import Data.Array                    ((!))
-import Data.Either                   (partitionEithers)
 import Data.Graph                    (SCC (..))
 import Distribution.Utils.Structured (Structure (..), Structured (..))
 

Cabal/Distribution/Compat/Lens.hs

@@ -50,7 +50,6 @@ module Distribution.Compat.Lens (
 import Prelude()
 import Distribution.Compat.Prelude
 
-import Control.Applicative (Const (..))
 import Control.Monad.State.Class (MonadState (..), gets, modify)
 
 import qualified Distribution.Compat.DList as DList