Test fuckup

.github/scripts/bootstrap.sh

@@ -13,6 +13,4 @@ git describe --always
 ./scripts/bootstrap/bootstrap-haskell
 
 [ "$(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" ]
 

.github/workflows/bootstrap.yaml

@@ -25,10 +25,6 @@ jobs:
         include:
           - os: ubuntu-latest
             DISTRO: Ubuntu
-          - os: macOS-10.15
-            DISTRO: na
-          - os: windows-latest
-            DISTRO: na
     steps:
       - name: Checkout code
         uses: actions/checkout@v3
@@ -38,18 +34,10 @@ jobs:
       - if: runner.os == 'Linux'
         name: Run bootstrap
         run: |
-          sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl gzip
+          ls -lah /usr/local/.ghcup
-          sh ./.github/scripts/bootstrap.sh
+          ls -lah /usr/local/.ghcup/cache
+          cat /usr/local/.ghcup/config.yaml
+          ghcup --version
+          ghcup -v install cabal 3.8.1.0
         env:
           DISTRO: ${{ matrix.DISTRO }}
-
-      - if: runner.os == 'macOS'
-        name: Run bootstrap
-        run: sh ./.github/scripts/bootstrap.sh
-        env:
-          DISTRO: ${{ matrix.DISTRO }}
-
-      - if: runner.os == 'Windows'
-        name: Run bootstrap
-        run: ./scripts/bootstrap/bootstrap-haskell.ps1 -InstallDir ${GITHUB_WORKSPACE} -BootstrapUrl ${GITHUB_WORKSPACE}/bootstrap-haskell -InBash
-        shell: pwsh

app/ghcup/GHCup/OptParse/Config.hs

@@ -120,38 +120,21 @@ formatConfig :: UserSettings -> String
 formatConfig = UTF8.toString . Y.encode
 
 
-updateSettings :: UserSettings -> UserSettings -> UserSettings
+updateSettings :: UserSettings -> Settings -> Settings
-updateSettings usl usr =
+updateSettings UserSettings{..} Settings{..} =
-   let cache'      = uCache usl      <|> uCache usr
+   let cache'      = fromMaybe cache uCache
-       metaCache'  = uMetaCache usl  <|> uMetaCache usr
+       metaCache'  = fromMaybe metaCache uMetaCache
-       metaMode'   = uMetaMode usl   <|> uMetaMode usr
+       metaMode'   = fromMaybe metaMode uMetaMode
-       noVerify'   = uNoVerify usl   <|> uNoVerify usr
+       noVerify'   = fromMaybe noVerify uNoVerify
-       verbose'    = uVerbose usl    <|> uVerbose usr
+       keepDirs'   = fromMaybe keepDirs uKeepDirs
-       keepDirs'   = uKeepDirs usl   <|> uKeepDirs usr
+       downloader' = fromMaybe downloader uDownloader
-       downloader' = uDownloader usl <|> uDownloader usr
+       verbose'    = fromMaybe verbose uVerbose
-       urlSource'  = uUrlSource usl  <|> uUrlSource usr
+       urlSource'  = fromMaybe urlSource uUrlSource
-       noNetwork'  = uNoNetwork usl  <|> uNoNetwork usr
+       noNetwork'  = fromMaybe noNetwork uNoNetwork
-       gpgSetting' = uGPGSetting usl <|> uGPGSetting usr
+       gpgSetting' = fromMaybe gpgSetting uGPGSetting
-       platformOverride' = uPlatformOverride usl <|> uPlatformOverride usr
+       platformOverride' = uPlatformOverride <|> platformOverride
-       mirrors' = uMirrors usl <|> uMirrors usr
+       mirrors' = fromMaybe mirrors uMirrors
-   in UserSettings cache' metaCache' metaMode' noVerify' verbose' keepDirs' downloader' (updateKeyBindings (uKeyBindings usl) (uKeyBindings usr)) urlSource' noNetwork' gpgSetting' platformOverride' mirrors'
+   in Settings cache' metaCache' metaMode' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor 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
-         }
 
 
 
@@ -168,11 +151,10 @@ config :: forall m. ( Monad m
           )
      => ConfigCommand
      -> Settings
-     -> UserSettings
      -> KeyBindings
      -> (ReaderT LeanAppState m () -> m ())
      -> m ExitCode
-config configCommand settings userConf keybindings runLogger = case configCommand of
+config configCommand settings keybindings runLogger = case configCommand of
   InitConfig -> do
     path <- getConfigFilePath
     liftIO $ writeFile path $ formatConfig $ fromSettings settings (Just keybindings)
@@ -221,9 +203,9 @@ config configCommand settings userConf keybindings runLogger = case configComman
  where
   doConfig :: MonadIO m => UserSettings -> m ()
   doConfig usersettings = do
-    let settings' = updateSettings usersettings userConf
+    let settings' = updateSettings usersettings settings
     path <- liftIO getConfigFilePath
-    liftIO $ writeFile path $ formatConfig $ settings'
+    liftIO $ writeFile path $ formatConfig $ fromSettings settings' (Just keybindings)
     runLogger $ logDebug $ T.pack $ show settings'
     pure ()
 

app/ghcup/Main.hs

@@ -63,7 +63,7 @@ import qualified GHCup.Types                   as Types
 
 
 
-toSettings :: Options -> IO (Settings, KeyBindings, UserSettings)
+toSettings :: Options -> IO (Settings, KeyBindings)
 toSettings options = do
   noColor <- isJust <$> lookupEnv "NO_COLOR"
   userConf <- runE @'[ JSONError ] ghcupConfigFile >>= \case
@@ -73,7 +73,7 @@ toSettings options = do
       pure defaultUserSettings
     _ -> do
       die "Unexpected error!"
-  pure $ (\(s', k) -> (s', k, userConf)) $ mergeConf options userConf noColor
+  pure $ mergeConf options userConf noColor
  where
    mergeConf :: Options -> UserSettings -> Bool -> (Settings, KeyBindings)
    mergeConf Options{..} UserSettings{..} noColor =
@@ -176,7 +176,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
           -- create ~/.ghcup dir
           ensureDirectories dirs
 
-          (settings, keybindings, userConf) <- toSettings opt
+          (settings, keybindings) <- toSettings opt
 
           -- logger interpreter
           logfile <- runReaderT initGHCupFileLogging dirs
@@ -303,7 +303,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
             Rm rmCommand               -> rm rmCommand runAppState runLogger
             DInfo                      -> dinfo runAppState runLogger
             Compile compileCommand     -> compile compileCommand settings dirs runAppState runLogger
-            Config configCommand       -> config configCommand settings userConf keybindings runLogger
+            Config configCommand       -> config configCommand settings keybindings runLogger
             Whereis whereisOptions
                     whereisCommand     -> whereis whereisCommand whereisOptions runAppState leanAppstate runLogger
             Upgrade uOpts force' fatal -> upgrade uOpts force' fatal dirs runAppState runLogger

lib/GHCup/Prelude/File/Posix/Traversals.hsc

@@ -117,15 +117,7 @@ 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_UNKNOWN}, _)
-    (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}
@@ -136,4 +128,5 @@ readDirEntPortable (DirStreamPortable (basedir, dirs)) = do
                              | isRegularFile stat     -> DirType #{const DT_REG}
                              | isSocket stat          -> DirType #{const DT_SOCK}
                              | otherwise              -> DirType #{const DT_UNKNOWN}
+    _ -> pure (dt, fp)
 

scripts/bootstrap/bootstrap-haskell

@@ -119,10 +119,6 @@ edo() {
     "$@" || die "\"$*\" failed!"
 }
 
-eghcup_raw() {
-	"${GHCUP_BIN}/ghcup" "$@" || die "\"ghcup $*\" failed!"
-}
-
 eghcup() {
 	_eghcup "$@"
 }
@@ -385,10 +381,10 @@ download_ghcup() {
     edo . "${GHCUP_DIR}"/env
     case "${BOOTSTRAP_HASKELL_DOWNLOADER}" in
         "curl")
-            eghcup_raw config set downloader Curl
+            eghcup config set downloader Curl
             ;;
         "wget")
-            eghcup_raw config set downloader Wget
+            eghcup config set downloader Wget
             ;;
         *)
             die "Unknown downloader: ${BOOTSTRAP_HASKELL_DOWNLOADER}"