Skip to content

Commit d4d3ca0

Browse files
mgsloanmgsloan
authored
Merge branch 'master' into multiword-ghc-options
2 parents c30d959 + 838b199 commit d4d3ca0

12 files changed

Lines changed: 122 additions & 75 deletions

File tree

‎ChangeLog.md‎

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -19,6 +19,13 @@ Behavior changes:
1919
currently have, Stack will automatically download and install that
2020
GHC. You can explicitly set `install-ghc: false` or pass the flag
2121
`--no-install-ghc` to regain the previous behavior.
22+
* `stack ghci` no longer loads modules grouped by package. This is
23+
always an improvement for plain ghci - it makes loading faster and
24+
less noisy. For intero, this has the side-effect that it will no
25+
longer load multiple packages that depend on TH loading relative
26+
paths. TH relative paths will still work when loading a single
27+
package into intero. See
28+
[#3309](https://github.com/commercialhaskell/stack/issues/3309)
2229

2330
Other enhancements:
2431

@@ -45,6 +52,9 @@ Other enhancements:
4552
* `--ghc-options` and `--ghcjs-boot-options` now parse their input, so
4653
multiple arguments can be passed in one option.
4754
See [#3315](https://github.com/commercialhaskell/stack/issues/3315)
55+
* Added `stack ghci --only-main` flag, to skip loading / importing
56+
all but main modules. See the ghci documentation page
57+
for further info.
4858

4959
Bug fixes:
5060

‎doc/GUIDE.md‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1985,7 +1985,7 @@ the following (or add it to `.bashrc`):
19851985
eval "$(stack --bash-completion-script stack)"
19861986
19871987
For more information and other shells, see [the Shell auto-completion wiki
1988-
page](https://github.com/commercialhaskell/stack/wiki/Shell-autocompletion)
1988+
page](https://docs.haskellstack.org/en/stable/shell_autocompletion)
19891989
19901990
### Docker
19911991

‎doc/faq.md‎

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -521,4 +521,8 @@ where you keep your SSL certificates.
521521
Unfortunately `stack build` does not have an obvious equivalent to `cabal build -vN` which shows verbose output from GHC when building. The easiest workaround is to add `ghc-options: -vN` to the .cabal file or pass it via `stack build --ghc-options="-v"`.
522522
523523
## Does Stack support the Hpack specification?
524-
Yes. You can run `stack init` as usual and Stack will create a matching `stack.yaml`.
524+
525+
Yes:
526+
527+
* If a package directory contains an Hpack `package.yaml` file, then Stack will use it to generate a `.cabal` file when building the package.
528+
* You can run `stack init` to initialize a `stack.yaml` file regardless of whether your packages are declared with `.cabal` files or with Hpack `package.yaml` files.

‎doc/ghci.md‎

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -31,6 +31,25 @@ There are two ways to speed up the initial startup of ghci:
3131
* `--no-load`, to skip loading all defined modules into ghci. You can then
3232
directly use `:load MyModule` to load a specific module in your project.
3333

34+
## Loading just the main module
35+
36+
By default, `stack ghci` loads and imports all of the modules in the package.
37+
This allows you to easily use anything exported by your package. This is
38+
usually quite convenient, but in some cases it makes sense to only load one
39+
module, or no modules at all. The `--only-main` flag allows this. It specifies
40+
that only the main module will be loaded, if any. This is particularly useful
41+
in the following circumstances:
42+
43+
1. You're loading the project in order to run it in ghci (e.g. via `main`), and
44+
you intend to reload while developing. Without the `--only-main` flag, you
45+
will need to quit and restart ghci whenever a module gets deleted. With the
46+
flag, reloading should work fine in this case.
47+
48+
2. If many of your modules have exports named the same thing, then you'll need to
49+
refer to them using qualified names. To avoid this, it may be easier to use
50+
`--only-main` to start with a blank slate and just import the modules you are
51+
interested in.
52+
3453
## Loading a filepath directly
3554

3655
Instead of the `TARGET` syntax, it is also possible to directly run

‎doc/yaml_configuration.md‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -27,7 +27,7 @@ project, not in the user or global config files.
2727

2828
> Note: We define **project** to mean a directory that contains a `stack.yaml`
2929
> file, which specifies how to build a set of packages. We define **package** to
30-
> be a package with a `.cabal` file.
30+
> be a package with a `.cabal` file or Hpack `package.yaml` file.
3131
3232
In your project-specific options, you specify both **which local packages** to
3333
build and **which dependencies to use** when building these packages. Unlike the

‎etc/scripts/get-stack.sh‎

Lines changed: 13 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -465,9 +465,20 @@ install_from_bindist() {
465465
fi
466466
STACK_TEMP_EXE="$STACK_TEMP_DIR/$(basename "$DEST")"
467467
mv "$STACK_TEMP_DIR/$1"/*/stack "$STACK_TEMP_EXE"
468+
destdir="$(dirname "$DEST")"
469+
if [ ! -d "$destdir" ]; then
470+
info "$destdir directory does not exist; creating it..."
471+
# First try to create directory as current user, then try with sudo if it fails.
472+
if ! mkdir -p "$destdir" 2>/dev/null; then
473+
if ! sudocmd mkdir -p "$destdir"; then
474+
die "Could not create directory: $DEST"
475+
fi
476+
fi
477+
fi
468478
# First attempt to install 'stack' as current user, then try with sudo if it fails
469-
if ! install -c -m 0755 "$STACK_TEMP_EXE" "$(dirname "$DEST")" 2>/dev/null; then
470-
if ! sudocmd install -c -o 0 -g 0 -m 0755 "$STACK_TEMP_EXE" "$(dirname "$DEST")"; then
479+
info "Installing Stack to: $DEST..."
480+
if ! install -c -m 0755 "$STACK_TEMP_EXE" "$destdir" 2>/dev/null; then
481+
if ! sudocmd install -c -o 0 -g 0 -m 0755 "$STACK_TEMP_EXE" "$destdir"; then
471482
die "Install to $DEST failed"
472483
fi
473484
fi

‎src/Stack/Clean.hs‎

Lines changed: 12 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,8 @@
22
{-# LANGUAGE ConstraintKinds #-}
33
{-# LANGUAGE DeriveDataTypeable #-}
44
{-# LANGUAGE FlexibleContexts #-}
5+
{-# LANGUAGE TemplateHaskell #-}
6+
{-# LANGUAGE OverloadedStrings #-}
57

68
-- | Clean a project.
79
module Stack.Clean
@@ -13,19 +15,27 @@ module Stack.Clean
1315
import Stack.Prelude
1416
import Data.List ((\\),intercalate)
1517
import qualified Data.Map.Strict as Map
18+
import qualified Data.Text as T
1619
import Path.IO (ignoringAbsence, removeDirRecur)
1720
import Stack.Config (getLocalPackages)
1821
import Stack.Constants.Config (distDirFromDir, workDirFromDir)
1922
import Stack.Types.PackageName
2023
import Stack.Types.Config
24+
import System.Exit (exitFailure)
2125

2226
-- | Deletes build artifacts in the current project.
2327
--
2428
-- Throws 'StackCleanException'.
2529
clean :: HasEnvConfig env => CleanOpts -> RIO env ()
2630
clean cleanOpts = do
27-
dirs <- dirsToDelete cleanOpts
28-
liftIO $ forM_ dirs (ignoringAbsence . removeDirRecur)
31+
failures <- mapM cleanDir =<< dirsToDelete cleanOpts
32+
when (or failures) $ liftIO exitFailure
33+
where
34+
cleanDir dir =
35+
liftIO (ignoringAbsence (removeDirRecur dir) >> return False) `catchAny` \ex -> do
36+
$logError $ "Exception while recursively deleting " <> T.pack (toFilePath dir) <> "\n" <> T.pack (show ex)
37+
$logError "Perhaps you do not have permission to delete these files or they are in use?"
38+
return True
2939

3040
dirsToDelete :: HasEnvConfig env => CleanOpts -> RIO env [Path Abs Dir]
3141
dirsToDelete cleanOpts = do

‎src/Stack/Ghci.hs‎

Lines changed: 39 additions & 49 deletions
Original file line numberDiff line numberDiff line change
@@ -15,10 +15,6 @@ module Stack.Ghci
1515
, GhciPkgInfo(..)
1616
, GhciException(..)
1717
, ghci
18-
19-
-- TODO: Address what should and should not be exported.
20-
, renderScriptGhci
21-
, renderScriptIntero
2218
) where
2319

2420
import Stack.Prelude
@@ -72,6 +68,7 @@ data GhciOpts = GhciOpts
7268
, ghciSkipIntermediate :: !Bool
7369
, ghciHidePackages :: !Bool
7470
, ghciNoBuild :: !Bool
71+
, ghciOnlyMain :: !Bool
7572
} deriving Show
7673

7774
-- | Necessary information to load a package or its components.
@@ -331,72 +328,65 @@ runGhci GhciOpts{..} targets mainIsTargets pkgs extraFiles = do
331328
-- is included.
332329
(if null pkgs then id else ("-i" : )) $
333330
odir <> pkgopts <> map T.unpack ghciGhcOptions <> ghciArgs <> extras)
334-
interrogateExeForRenderFunction = do
335-
menv <- liftIO $ configEnvOverride config defaultEnvSettings
336-
output <- execObserve menv (fromMaybe (compilerExeName wc) ghciGhcCommand) ["--version"]
337-
if "Intero" `isPrefixOf` output
338-
then return renderScriptIntero
339-
else return renderScriptGhci
331+
-- TODO: Consider optimizing this check. Perhaps if no
332+
-- "with-ghc" is specified, assume that it is not using intero.
333+
checkIsIntero =
334+
-- Optimization dependent on the behavior of renderScript -
335+
-- it doesn't matter if it's intero or ghci when loading
336+
-- multiple packages.
337+
case pkgs of
338+
[_] -> do
339+
menv <- liftIO $ configEnvOverride config defaultEnvSettings
340+
output <- execObserve menv (fromMaybe (compilerExeName wc) ghciGhcCommand) ["--version"]
341+
return $ "Intero" `isPrefixOf` output
342+
_ -> return False
340343
withSystemTempDir "ghci" $ \tmpDirectory -> do
341344
macrosOptions <- writeMacrosFile tmpDirectory pkgs
342345
if ghciNoLoadModules
343346
then execGhci macrosOptions
344347
else do
345348
checkForDuplicateModules pkgs
346-
renderFn <- interrogateExeForRenderFunction
349+
isIntero <- checkIsIntero
347350
bopts <- view buildOptsL
348351
mainFile <- figureOutMainFile bopts mainIsTargets targets pkgs
349-
scriptPath <- writeGhciScript tmpDirectory (renderFn pkgs mainFile extraFiles)
352+
scriptPath <- writeGhciScript tmpDirectory (renderScript isIntero pkgs mainFile ghciOnlyMain extraFiles)
350353
execGhci (macrosOptions ++ ["-ghci-script=" <> toFilePath scriptPath])
351354

352355
writeMacrosFile :: (MonadIO m) => Path Abs Dir -> [GhciPkgInfo] -> m [String]
353356
writeMacrosFile tmpDirectory packages = do
354-
preprocessCabalMacros packages macrosFile
357+
preprocessCabalMacros packages macrosFile
355358
where
356359
macrosFile = tmpDirectory </> $(mkRelFile "cabal_macros.h")
357360

358361
writeGhciScript :: (MonadIO m) => Path Abs Dir -> GhciScript -> m (Path Abs File)
359362
writeGhciScript tmpDirectory script = do
360-
liftIO $ scriptToFile scriptPath script
361-
setScriptPerms scriptFilePath
362-
return scriptPath
363+
liftIO $ scriptToFile scriptPath script
364+
setScriptPerms scriptFilePath
365+
return scriptPath
363366
where
364367
scriptPath = tmpDirectory </> $(mkRelFile "ghci-script")
365368
scriptFilePath = toFilePath scriptPath
366369

367-
findOwningPackageForMain :: [GhciPkgInfo] -> Path Abs File -> Maybe GhciPkgInfo
368-
findOwningPackageForMain pkgs mainFile =
369-
find (\pkg -> toFilePath (ghciPkgDir pkg) `isPrefixOf` toFilePath mainFile) pkgs
370-
371-
renderScriptGhci :: [GhciPkgInfo] -> Maybe (Path Abs File) -> [Path Abs File] -> GhciScript
372-
renderScriptGhci pkgs mainFile extraFiles =
373-
let addPhase = mconcat $ fmap renderPkg pkgs
374-
mainPhase = case mainFile of
375-
Just path -> cmdAddFile path
376-
Nothing -> mempty
377-
modulePhase = cmdModule $ foldl' S.union S.empty (fmap ghciPkgModules pkgs)
378-
in case getFileTargets pkgs <> extraFiles of
379-
[] -> addPhase <> mainPhase <> modulePhase
380-
fileTargets -> mconcat $ map cmdAddFile fileTargets
381-
where
382-
renderPkg pkg = cmdAdd (ghciPkgModules pkg)
383-
384-
renderScriptIntero :: [GhciPkgInfo] -> Maybe (Path Abs File) -> [Path Abs File] -> GhciScript
385-
renderScriptIntero pkgs mainFile extraFiles =
386-
let addPhase = mconcat $ fmap renderPkg pkgs
387-
mainPhase = case mainFile of
388-
Just path ->
389-
case findOwningPackageForMain pkgs path of
390-
Just mainPkg -> cmdCdGhc (ghciPkgDir mainPkg) <> cmdAddFile path
391-
Nothing -> cmdAddFile path
392-
Nothing -> mempty
393-
modulePhase = cmdModule $ foldl' S.union S.empty (fmap ghciPkgModules pkgs)
394-
in case getFileTargets pkgs <> extraFiles of
395-
[] -> addPhase <> mainPhase <> modulePhase
396-
fileTargets -> mconcat $ map cmdAddFile fileTargets
397-
where
398-
renderPkg pkg = cmdCdGhc (ghciPkgDir pkg)
399-
<> cmdAdd (ghciPkgModules pkg)
370+
renderScript :: Bool -> [GhciPkgInfo] -> Maybe (Path Abs File) -> Bool -> [Path Abs File] -> GhciScript
371+
renderScript isIntero pkgs mainFile onlyMain extraFiles = do
372+
let cdPhase = case (isIntero, pkgs) of
373+
-- If only loading one package, set the cwd properly.
374+
-- Otherwise don't try. See
375+
-- https://github.com/commercialhaskell/stack/issues/3309
376+
(True, [pkg]) -> cmdCdGhc (ghciPkgDir pkg)
377+
_ -> mempty
378+
addPhase = cmdAdd $ S.fromList (map Left allModules ++ addMain)
379+
addMain = case mainFile of
380+
Just path -> [Right path]
381+
_ -> []
382+
modulePhase = cmdModule $ S.fromList allModules
383+
allModules = concatMap (S.toList . ghciPkgModules) pkgs
384+
case getFileTargets pkgs <> extraFiles of
385+
[] ->
386+
if onlyMain
387+
then cdPhase <> if isJust mainFile then cmdAdd (S.fromList addMain) else mempty
388+
else cdPhase <> addPhase <> modulePhase
389+
fileTargets -> cmdAdd (S.fromList (map Right fileTargets))
400390

401391
-- Hacky check if module / main phase should be omitted. This should be
402392
-- improved if / when we have a better per-component load.

‎src/Stack/Ghci/Script.hs‎

Lines changed: 5 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,6 @@ module Stack.Ghci.Script
66
, ModuleName
77

88
, cmdAdd
9-
, cmdAddFile
109
, cmdCdGhc
1110
, cmdModule
1211

@@ -33,18 +32,14 @@ instance Monoid GhciScript where
3332
(GhciScript xs) `mappend` (GhciScript ys) = GhciScript (ys <> xs)
3433

3534
data GhciCommand
36-
= Add (Set ModuleName)
37-
| AddFile (Path Abs File)
35+
= Add (Set (Either ModuleName (Path Abs File)))
3836
| CdGhc (Path Abs Dir)
3937
| Module (Set ModuleName)
4038
deriving (Show)
4139

42-
cmdAdd :: Set ModuleName -> GhciScript
40+
cmdAdd :: Set (Either ModuleName (Path Abs File)) -> GhciScript
4341
cmdAdd = GhciScript . (:[]) . Add
4442

45-
cmdAddFile :: Path Abs File -> GhciScript
46-
cmdAddFile = GhciScript . (:[]) . AddFile
47-
4843
cmdCdGhc :: Path Abs Dir -> GhciScript
4944
cmdCdGhc = GhciScript . (:[]) . CdGhc
5045

@@ -79,13 +74,11 @@ commandToBuilder (Add modules)
7974
| S.null modules = mempty
8075
| otherwise =
8176
fromText ":add "
82-
<> mconcat (intersperse (fromText " ")
83-
$ (stringUtf8 . quoteFileName . mconcat . intersperse "." . components) <$> S.toAscList modules)
77+
<> mconcat (intersperse (fromText " ") $
78+
fmap (stringUtf8 . quoteFileName . either (mconcat . intersperse "." . components) toFilePath)
79+
(S.toAscList modules))
8480
<> fromText "\n"
8581

86-
commandToBuilder (AddFile path) =
87-
fromText ":add " <> stringUtf8 (quoteFileName (toFilePath path)) <> fromText "\n"
88-
8982
commandToBuilder (CdGhc path) =
9083
fromText ":cd-ghc " <> stringUtf8 (quoteFileName (toFilePath path)) <> fromText "\n"
9184

‎src/Stack/Options/GhciParser.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -53,3 +53,4 @@ ghciOptsParser = GhciOpts
5353
<*> switch (long "skip-intermediate-deps" <> help "Skip loading intermediate target dependencies" <> internal)
5454
<*> boolFlags True "package-hiding" "package hiding" idm
5555
<*> switch (long "no-build" <> help "Don't build before launching GHCi" <> internal)
56+
<*> switch (long "only-main" <> help "Only load and import the main module. If no main module, no modules will be loaded.")

0 commit comments

Comments
 (0)