Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Make cabal-install compilable with NoImplicitPrelude #6818

Merged
merged 1 commit into from
May 19, 2020
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
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