Skip to content

Commit

Permalink
Make cabal-install compilable with NoImplicitPrelude
Browse files Browse the repository at this point in the history
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)
  • Loading branch information
phadej committed May 18, 2020
1 parent a4f2082 commit 2b44384
Show file tree
Hide file tree
Showing 199 changed files with 714 additions and 846 deletions.
19 changes: 8 additions & 11 deletions Cabal/Distribution/Backpack/LinkedComponent.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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.
Expand All @@ -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
Expand All @@ -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
Expand Down
17 changes: 7 additions & 10 deletions Cabal/Distribution/Backpack/ReadyComponent.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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'

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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),
Expand Down
13 changes: 6 additions & 7 deletions Cabal/Distribution/Backpack/UnifyM.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
6 changes: 1 addition & 5 deletions Cabal/Distribution/Compat/CopyFile.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 )
Expand All @@ -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 )
Expand Down
14 changes: 12 additions & 2 deletions Cabal/Distribution/Compat/Exception.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
1 change: 0 additions & 1 deletion Cabal/Distribution/Compat/Graph.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 (..))

Expand Down
1 change: 0 additions & 1 deletion Cabal/Distribution/Compat/Lens.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Loading

0 comments on commit 2b44384

Please sign in to comment.