Compare commits
20 Commits
small-ci
...
readDirEnt
| Author | SHA1 | Date | |
|---|---|---|---|
|
6d3e8d65e1
|
|||
|
895e4b3f18
|
|||
|
20f0505120
|
|||
|
31e83cac5e
|
|||
|
d3a1115b99
|
|||
|
6d46849fec
|
|||
|
53e324bfee
|
|||
|
2e39b7b603
|
|||
|
048932bf50
|
|||
|
69d325bf90
|
|||
|
3d1b8859cd
|
|||
|
db89ca9942
|
|||
|
bba009d98c
|
|||
|
9d954ea174
|
|||
|
da9c9049d2
|
|||
|
a4c00d2c56
|
|||
|
|
b30f565871 | ||
|
|
fa378a1d34 | ||
|
|
119efb1ff4 | ||
|
1fb4101b49
|
2
.github/scripts/bootstrap.sh
vendored
2
.github/scripts/bootstrap.sh
vendored
@@ -13,4 +13,6 @@ git describe --always
|
|||||||
./scripts/bootstrap/bootstrap-haskell
|
./scripts/bootstrap/bootstrap-haskell
|
||||||
|
|
||||||
[ "$(ghc --numeric-version)" = "${BOOTSTRAP_HASKELL_GHC_VERSION}" ]
|
[ "$(ghc --numeric-version)" = "${BOOTSTRAP_HASKELL_GHC_VERSION}" ]
|
||||||
|
# https://github.com/actions/runner-images/issues/7061
|
||||||
|
[ "$(ghcup config | grep --color=never meta-mode)" = "meta-mode: Lax" ]
|
||||||
|
|
||||||
|
|||||||
4
.github/workflows/docker.yaml
vendored
4
.github/workflows/docker.yaml
vendored
@@ -26,7 +26,9 @@ jobs:
|
|||||||
context: ./docker/alpine32
|
context: ./docker/alpine32
|
||||||
push: true
|
push: true
|
||||||
tags: hasufell/i386-alpine-haskell:3.12
|
tags: hasufell/i386-alpine-haskell:3.12
|
||||||
platforms: linux/i386
|
platforms: |
|
||||||
|
linux/i386
|
||||||
|
linux/amd64
|
||||||
|
|
||||||
docker-alpine:
|
docker-alpine:
|
||||||
runs-on: ubuntu-latest
|
runs-on: ubuntu-latest
|
||||||
|
|||||||
@@ -59,7 +59,7 @@ data ConfigCommand
|
|||||||
--[ Parsers ]--
|
--[ Parsers ]--
|
||||||
---------------
|
---------------
|
||||||
|
|
||||||
|
|
||||||
configP :: Parser ConfigCommand
|
configP :: Parser ConfigCommand
|
||||||
configP = subparser
|
configP = subparser
|
||||||
( command "init" initP
|
( command "init" initP
|
||||||
@@ -120,21 +120,38 @@ formatConfig :: UserSettings -> String
|
|||||||
formatConfig = UTF8.toString . Y.encode
|
formatConfig = UTF8.toString . Y.encode
|
||||||
|
|
||||||
|
|
||||||
updateSettings :: UserSettings -> Settings -> Settings
|
updateSettings :: UserSettings -> UserSettings -> UserSettings
|
||||||
updateSettings UserSettings{..} Settings{..} =
|
updateSettings usl usr =
|
||||||
let cache' = fromMaybe cache uCache
|
let cache' = uCache usl <|> uCache usr
|
||||||
metaCache' = fromMaybe metaCache uMetaCache
|
metaCache' = uMetaCache usl <|> uMetaCache usr
|
||||||
metaMode' = fromMaybe metaMode uMetaMode
|
metaMode' = uMetaMode usl <|> uMetaMode usr
|
||||||
noVerify' = fromMaybe noVerify uNoVerify
|
noVerify' = uNoVerify usl <|> uNoVerify usr
|
||||||
keepDirs' = fromMaybe keepDirs uKeepDirs
|
verbose' = uVerbose usl <|> uVerbose usr
|
||||||
downloader' = fromMaybe downloader uDownloader
|
keepDirs' = uKeepDirs usl <|> uKeepDirs usr
|
||||||
verbose' = fromMaybe verbose uVerbose
|
downloader' = uDownloader usl <|> uDownloader usr
|
||||||
urlSource' = fromMaybe urlSource uUrlSource
|
urlSource' = uUrlSource usl <|> uUrlSource usr
|
||||||
noNetwork' = fromMaybe noNetwork uNoNetwork
|
noNetwork' = uNoNetwork usl <|> uNoNetwork usr
|
||||||
gpgSetting' = fromMaybe gpgSetting uGPGSetting
|
gpgSetting' = uGPGSetting usl <|> uGPGSetting usr
|
||||||
platformOverride' = uPlatformOverride <|> platformOverride
|
platformOverride' = uPlatformOverride usl <|> uPlatformOverride usr
|
||||||
mirrors' = fromMaybe mirrors uMirrors
|
mirrors' = uMirrors usl <|> uMirrors usr
|
||||||
in Settings cache' metaCache' metaMode' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor platformOverride' mirrors'
|
in UserSettings cache' metaCache' metaMode' noVerify' verbose' keepDirs' downloader' (updateKeyBindings (uKeyBindings usl) (uKeyBindings usr)) urlSource' noNetwork' gpgSetting' platformOverride' mirrors'
|
||||||
|
where
|
||||||
|
updateKeyBindings :: Maybe UserKeyBindings -> Maybe UserKeyBindings -> Maybe UserKeyBindings
|
||||||
|
updateKeyBindings Nothing Nothing = Nothing
|
||||||
|
updateKeyBindings (Just kbl) Nothing = Just kbl
|
||||||
|
updateKeyBindings Nothing (Just kbr) = Just kbr
|
||||||
|
updateKeyBindings (Just kbl) (Just kbr) =
|
||||||
|
Just $ UserKeyBindings {
|
||||||
|
kUp = kUp kbl <|> kUp kbr
|
||||||
|
, kDown = kDown kbl <|> kDown kbr
|
||||||
|
, kQuit = kQuit kbl <|> kQuit kbr
|
||||||
|
, kInstall = kInstall kbl <|> kInstall kbr
|
||||||
|
, kUninstall = kUninstall kbl <|> kUninstall kbr
|
||||||
|
, kSet = kSet kbl <|> kSet kbr
|
||||||
|
, kChangelog = kChangelog kbl <|> kChangelog kbr
|
||||||
|
, kShowAll = kShowAll kbl <|> kShowAll kbr
|
||||||
|
, kShowAllTools = kShowAllTools kbl <|> kShowAllTools kbr
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -151,10 +168,11 @@ config :: forall m. ( Monad m
|
|||||||
)
|
)
|
||||||
=> ConfigCommand
|
=> ConfigCommand
|
||||||
-> Settings
|
-> Settings
|
||||||
|
-> UserSettings
|
||||||
-> KeyBindings
|
-> KeyBindings
|
||||||
-> (ReaderT LeanAppState m () -> m ())
|
-> (ReaderT LeanAppState m () -> m ())
|
||||||
-> m ExitCode
|
-> m ExitCode
|
||||||
config configCommand settings keybindings runLogger = case configCommand of
|
config configCommand settings userConf keybindings runLogger = case configCommand of
|
||||||
InitConfig -> do
|
InitConfig -> do
|
||||||
path <- getConfigFilePath
|
path <- getConfigFilePath
|
||||||
liftIO $ writeFile path $ formatConfig $ fromSettings settings (Just keybindings)
|
liftIO $ writeFile path $ formatConfig $ fromSettings settings (Just keybindings)
|
||||||
@@ -203,9 +221,9 @@ config configCommand settings keybindings runLogger = case configCommand of
|
|||||||
where
|
where
|
||||||
doConfig :: MonadIO m => UserSettings -> m ()
|
doConfig :: MonadIO m => UserSettings -> m ()
|
||||||
doConfig usersettings = do
|
doConfig usersettings = do
|
||||||
let settings' = updateSettings usersettings settings
|
let settings' = updateSettings usersettings userConf
|
||||||
path <- liftIO getConfigFilePath
|
path <- liftIO getConfigFilePath
|
||||||
liftIO $ writeFile path $ formatConfig $ fromSettings settings' (Just keybindings)
|
liftIO $ writeFile path $ formatConfig $ settings'
|
||||||
runLogger $ logDebug $ T.pack $ show settings'
|
runLogger $ logDebug $ T.pack $ show settings'
|
||||||
pure ()
|
pure ()
|
||||||
|
|
||||||
|
|||||||
@@ -259,7 +259,7 @@ set :: forall m env.
|
|||||||
-> m (VEither eff GHCTargetVersion))
|
-> m (VEither eff GHCTargetVersion))
|
||||||
-> (ReaderT LeanAppState m () -> m ())
|
-> (ReaderT LeanAppState m () -> m ())
|
||||||
-> m ExitCode
|
-> m ExitCode
|
||||||
set setCommand runAppState runLeanAppState runLogger = case setCommand of
|
set setCommand runAppState _ runLogger = case setCommand of
|
||||||
(Right sopts) -> do
|
(Right sopts) -> do
|
||||||
runLogger (logWarn "This is an old-style command for setting GHC. Use 'ghcup set ghc' instead.")
|
runLogger (logWarn "This is an old-style command for setting GHC. Use 'ghcup set ghc' instead.")
|
||||||
setGHC' sopts
|
setGHC' sopts
|
||||||
@@ -271,10 +271,7 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
|
|||||||
where
|
where
|
||||||
setGHC' :: SetOptions
|
setGHC' :: SetOptions
|
||||||
-> m ExitCode
|
-> m ExitCode
|
||||||
setGHC' SetOptions{ sToolVer } =
|
setGHC' SetOptions{ sToolVer } = runSetGHC runAppState (do
|
||||||
case sToolVer of
|
|
||||||
(SetGHCVersion v) -> runSetGHC runLeanAppState (liftE $ setGHC v SetGHCOnly Nothing >> pure v)
|
|
||||||
_ -> runSetGHC runAppState (do
|
|
||||||
v <- liftE $ fst <$> fromVersion' sToolVer GHC
|
v <- liftE $ fst <$> fromVersion' sToolVer GHC
|
||||||
liftE $ setGHC v SetGHCOnly Nothing
|
liftE $ setGHC v SetGHCOnly Nothing
|
||||||
)
|
)
|
||||||
@@ -291,10 +288,7 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
|
|||||||
|
|
||||||
setCabal' :: SetOptions
|
setCabal' :: SetOptions
|
||||||
-> m ExitCode
|
-> m ExitCode
|
||||||
setCabal' SetOptions{ sToolVer } =
|
setCabal' SetOptions{ sToolVer } = runSetCabal runAppState (do
|
||||||
case sToolVer of
|
|
||||||
(SetToolVersion v) -> runSetCabal runLeanAppState (liftE $ setCabal v >> pure (mkTVer v))
|
|
||||||
_ -> runSetCabal runAppState (do
|
|
||||||
v <- liftE $ fst <$> fromVersion' sToolVer Cabal
|
v <- liftE $ fst <$> fromVersion' sToolVer Cabal
|
||||||
liftE $ setCabal (_tvVersion v)
|
liftE $ setCabal (_tvVersion v)
|
||||||
pure v
|
pure v
|
||||||
@@ -311,10 +305,7 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
|
|||||||
|
|
||||||
setHLS' :: SetOptions
|
setHLS' :: SetOptions
|
||||||
-> m ExitCode
|
-> m ExitCode
|
||||||
setHLS' SetOptions{ sToolVer } =
|
setHLS' SetOptions{ sToolVer } = runSetHLS runAppState (do
|
||||||
case sToolVer of
|
|
||||||
(SetToolVersion v) -> runSetHLS runLeanAppState (liftE $ setHLS v SetHLSOnly Nothing >> pure (mkTVer v))
|
|
||||||
_ -> runSetHLS runAppState (do
|
|
||||||
v <- liftE $ fst <$> fromVersion' sToolVer HLS
|
v <- liftE $ fst <$> fromVersion' sToolVer HLS
|
||||||
liftE $ setHLS (_tvVersion v) SetHLSOnly Nothing
|
liftE $ setHLS (_tvVersion v) SetHLSOnly Nothing
|
||||||
pure v
|
pure v
|
||||||
@@ -332,10 +323,7 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
|
|||||||
|
|
||||||
setStack' :: SetOptions
|
setStack' :: SetOptions
|
||||||
-> m ExitCode
|
-> m ExitCode
|
||||||
setStack' SetOptions{ sToolVer } =
|
setStack' SetOptions{ sToolVer } = runSetStack runAppState (do
|
||||||
case sToolVer of
|
|
||||||
(SetToolVersion v) -> runSetStack runLeanAppState (liftE $ setStack v >> pure (mkTVer v))
|
|
||||||
_ -> runSetStack runAppState (do
|
|
||||||
v <- liftE $ fst <$> fromVersion' sToolVer Stack
|
v <- liftE $ fst <$> fromVersion' sToolVer Stack
|
||||||
liftE $ setStack (_tvVersion v)
|
liftE $ setStack (_tvVersion v)
|
||||||
pure v
|
pure v
|
||||||
|
|||||||
@@ -63,7 +63,7 @@ import qualified GHCup.Types as Types
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
toSettings :: Options -> IO (Settings, KeyBindings)
|
toSettings :: Options -> IO (Settings, KeyBindings, UserSettings)
|
||||||
toSettings options = do
|
toSettings options = do
|
||||||
noColor <- isJust <$> lookupEnv "NO_COLOR"
|
noColor <- isJust <$> lookupEnv "NO_COLOR"
|
||||||
userConf <- runE @'[ JSONError ] ghcupConfigFile >>= \case
|
userConf <- runE @'[ JSONError ] ghcupConfigFile >>= \case
|
||||||
@@ -73,7 +73,7 @@ toSettings options = do
|
|||||||
pure defaultUserSettings
|
pure defaultUserSettings
|
||||||
_ -> do
|
_ -> do
|
||||||
die "Unexpected error!"
|
die "Unexpected error!"
|
||||||
pure $ mergeConf options userConf noColor
|
pure $ (\(s', k) -> (s', k, userConf)) $ mergeConf options userConf noColor
|
||||||
where
|
where
|
||||||
mergeConf :: Options -> UserSettings -> Bool -> (Settings, KeyBindings)
|
mergeConf :: Options -> UserSettings -> Bool -> (Settings, KeyBindings)
|
||||||
mergeConf Options{..} UserSettings{..} noColor =
|
mergeConf Options{..} UserSettings{..} noColor =
|
||||||
@@ -176,7 +176,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
|||||||
-- create ~/.ghcup dir
|
-- create ~/.ghcup dir
|
||||||
ensureDirectories dirs
|
ensureDirectories dirs
|
||||||
|
|
||||||
(settings, keybindings) <- toSettings opt
|
(settings, keybindings, userConf) <- toSettings opt
|
||||||
|
|
||||||
-- logger interpreter
|
-- logger interpreter
|
||||||
logfile <- runReaderT initGHCupFileLogging dirs
|
logfile <- runReaderT initGHCupFileLogging dirs
|
||||||
@@ -303,7 +303,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
|||||||
Rm rmCommand -> rm rmCommand runAppState runLogger
|
Rm rmCommand -> rm rmCommand runAppState runLogger
|
||||||
DInfo -> dinfo runAppState runLogger
|
DInfo -> dinfo runAppState runLogger
|
||||||
Compile compileCommand -> compile compileCommand settings dirs runAppState runLogger
|
Compile compileCommand -> compile compileCommand settings dirs runAppState runLogger
|
||||||
Config configCommand -> config configCommand settings keybindings runLogger
|
Config configCommand -> config configCommand settings userConf keybindings runLogger
|
||||||
Whereis whereisOptions
|
Whereis whereisOptions
|
||||||
whereisCommand -> whereis whereisCommand whereisOptions runAppState leanAppstate runLogger
|
whereisCommand -> whereis whereisCommand whereisOptions runAppState leanAppstate runLogger
|
||||||
Upgrade uOpts force' fatal -> upgrade uOpts force' fatal dirs runAppState runLogger
|
Upgrade uOpts force' fatal -> upgrade uOpts force' fatal dirs runAppState runLogger
|
||||||
|
|||||||
@@ -1,4 +1,4 @@
|
|||||||
FROM i386/alpine:3.12
|
FROM --platform=linux/i386 i386/alpine:3.12
|
||||||
|
|
||||||
ENV LANG C.UTF-8
|
ENV LANG C.UTF-8
|
||||||
|
|
||||||
|
|||||||
@@ -35,7 +35,7 @@ hide:
|
|||||||
<span>
|
<span>
|
||||||
</span>
|
</span>
|
||||||
<div class="footer">
|
<div class="footer">
|
||||||
<a href="https://github.com/haskell/ghcup-hs/blob/master/scripts/bootstrap/bootstrap-haskell" target="_blank">What does this do?</a> <b> · </b> <a href="https://www.haskell.org/ghcup/install/#manual-install">I don't like curl | sh</a> <div class="show-all-platforms"><b> · </b> <a class="show-all-platforms-button" href="#">Show all platforms</a></div></p>
|
<a href="https://github.com/haskell/ghcup-hs/blob/master/scripts/bootstrap/bootstrap-haskell" target="_blank">What does this do?</a> <b> · </b> <a href="https://www.haskell.org/ghcup/install/#manual-installation">I don't like curl | sh</a> <div class="show-all-platforms"><b> · </b> <a class="show-all-platforms-button" href="#">Show all platforms</a></div></p>
|
||||||
</div>
|
</div>
|
||||||
</div>
|
</div>
|
||||||
|
|
||||||
@@ -51,7 +51,7 @@ hide:
|
|||||||
<button class="btn" onclick="copyToClipboardWin()" id="ghcup-windows-button"><i class="fa fa-copy"></i></button>
|
<button class="btn" onclick="copyToClipboardWin()" id="ghcup-windows-button"><i class="fa fa-copy"></i></button>
|
||||||
</div>
|
</div>
|
||||||
<div class="footer">
|
<div class="footer">
|
||||||
<a href="https://github.com/haskell/ghcup-hs/blob/master/scripts/bootstrap/bootstrap-haskell.ps1" target="_blank">What does this do?</a> <b> · </b> <a href="https://www.haskell.org/ghcup/install/#manual-install">I don't like curl | sh</a> <div class="show-all-platforms"><b> · </b> <a class="show-all-platforms-button" href="#">Show all platforms</a></div></p>
|
<a href="https://github.com/haskell/ghcup-hs/blob/master/scripts/bootstrap/bootstrap-haskell.ps1" target="_blank">What does this do?</a> <b> · </b> <a href="https://www.haskell.org/ghcup/install/#manual-installation">I don't like curl | sh</a> <div class="show-all-platforms"><b> · </b> <a class="show-all-platforms-button" href="#">Show all platforms</a></div></p>
|
||||||
</div>
|
</div>
|
||||||
</div>
|
</div>
|
||||||
</section>
|
</section>
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
# Installation
|
# Installation
|
||||||
|
|
||||||
GHCup makes it easy to install specific versions of GHC on GNU/Linux,
|
GHCup makes it easy to install specific versions of GHC on GNU/Linux,
|
||||||
macOS (aka Darwin), FreeBSD and Windows and can also bootstrap a fresh [Haskell developer environment](./install/#supported-tools) from scratch.
|
macOS (aka Darwin), FreeBSD and Windows and can also bootstrap a fresh [Haskell developer environment](./#supported-tools) from scratch.
|
||||||
It follows the UNIX philosophy of [do one thing and do it well](https://en.wikipedia.org/wiki/Unix_philosophy#Do_One_Thing_and_Do_It_Well). Similar in scope to [rustup](https://github.com/rust-lang-nursery/rustup.rs), [pyenv](https://github.com/pyenv/pyenv) and [jenv](http://www.jenv.be).
|
It follows the UNIX philosophy of [do one thing and do it well](https://en.wikipedia.org/wiki/Unix_philosophy#Do_One_Thing_and_Do_It_Well). Similar in scope to [rustup](https://github.com/rust-lang-nursery/rustup.rs), [pyenv](https://github.com/pyenv/pyenv) and [jenv](http://www.jenv.be).
|
||||||
|
|
||||||
## How to install
|
## How to install
|
||||||
@@ -24,7 +24,7 @@ Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager
|
|||||||
|
|
||||||
There's also a [youtube video](https://www.youtube.com/watch?v=bB4fmQiUYPw) explaining installation on windows.
|
There's also a [youtube video](https://www.youtube.com/watch?v=bB4fmQiUYPw) explaining installation on windows.
|
||||||
|
|
||||||
If you want to know what these scripts do, check out the [source code at the repository](https://github.com/haskell/ghcup-hs/tree/master/scripts/bootstrap). Advanced users may want to perform a [manual installation](#manual-install) and GPG verify the binaries.
|
If you want to know what these scripts do, check out the [source code at the repository](https://github.com/haskell/ghcup-hs/tree/master/scripts/bootstrap). Advanced users may want to perform a [manual installation](#manual-installation) and GPG verify the binaries.
|
||||||
|
|
||||||
### Which versions get installed?
|
### Which versions get installed?
|
||||||
|
|
||||||
|
|||||||
@@ -279,11 +279,11 @@ removeEmptyDirectory = PD.removeDirectory
|
|||||||
|
|
||||||
-- | Create an 'Unfold' of directory contents.
|
-- | Create an 'Unfold' of directory contents.
|
||||||
unfoldDirContents :: (MonadMask m, MonadIO m, S.MonadAsync m) => Unfold m FilePath (FD.DirType, FilePath)
|
unfoldDirContents :: (MonadMask m, MonadIO m, S.MonadAsync m) => Unfold m FilePath (FD.DirType, FilePath)
|
||||||
unfoldDirContents = U.bracket (liftIO . openDirStream) (liftIO . closeDirStream) (Unfold step return)
|
unfoldDirContents = U.bracket (liftIO . openDirStreamPortable) (liftIO . closeDirStreamPortable) (Unfold step return)
|
||||||
where
|
where
|
||||||
{-# INLINE [0] step #-}
|
{-# INLINE [0] step #-}
|
||||||
step dirstream = do
|
step dirstream = do
|
||||||
(typ, e) <- liftIO $ readDirEnt dirstream
|
(typ, e) <- liftIO $ readDirEntPortable dirstream
|
||||||
return $ if
|
return $ if
|
||||||
| null e -> D.Stop
|
| null e -> D.Stop
|
||||||
| "." == e -> D.Skip dirstream
|
| "." == e -> D.Skip dirstream
|
||||||
@@ -308,8 +308,8 @@ getDirectoryContentsRecursiveUnfold = Unfold step (\s -> return (s, Nothing, [""
|
|||||||
step (_, Nothing, []) = return D.Stop
|
step (_, Nothing, []) = return D.Stop
|
||||||
|
|
||||||
step (topdir, Just (cdir, dirstream, finalizer), dirs) = flip onException (runIOFinalizer finalizer) $ do
|
step (topdir, Just (cdir, dirstream, finalizer), dirs) = flip onException (runIOFinalizer finalizer) $ do
|
||||||
(dt, f) <- liftIO $ readDirEnt dirstream
|
(dt, f) <- liftIO $ readDirEntPortable dirstream
|
||||||
if | FD.dtUnknown == dt -> do
|
if | f == "" -> do
|
||||||
runIOFinalizer finalizer
|
runIOFinalizer finalizer
|
||||||
return $ D.Skip (topdir, Nothing, dirs)
|
return $ D.Skip (topdir, Nothing, dirs)
|
||||||
| f == "." || f == ".."
|
| f == "." || f == ".."
|
||||||
@@ -323,8 +323,8 @@ getDirectoryContentsRecursiveUnfold = Unfold step (\s -> return (s, Nothing, [""
|
|||||||
|
|
||||||
acquire dir =
|
acquire dir =
|
||||||
withRunInIO $ \run -> mask_ $ run $ do
|
withRunInIO $ \run -> mask_ $ run $ do
|
||||||
dirstream <- liftIO $ openDirStream dir
|
dirstream <- liftIO $ openDirStreamPortable dir
|
||||||
ref <- newIOFinalizer (liftIO $ closeDirStream dirstream)
|
ref <- newIOFinalizer (liftIO $ closeDirStreamPortable dirstream)
|
||||||
return (dirstream, ref)
|
return (dirstream, ref)
|
||||||
|
|
||||||
getDirectoryContentsRecursiveBFSUnsafe :: (MonadMask m, MonadIO m, S.MonadAsync m)
|
getDirectoryContentsRecursiveBFSUnsafe :: (MonadMask m, MonadIO m, S.MonadAsync m)
|
||||||
|
|||||||
@@ -10,9 +10,20 @@
|
|||||||
module GHCup.Prelude.File.Posix.Traversals (
|
module GHCup.Prelude.File.Posix.Traversals (
|
||||||
-- lower-level stuff
|
-- lower-level stuff
|
||||||
readDirEnt
|
readDirEnt
|
||||||
|
, readDirEntPortable
|
||||||
|
, openDirStreamPortable
|
||||||
|
, closeDirStreamPortable
|
||||||
, unpackDirStream
|
, unpackDirStream
|
||||||
|
, DirStreamPortable
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
#include <limits.h>
|
||||||
|
#include <stdlib.h>
|
||||||
|
#include <dirent.h>
|
||||||
|
#include <sys/types.h>
|
||||||
|
#include <sys/stat.h>
|
||||||
|
#include <fcntl.h>
|
||||||
|
|
||||||
|
|
||||||
#if __GLASGOW_HASKELL__ < 710
|
#if __GLASGOW_HASKELL__ < 710
|
||||||
import Control.Applicative ((<$>))
|
import Control.Applicative ((<$>))
|
||||||
@@ -28,6 +39,7 @@ import Foreign.Storable
|
|||||||
import System.Posix
|
import System.Posix
|
||||||
import Foreign (alloca)
|
import Foreign (alloca)
|
||||||
import System.Posix.Internals (peekFilePath)
|
import System.Posix.Internals (peekFilePath)
|
||||||
|
import System.FilePath
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -90,3 +102,38 @@ readDirEnt (unpackDirStream -> dirp) =
|
|||||||
then return (dtUnknown, mempty)
|
then return (dtUnknown, mempty)
|
||||||
else throwErrno "readDirEnt"
|
else throwErrno "readDirEnt"
|
||||||
|
|
||||||
|
|
||||||
|
newtype DirStreamPortable = DirStreamPortable (FilePath, DirStream)
|
||||||
|
|
||||||
|
openDirStreamPortable :: FilePath -> IO DirStreamPortable
|
||||||
|
openDirStreamPortable fp = do
|
||||||
|
dirs <- openDirStream fp
|
||||||
|
pure $ DirStreamPortable (fp, dirs)
|
||||||
|
|
||||||
|
closeDirStreamPortable :: DirStreamPortable -> IO ()
|
||||||
|
closeDirStreamPortable (DirStreamPortable (_, dirs)) = closeDirStream dirs
|
||||||
|
|
||||||
|
readDirEntPortable :: DirStreamPortable -> IO (DirType, FilePath)
|
||||||
|
readDirEntPortable (DirStreamPortable (basedir, dirs)) = do
|
||||||
|
(dt, fp) <- readDirEnt dirs
|
||||||
|
case (dt, fp) of
|
||||||
|
(DirType #{const DT_BLK}, _) -> pure (dt, fp)
|
||||||
|
(DirType #{const DT_CHR}, _) -> pure (dt, fp)
|
||||||
|
(DirType #{const DT_DIR}, _) -> pure (dt, fp)
|
||||||
|
(DirType #{const DT_FIFO}, _) -> pure (dt, fp)
|
||||||
|
(DirType #{const DT_LNK}, _) -> pure (dt, fp)
|
||||||
|
(DirType #{const DT_REG}, _) -> pure (dt, fp)
|
||||||
|
(DirType #{const DT_SOCK}, _) -> pure (dt, fp)
|
||||||
|
(DirType #{const DT_UNKNOWN}, _) -> pure (dt, fp)
|
||||||
|
(_, _)
|
||||||
|
| fp /= "" -> do
|
||||||
|
stat <- getSymbolicLinkStatus (basedir </> fp)
|
||||||
|
pure $ (, fp) $ if | isBlockDevice stat -> DirType #{const DT_BLK}
|
||||||
|
| isCharacterDevice stat -> DirType #{const DT_CHR}
|
||||||
|
| isDirectory stat -> DirType #{const DT_DIR}
|
||||||
|
| isNamedPipe stat -> DirType #{const DT_FIFO}
|
||||||
|
| isSymbolicLink stat -> DirType #{const DT_LNK}
|
||||||
|
| isRegularFile stat -> DirType #{const DT_REG}
|
||||||
|
| isSocket stat -> DirType #{const DT_SOCK}
|
||||||
|
| otherwise -> DirType #{const DT_UNKNOWN}
|
||||||
|
|
||||||
@@ -119,20 +119,26 @@ edo() {
|
|||||||
"$@" || die "\"$*\" failed!"
|
"$@" || die "\"$*\" failed!"
|
||||||
}
|
}
|
||||||
|
|
||||||
|
eghcup_raw() {
|
||||||
|
"${GHCUP_BIN}/ghcup" "$@" || die "\"ghcup $*\" failed!"
|
||||||
|
}
|
||||||
|
|
||||||
eghcup() {
|
eghcup() {
|
||||||
edo _eghcup "$@"
|
_eghcup "$@"
|
||||||
}
|
}
|
||||||
|
|
||||||
_eghcup() {
|
_eghcup() {
|
||||||
if [ -n "${BOOTSTRAP_HASKELL_YAML}" ] ; then
|
if [ -n "${BOOTSTRAP_HASKELL_YAML}" ] ; then
|
||||||
args="-s ${BOOTSTRAP_HASKELL_YAML}"
|
args="-s ${BOOTSTRAP_HASKELL_YAML} --metadata-fetching-mode=Strict"
|
||||||
|
else
|
||||||
|
args="--metadata-fetching-mode=Strict"
|
||||||
fi
|
fi
|
||||||
if [ -z "${BOOTSTRAP_HASKELL_VERBOSE}" ] ; then
|
if [ -z "${BOOTSTRAP_HASKELL_VERBOSE}" ] ; then
|
||||||
# shellcheck disable=SC2086
|
# shellcheck disable=SC2086
|
||||||
"${GHCUP_BIN}/ghcup" ${args} "$@"
|
"${GHCUP_BIN}/ghcup" ${args} "$@" || die "\"ghcup ${args} $*\" failed!"
|
||||||
else
|
else
|
||||||
# shellcheck disable=SC2086
|
# shellcheck disable=SC2086
|
||||||
"${GHCUP_BIN}/ghcup" ${args} --verbose "$@"
|
"${GHCUP_BIN}/ghcup" ${args} --verbose "$@" || die "\"ghcup ${args} --verbose $*\" failed!"
|
||||||
fi
|
fi
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -147,7 +153,7 @@ _ecabal() {
|
|||||||
}
|
}
|
||||||
|
|
||||||
ecabal() {
|
ecabal() {
|
||||||
edo _ecabal "$@"
|
_ecabal "$@" || die "\"cabal $*\" failed!"
|
||||||
}
|
}
|
||||||
|
|
||||||
_done() {
|
_done() {
|
||||||
@@ -282,14 +288,6 @@ download_ghcup() {
|
|||||||
esac
|
esac
|
||||||
;;
|
;;
|
||||||
"FreeBSD"|"freebsd")
|
"FreeBSD"|"freebsd")
|
||||||
if freebsd-version | grep -E '^12.*' ; then
|
|
||||||
freebsd_ver=12
|
|
||||||
elif freebsd-version | grep -E '^13.*' ; then
|
|
||||||
freebsd_ver=13
|
|
||||||
else
|
|
||||||
die "Unsupported FreeBSD version! Please report a bug at https://github.com/haskell/ghcup-hs/issues"
|
|
||||||
fi
|
|
||||||
|
|
||||||
case "${arch}" in
|
case "${arch}" in
|
||||||
x86_64|amd64)
|
x86_64|amd64)
|
||||||
;;
|
;;
|
||||||
@@ -299,7 +297,7 @@ download_ghcup() {
|
|||||||
*) die "Unknown architecture: ${arch}"
|
*) die "Unknown architecture: ${arch}"
|
||||||
;;
|
;;
|
||||||
esac
|
esac
|
||||||
_url=${GHCUP_BASE_URL}/${ghver}/x86_64-freebsd${freebsd_ver}-ghcup-${ghver}
|
_url=${GHCUP_BASE_URL}/${ghver}/x86_64-portbld-freebsd-ghcup-${ghver}
|
||||||
;;
|
;;
|
||||||
"Darwin"|"darwin")
|
"Darwin"|"darwin")
|
||||||
case "${arch}" in
|
case "${arch}" in
|
||||||
@@ -387,10 +385,10 @@ download_ghcup() {
|
|||||||
edo . "${GHCUP_DIR}"/env
|
edo . "${GHCUP_DIR}"/env
|
||||||
case "${BOOTSTRAP_HASKELL_DOWNLOADER}" in
|
case "${BOOTSTRAP_HASKELL_DOWNLOADER}" in
|
||||||
"curl")
|
"curl")
|
||||||
eghcup config set downloader Curl
|
eghcup_raw config set downloader Curl
|
||||||
;;
|
;;
|
||||||
"wget")
|
"wget")
|
||||||
eghcup config set downloader Wget
|
eghcup_raw config set downloader Wget
|
||||||
;;
|
;;
|
||||||
*)
|
*)
|
||||||
die "Unknown downloader: ${BOOTSTRAP_HASKELL_DOWNLOADER}"
|
die "Unknown downloader: ${BOOTSTRAP_HASKELL_DOWNLOADER}"
|
||||||
@@ -795,7 +793,7 @@ edo mkdir -p "${GHCUP_BIN}"
|
|||||||
|
|
||||||
if command -V "ghcup" >/dev/null 2>&1 ; then
|
if command -V "ghcup" >/dev/null 2>&1 ; then
|
||||||
if [ -z "${BOOTSTRAP_HASKELL_NO_UPGRADE}" ] ; then
|
if [ -z "${BOOTSTRAP_HASKELL_NO_UPGRADE}" ] ; then
|
||||||
_eghcup upgrade || download_ghcup
|
( _eghcup upgrade ) || download_ghcup
|
||||||
fi
|
fi
|
||||||
else
|
else
|
||||||
download_ghcup
|
download_ghcup
|
||||||
@@ -842,17 +840,17 @@ fi
|
|||||||
|
|
||||||
case $ask_hls_answer in
|
case $ask_hls_answer in
|
||||||
1)
|
1)
|
||||||
_eghcup --cache install hls || warn "HLS installation failed, continuing anyway"
|
(_eghcup --cache install hls) || warn "HLS installation failed, continuing anyway"
|
||||||
;;
|
;;
|
||||||
*) ;;
|
*) ;;
|
||||||
esac
|
esac
|
||||||
|
|
||||||
case $ask_stack_answer in
|
case $ask_stack_answer in
|
||||||
1)
|
1)
|
||||||
_eghcup --cache install stack || die "Stack installation failed"
|
(_eghcup --cache install stack) || die "Stack installation failed"
|
||||||
;;
|
;;
|
||||||
2)
|
2)
|
||||||
_eghcup --cache install stack || die "Stack installation failed"
|
(_eghcup --cache install stack) || die "Stack installation failed"
|
||||||
edo mkdir -p "${STACK_ROOOT:-$HOME/.stack}"/hooks
|
edo mkdir -p "${STACK_ROOOT:-$HOME/.stack}"/hooks
|
||||||
hook_exe="${STACK_ROOOT:-$HOME/.stack}"/hooks/ghc-install.sh
|
hook_exe="${STACK_ROOOT:-$HOME/.stack}"/hooks/ghc-install.sh
|
||||||
hook_url="https://www.haskell.org/ghcup/sh/hooks/stack/ghc-install.sh"
|
hook_url="https://www.haskell.org/ghcup/sh/hooks/stack/ghc-install.sh"
|
||||||
|
|||||||
@@ -432,12 +432,13 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
|
|||||||
}
|
}
|
||||||
Print-Msg -msg ('Downloading Msys2 archive {0}...' -f $Msys2Version)
|
Print-Msg -msg ('Downloading Msys2 archive {0}...' -f $Msys2Version)
|
||||||
$archive = ('msys2-base-x86_64-{0}.sfx.exe' -f $Msys2Version)
|
$archive = ('msys2-base-x86_64-{0}.sfx.exe' -f $Msys2Version)
|
||||||
|
$msysUrl = ('https://repo.msys2.org/distrib/x86_64/{0}' -f "$archive")
|
||||||
$archivePath = ('{0}\{1}' -f ([IO.Path]::GetTempPath()), "$archive")
|
$archivePath = ('{0}\{1}' -f ([IO.Path]::GetTempPath()), "$archive")
|
||||||
|
|
||||||
if ((Get-Command -Name 'curl.exe' -ErrorAction SilentlyContinue) -and !($DisableCurl)) {
|
if ((Get-Command -Name 'curl.exe' -ErrorAction SilentlyContinue) -and !($DisableCurl)) {
|
||||||
Exec "curl.exe" '-o' "$archivePath" ('https://repo.msys2.org/distrib/x86_64/{0}' -f "$archive")
|
Exec "curl.exe" '-o' "$archivePath" "$msysUrl"
|
||||||
} else {
|
} else {
|
||||||
Get-FileWCSynchronous -url ('https://repo.msys2.org/distrib/{0}' -f $archive) -destinationFolder ([IO.Path]::GetTempPath()) -includeStats
|
Get-FileWCSynchronous -url "$msysUrl" -destinationFolder ([IO.Path]::GetTempPath()) -includeStats
|
||||||
}
|
}
|
||||||
|
|
||||||
Print-Msg -msg 'Extracting Msys2 archive...'
|
Print-Msg -msg 'Extracting Msys2 archive...'
|
||||||
|
|||||||
@@ -24,11 +24,11 @@ spec = do
|
|||||||
-- https://github.com/haskell/ghcup-hs/issues/415
|
-- https://github.com/haskell/ghcup-hs/issues/415
|
||||||
describe "GHCup.Prelude.File.Posix.Traversals" $ do
|
describe "GHCup.Prelude.File.Posix.Traversals" $ do
|
||||||
it "readDirEnt" $ do
|
it "readDirEnt" $ do
|
||||||
dirstream <- liftIO $ openDirStream "test/data"
|
dirstream <- liftIO $ openDirStreamPortable "test/data"
|
||||||
(dt1, fp1) <- readDirEnt dirstream
|
(dt1, fp1) <- readDirEntPortable dirstream
|
||||||
(dt2, fp2) <- readDirEnt dirstream
|
(dt2, fp2) <- readDirEntPortable dirstream
|
||||||
(dt3, fp3) <- readDirEnt dirstream
|
(dt3, fp3) <- readDirEntPortable dirstream
|
||||||
(dt4, fp4) <- readDirEnt dirstream
|
(dt4, fp4) <- readDirEntPortable dirstream
|
||||||
let xs = sortOn snd [ (dt1, fp1), (dt2, fp2)
|
let xs = sortOn snd [ (dt1, fp1), (dt2, fp2)
|
||||||
, (dt3, fp3), (dt4, fp4)
|
, (dt3, fp3), (dt4, fp4)
|
||||||
]
|
]
|
||||||
|
|||||||
Reference in New Issue
Block a user