Fix property tests

.github/scripts/test.sh

@@ -30,32 +30,32 @@ sha_sum "$(raw_eghcup --offline whereis ghcup)"
 
 ### Haskell test suite
 
-./"ghcup-test${ext}"
-./"ghcup-test-optparse${ext}"
-rm "ghcup-test${ext}" "ghcup-test-optparse${ext}"
+./ghcup-test${ext}
+./ghcup-test-optparse${ext}
+rm ghcup-test${ext} ghcup-test-optparse${ext}
 
 ### manual cli based testing
 
 eghcup --numeric-version
 
-eghcup install ghc "${GHC_VER}"
-eghcup unset ghc "${GHC_VER}"
-ls -lah "$(eghcup whereis -d ghc "${GHC_VER}")"
-[ "$($(eghcup whereis ghc "${GHC_VER}") --numeric-version)" = "${GHC_VER}" ]
-[ "$(eghcup run -q --ghc "${GHC_VER}" -- ghc --numeric-version)" = "${GHC_VER}" ]
-[ "$(ghcup run -q --ghc "${GHC_VER}" -- ghc -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)')" = "$($(ghcup whereis ghc "${GHC_VER}") -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)')" ]
-eghcup set ghc "${GHC_VER}"
-eghcup install cabal "${CABAL_VER}"
-[ "$($(eghcup whereis cabal "${CABAL_VER}") --numeric-version)" = "${CABAL_VER}" ]
+eghcup install ghc ${GHC_VER}
+eghcup unset ghc ${GHC_VER}
+ls -lah "$(eghcup whereis -d ghc ${GHC_VER})"
+[ "`$(eghcup whereis ghc ${GHC_VER}) --numeric-version`" = "${GHC_VER}" ]
+[ "`eghcup run --ghc ${GHC_VER} -- ghc --numeric-version`" = "${GHC_VER}" ]
+[ "`ghcup run --ghc ${GHC_VER} -- ghc -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)'`" = "`$(ghcup whereis ghc ${GHC_VER}) -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)'`" ]
+eghcup set ghc ${GHC_VER}
+eghcup install cabal ${CABAL_VER}
+[ "`$(eghcup whereis cabal ${CABAL_VER}) --numeric-version`" = "${CABAL_VER}" ]
 eghcup unset cabal
 "$GHCUP_BIN"/cabal --version && exit 1 || echo yes
 
 # make sure no cabal is set when running 'ghcup run' to check that PATH propagages properly
 # https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/375
-[ "$(eghcup run -q --cabal "${CABAL_VER}" -- cabal --numeric-version)" = "${CABAL_VER}" ]
-eghcup set cabal "${CABAL_VER}"
+[ "`eghcup run --cabal ${CABAL_VER} -- cabal --numeric-version`" = "${CABAL_VER}" ]
+eghcup set cabal ${CABAL_VER}
 
-[ "$($(eghcup whereis cabal "${CABAL_VER}") --numeric-version)" = "${CABAL_VER}" ]
+[ "`$(eghcup whereis cabal ${CABAL_VER}) --numeric-version`" = "${CABAL_VER}" ]
 
 if [ "${OS}" != "FreeBSD" ] ; then
 	if [ "${ARCH}" = "64" ] && [ "${DISTRO}" != "Alpine" ] ; then
@@ -85,10 +85,10 @@ eghcup list -t cabal
 
 ghc_ver=$(ghc --numeric-version)
 ghc --version
-"ghc-${ghc_ver}" --version
+ghc-${ghc_ver} --version
 if [ "${OS}" != "Windows" ] ; then
 		ghci --version
-		"ghci-${ghc_ver}" --version
+		ghci-${ghc_ver} --version
 fi
 
 
@@ -132,11 +132,11 @@ else
 	eghcup --offline set 8.10.3
 	eghcup set 8.10.3
 	[ "$(ghc --numeric-version)" = "8.10.3" ]
-	eghcup set "${GHC_VER}"
+	eghcup set ${GHC_VER}
 	[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
 	eghcup unset ghc
     "$GHCUP_BIN"/ghc --numeric-version && exit 1 || echo yes
-	eghcup set "${GHC_VER}"
+	eghcup set ${GHC_VER}
 	eghcup --offline rm 8.10.3
 	[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
 
@@ -169,10 +169,10 @@ fi
 # check that lazy loading works for 'whereis'
 cp "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml" "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml.bak"
 echo '**' > "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml"
-eghcup whereis ghc "$(ghc --numeric-version)"
+eghcup whereis ghc $(ghc --numeric-version)
 mv -f "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml.bak" "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml"
 
-eghcup rm "$(ghc --numeric-version)"
+eghcup rm $(ghc --numeric-version)
 
 # https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/116
 if [ "${OS}" = "Linux" ] ; then
@@ -186,7 +186,7 @@ eghcup gc -c
 
 # test etags
 rm -f "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml"
-raw_eghcup -s "https://www.haskell.org/ghcup/data/ghcup-${JSON_VERSION}.yaml" list
+raw_eghcup -s https://www.haskell.org/ghcup/data/ghcup-${JSON_VERSION}.yaml list
 # snapshot yaml and etags file
 etag=$(cat "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml.etags")
 sha=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")

.gitmodules

@@ -1,4 +1,4 @@
 [submodule "data/metadata"]
 	path = data/metadata
 	url = https://github.com/haskell/ghcup-metadata.git
-	branch = develop
+	branch = master

app/ghcup/BrickMain.hs

@@ -94,7 +94,7 @@ data BrickState = BrickState
 
 
 keyHandlers :: KeyBindings
-            -> [ ( KeyCombination
+            -> [ ( Vty.Key
                  , BrickSettings -> String
                  , BrickState -> EventM String BrickState ()
                  )
@@ -131,9 +131,6 @@ showKey Vty.KUp = "↑"
 showKey Vty.KDown = "↓"
 showKey key = tail (show key)
 
-showMod :: Vty.Modifier -> String
-showMod = tail . show
-
 
 ui :: AttrMap -> BrickState -> Widget String
 ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
@@ -150,7 +147,7 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
       . txtWrap
       . T.pack
       . foldr1 (\x y -> x <> "  " <> y)
-      . fmap (\(KeyCombination key mods, s, _) -> intercalate "+" (showKey key : (showMod <$> mods)) <> ":" <> s as)
+      . fmap (\(key, s, _) -> showKey key <> ":" <> s as)
       $ keyHandlers appKeys
   header =
     minHSize 2 emptyWidget
@@ -324,12 +321,12 @@ eventHandler st@BrickState{..} ev = do
     (MouseDown _ Vty.BScrollDown _ _) ->
       put (BrickState { appState = moveCursor 1 appState Down, .. })
     (VtyEvent (Vty.EvResize _ _)) -> put st
-    (VtyEvent (Vty.EvKey Vty.KUp [])) ->
+    (VtyEvent (Vty.EvKey Vty.KUp _)) ->
       put BrickState{ appState = moveCursor 1 appState Up, .. }
-    (VtyEvent (Vty.EvKey Vty.KDown [])) ->
+    (VtyEvent (Vty.EvKey Vty.KDown _)) ->
       put BrickState{ appState = moveCursor 1 appState Down, .. }
-    (VtyEvent (Vty.EvKey key mods)) ->
-      case find (\(keyCombo, _, _) -> keyCombo == KeyCombination key mods) (keyHandlers kb) of
+    (VtyEvent (Vty.EvKey key _)) ->
+      case find (\(key', _, _) -> key' == key) (keyHandlers kb) of
         Nothing -> put st
         Just (_, _, handler) -> handler st
     _ -> put st

data/config.yaml

@@ -16,11 +16,6 @@ gpg-setting: GPGNone # GPGStrict | GPGLax | GPGNone
 # TUI key bindings,
 # see https://hackage.haskell.org/package/vty-5.31/docs/Graphics-Vty-Input-Events.html#t:Key
 # for possible values.
-# It's also possible to define key+modifier, e.g.:
-#   quit:
-#     Key:
-#       KChar: c
-#     Mods: [MCtrl]
 key-bindings:
   up:
     KUp: []

docs/guide.md

@@ -214,7 +214,17 @@ url-source:
 Stack manages GHC versions internally by default. In order to make it use ghcup installed
 GHC versions there are two strategies.
 
-### Strategy 1: Stack hooks (new, recommended)
+### Strategy 1: System GHC (works on all stack versions)
+
+You can instruct stack to use "system" GHC versions (whatever is in PATH). To do so,
+run the following commands:
+
+```sh
+stack config set install-ghc false --global
+stack config set system-ghc  true  --global
+```
+
+### Strategy 2: Stack hooks (new, recommended)
 
 Since stack 2.9.1 you can customize the installation logic of GHC completely, see [https://docs.haskellstack.org/en/stable/yaml_configuration/#ghc-installation-customisation](https://docs.haskellstack.org/en/stable/yaml_configuration/#ghc-installation-customisation).
 
@@ -236,16 +246,6 @@ stack config set system-ghc false --global
 By default, when the hook fails for whatever reason, stack will fall back to its own installation logic. To disable
 this, run `stack config set install-ghc false --global`.
 
-### Strategy 2: System GHC (works on all stack versions)
-
-You can instruct stack to use "system" GHC versions (whatever is in PATH). To do so,
-run the following commands:
-
-```sh
-stack config set install-ghc false --global
-stack config set system-ghc  true  --global
-```
-
 ### Windows
 
 On windows, you may find the following config options useful too:
@@ -456,48 +456,8 @@ variables and, in the case of Windows, parameters to tweak the script behavior.
 
 ### github workflows
 
-On github workflows GHCup itself is pre-installed on all platforms, but may use non-standard install locations.
-Here's an example workflow with a GHC matrix:
-
-```yaml
-jobs:
-  build:
-    runs-on: ${{ matrix.os }}
-    strategy:
-      fail-fast: true
-      matrix:
-        os: [ubuntu-22.04, macOS-latest]
-        ghc: ['9.6', '9.4', '9.2', '9.0', '8.10', '8.8', '8.6']
-    steps:
-    - uses: actions/checkout@v3
-    - name: Setup toolchain
-      run: |
-        ghcup install cabal --set recommended
-        ghcup install ghc --set ${{ matrix.ghc }}
-    - name: Build
-      run: |
-        cabal update
-        cabal test all --test-show-details=direct
-
-  i386:
-    runs-on: ubuntu-latest
-    container:
-      image: i386/ubuntu:bionic
-    steps:
-    - name: Install GHCup in container
-      run: |
-        apt-get update -y
-        apt-get install -y autoconf build-essential zlib1g-dev libgmp-dev curl
-        # we just go with recommended versions of cabal and GHC
-        curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_INSTALL_NO_STACK=1 sh
-    - uses: actions/checkout@v1
-    - name: Test
-      run: |
-        # in containers we need to fix PATH
-        source ~/.ghcup/env
-        cabal update
-        cabal test all --test-show-details=direct
-```
+On github workflows you can use [https://github.com/haskell/actions/](https://github.com/haskell/actions/).
+GHCup itself is also pre-installed on all platforms, but may use non-standard install locations.
 
 ## GPG verification
 

docs/install.md

@@ -42,14 +42,10 @@ Also see [tags and shortcuts](../guide/#tags-and-shortcuts) for more information
 
 The following distro packages are required: `build-essential curl libffi-dev libffi6 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
 
-#### Version >= 11 && <= 12
+#### Version >= 11
 
 The following distro packages are required: `build-essential curl libffi-dev libffi7 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
 
-#### Version >= 12
-
-The following distro packages are required: `build-essential curl libffi-dev libffi8 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
-
 ### Linux Ubuntu
 
 #### Generic
@@ -60,13 +56,10 @@ The following distro packages are required: `build-essential curl libffi-dev lib
 
 The following distro packages are required: `build-essential curl libffi-dev libffi7 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
 
-#### Version >= 20.10 && < 23
+#### Version >= 20.10
 
 The following distro packages are required: `build-essential curl libffi-dev libffi8ubuntu1 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
 
-#### Version >= 23
-
-The following distro packages are required: `build-essential curl libffi-dev libffi8ubuntu1 libgmp-dev libgmp10 libncurses-dev`
 
 ### Linux Fedora
 
@@ -207,9 +200,7 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
 <table>
 <thead><tr><th>HLS Version</th><th>Tags</th></tr></thead>
 <tbody>
-<tr><td>2.4.0.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
-<tr><td>2.3.0.0</td><td></td></tr>
-<tr><td>2.2.0.0</td><td></td></tr>
+<tr><td>2.2.0.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
 <tr><td>2.1.0.0</td><td></td></tr>
 <tr><td>2.0.0.1</td><td></td></tr>
 <tr><td>2.0.0.0</td><td></td></tr>

lib-opt/GHCup/OptParse/Common.hs

@@ -209,7 +209,19 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
         )
     ]
   distroP :: MP.Parsec Void Text LinuxDistro
-  distroP = choice' ((\d -> MP.chunk (T.pack $ distroToString d) $> d) <$> allDistros)
+  distroP = choice'
+    [ MP.chunk "debian" $> Debian
+    , MP.chunk "deb" $> Debian
+    , MP.chunk "ubuntu" $> Ubuntu
+    , MP.chunk "mint" $> Mint
+    , MP.chunk "fedora" $> Fedora
+    , MP.chunk "centos" $> CentOS
+    , MP.chunk "redhat" $> RedHat
+    , MP.chunk "alpine" $> Alpine
+    , MP.chunk "gentoo" $> Gentoo
+    , MP.chunk "exherbo" $> Exherbo
+    , MP.chunk "unknown" $> UnknownLinux
+    ]
 
 
 uriParser :: String -> Either String URI
@@ -355,7 +367,7 @@ fileUri' add = \case
   -- We need to do this so bash doesn't expand out any ~ or other
   -- chars we want to complete on, or emit an end of line error
   -- when seeking the close to the quote.
-  --
+  -- 
   -- NOTE: copied from https://hackage.haskell.org/package/optparse-applicative-0.17.0.0/docs/src/Options.Applicative.Builder.Completer.html#requote
   requote :: String -> String
   requote s =

lib/GHCup/Download.hs

@@ -246,7 +246,7 @@ getBase uri = do
     Settings { metaCache } <- lift getSettings
 
        -- for local files, let's short-circuit and ignore access time
-    if | scheme == "file" -> liftE $ download uri' (Just $ over pathL' (<> ".sig") uri') Nothing Nothing (fromGHCupPath cacheDir) Nothing True
+    if | scheme == "file" -> liftE $ download uri' Nothing Nothing Nothing (fromGHCupPath cacheDir) Nothing True
        | e -> do
           accessTime <- fmap utcTimeToPOSIXSeconds $ liftIO $ getAccessTime json_file
           let sinceLastAccess = utcTimeToPOSIXSeconds currentTime - accessTime
@@ -352,20 +352,15 @@ download :: ( MonadReader env m
 download rawUri gpgUri eDigest eCSize dest mfn etags
   | scheme == "https" = liftE dl
   | scheme == "http"  = liftE dl
-  | scheme == "file"
-  , Just s <- gpgScheme
-  , s /= "file" = throwIO $ userError $ "gpg scheme does not match base file scheme: " <> (T.unpack . decUTF8Safe $ s)
   | scheme == "file"  = do
-      Settings{ gpgSetting } <- lift getSettings
       let destFile' = T.unpack . decUTF8Safe $ view pathL' rawUri
       lift $ logDebug $ "using local file: " <> T.pack destFile'
-      liftE $ verify gpgSetting destFile' (pure . T.unpack . decUTF8Safe . view pathL')
+      forM_ eDigest (liftE . flip checkDigest destFile')
       pure destFile'
   | otherwise = throwE $ DownloadFailed (variantFromValue UnsupportedScheme)
 
  where
-  scheme    = view (uriSchemeL' % schemeBSL') rawUri
-  gpgScheme = view (uriSchemeL' % schemeBSL') <$> gpgUri
+  scheme = view (uriSchemeL' % schemeBSL') rawUri
   dl = do
     Settings{ mirrors } <- lift getSettings
     let uri = applyMirrors mirrors rawUri
@@ -407,14 +402,30 @@ download rawUri gpgUri eDigest eCSize dest mfn etags
                         else pure (\fp -> liftE . internalDL fp)
 #endif
               liftE $ downloadAction baseDestFile uri
-              liftE $ verify gpgSetting baseDestFile
-                (\uri' -> do
-                  gpgDestFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile uri' Nothing
-                  lift $ logDebug $ "downloading: " <> (decUTF8Safe . serializeURIRef') uri' <> " as file " <> T.pack gpgDestFile
-                  flip onException (lift $ hideError doesNotExistErrorType $ recycleFile (tmpFile gpgDestFile)) $
-                    downloadAction gpgDestFile uri'
-                  pure gpgDestFile
-                )
+              case (gpgUri, gpgSetting) of
+                (_, GPGNone) -> pure ()
+                (Just gpgUri', _) -> do
+                  gpgDestFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile gpgUri' Nothing
+                  liftE $ flip onException
+                       (lift $ hideError doesNotExistErrorType $ recycleFile (tmpFile gpgDestFile))
+                   $ catchAllE @_ @'[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] @'[GPGError]
+                        (\e -> if gpgSetting == GPGStrict then throwE (GPGError e) else lift $ logWarn $ T.pack (prettyHFError (GPGError e))
+                        ) $ do
+                      o' <- liftIO getGpgOpts
+                      lift $ logDebug $ "downloading: " <> (decUTF8Safe . serializeURIRef') gpgUri' <> " as file " <> T.pack gpgDestFile
+                      liftE $ downloadAction gpgDestFile gpgUri'
+                      lift $ logInfo $ "verifying signature of: " <> T.pack baseDestFile
+                      let args = o' ++ ["--batch", "--verify", "--quiet", "--no-tty", gpgDestFile, baseDestFile]
+                      cp <- lift $ executeOut "gpg" args Nothing
+                      case cp of
+                        CapturedProcess { _exitCode = ExitFailure i, _stdErr } -> do
+                          lift $ logDebug $ decUTF8Safe' _stdErr
+                          throwE (GPGError @'[ProcessError] (V (NonZeroExit i "gpg" args)))
+                        CapturedProcess { _stdErr } -> lift $ logDebug $ decUTF8Safe' _stdErr
+                _ -> pure ()
+
+              forM_ eCSize  (liftE . flip checkCSize  baseDestFile)
+              forM_ eDigest (liftE . flip checkDigest baseDestFile)
     pure baseDestFile
 
   curlDL :: ( MonadCatch m
@@ -612,41 +623,6 @@ download rawUri gpgUri eDigest eCSize dest mfn etags
       liftIO $ hideError doesNotExistErrorType $ rmFile (etagsFile fp)
       pure Nothing
 
-  verify :: ( MonadReader env m
-            , HasLog env
-            , HasDirs env
-            , HasSettings env
-            , MonadCatch m
-            , MonadMask m
-            , MonadIO m
-            )
-            => GPGSetting
-            -> FilePath
-            -> (URI -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m FilePath)
-            -> Excepts '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ()
-  verify gpgSetting destFile' downloadAction' = do
-    case (gpgUri, gpgSetting) of
-      (_, GPGNone) -> pure ()
-      (Just gpgUri', _) -> do
-        liftE $ catchAllE @_ @'[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] @'[GPGError]
-              (\e -> if gpgSetting == GPGStrict then throwE (GPGError e) else lift $ logWarn $ T.pack (prettyHFError (GPGError e))
-              ) $ do
-            o' <- liftIO getGpgOpts
-            gpgDestFile <- liftE $ downloadAction' gpgUri'
-            lift $ logInfo $ "verifying signature of: " <> T.pack destFile'
-            let args = o' ++ ["--batch", "--verify", "--quiet", "--no-tty", gpgDestFile, destFile']
-            cp <- lift $ executeOut "gpg" args Nothing
-            case cp of
-              CapturedProcess { _exitCode = ExitFailure i, _stdErr } -> do
-                lift $ logDebug $ decUTF8Safe' _stdErr
-                throwE (GPGError @'[ProcessError] (V (NonZeroExit i "gpg" args)))
-              CapturedProcess { _stdErr } -> lift $ logDebug $ decUTF8Safe' _stdErr
-      _ -> pure ()
-
-    forM_ eCSize  (liftE . flip checkCSize  destFile')
-    forM_ eDigest (liftE . flip checkDigest destFile')
-
-
 
 -- | Download into tmpdir or use cached version, if it exists. If filename
 -- is omitted, infers the filename from the url.
@@ -666,7 +642,7 @@ downloadCached :: ( MonadReader env m
 downloadCached dli mfn = do
   Settings{ cache } <- lift getSettings
   case cache of
-    True -> liftE $ downloadCached' dli mfn Nothing
+    True -> downloadCached' dli mfn Nothing
     False -> do
       tmp <- lift withGHCupTmpDir
       liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) (fromGHCupPath tmp) outputFileName False

lib/GHCup/Types.hs

@@ -22,7 +22,6 @@ module GHCup.Types
   ( module GHCup.Types
 #if defined(BRICK)
   , Key(..)
-  , Modifier(..)
 #endif
   )
   where
@@ -40,13 +39,14 @@ import           Optics                         ( makeLenses )
 import           Text.PrettyPrint.HughesPJClass (Pretty, pPrint, text)
 import           URI.ByteString
 #if defined(BRICK)
-import           Graphics.Vty                   ( Key(..), Modifier(..) )
+import           Graphics.Vty                   ( Key(..) )
 #endif
 
 import qualified Data.ByteString.Lazy          as BL
 import qualified Data.Text                     as T
 import qualified GHC.Generics                  as GHC
 import qualified Data.List.NonEmpty            as NE
+import           Data.Foldable                  (foldMap)
 
 #if !defined(BRICK)
 data Key = KEsc  | KChar Char | KBS | KEnter
@@ -55,14 +55,8 @@ data Key = KEsc  | KChar Char | KBS | KEnter
          | KFun Int | KBackTab | KPrtScr | KPause | KIns
          | KHome | KPageUp | KDel | KEnd | KPageDown | KBegin | KMenu
     deriving (Eq,Show,Read,Ord,GHC.Generic)
-
-data Modifier = MShift | MCtrl | MMeta | MAlt
-    deriving (Eq,Show,Read,Ord,GHC.Generic)
 #endif
 
-data KeyCombination = KeyCombination { key :: Key, mods :: [Modifier] }
-    deriving (Eq,Show,Read,Ord,GHC.Generic)
-
 
     --------------------
     --[ GHCInfo Tree ]--
@@ -255,18 +249,13 @@ data LinuxDistro = Debian
                  | RedHat
                  | Alpine
                  | AmazonLinux
-                 | Rocky
-                 | Void
                  -- rolling
                  | Gentoo
                  | Exherbo
                  -- not known
                  | UnknownLinux
                  -- ^ must exit
-  deriving (Eq, GHC.Generic, Ord, Show, Enum, Bounded)
-
-allDistros :: [LinuxDistro]
-allDistros = enumFromTo minBound maxBound
+  deriving (Eq, GHC.Generic, Ord, Show)
 
 instance NFData LinuxDistro
 
@@ -279,8 +268,6 @@ distroToString CentOS = "centos"
 distroToString RedHat = "redhat"
 distroToString Alpine = "alpine"
 distroToString AmazonLinux = "amazon"
-distroToString Rocky = "rocky"
-distroToString Void = "void"
 distroToString Gentoo = "gentoo"
 distroToString Exherbo = "exherbo"
 distroToString UnknownLinux = "unknown"
@@ -421,51 +408,47 @@ fromSettings Settings{..} (Just KeyBindings{..}) =
   }
 
 data UserKeyBindings = UserKeyBindings
-  { kUp           :: Maybe KeyCombination
-  , kDown         :: Maybe KeyCombination
-  , kQuit         :: Maybe KeyCombination
-  , kInstall      :: Maybe KeyCombination
-  , kUninstall    :: Maybe KeyCombination
-  , kSet          :: Maybe KeyCombination
-  , kChangelog    :: Maybe KeyCombination
-  , kShowAll      :: Maybe KeyCombination
-  , kShowAllTools :: Maybe KeyCombination
+  { kUp        :: Maybe Key
+  , kDown      :: Maybe Key
+  , kQuit      :: Maybe Key
+  , kInstall   :: Maybe Key
+  , kUninstall :: Maybe Key
+  , kSet       :: Maybe Key
+  , kChangelog :: Maybe Key
+  , kShowAll   :: Maybe Key
+  , kShowAllTools :: Maybe Key
   }
   deriving (Show, GHC.Generic)
 
 data KeyBindings = KeyBindings
-  { bUp              :: KeyCombination
-  , bDown            :: KeyCombination
-  , bQuit            :: KeyCombination
-  , bInstall         :: KeyCombination
-  , bUninstall       :: KeyCombination
-  , bSet             :: KeyCombination
-  , bChangelog       :: KeyCombination
-  , bShowAllVersions :: KeyCombination
-  , bShowAllTools    :: KeyCombination
+  { bUp        :: Key
+  , bDown      :: Key
+  , bQuit      :: Key
+  , bInstall   :: Key
+  , bUninstall :: Key
+  , bSet       :: Key
+  , bChangelog :: Key
+  , bShowAllVersions :: Key
+  , bShowAllTools :: Key
   }
   deriving (Show, GHC.Generic)
 
 instance NFData KeyBindings
 #if defined(IS_WINDOWS) || !defined(BRICK)
 instance NFData Key
-
-instance NFData Modifier
-
 #endif
-instance NFData KeyCombination
 
 defaultKeyBindings :: KeyBindings
 defaultKeyBindings = KeyBindings
-  { bUp              = KeyCombination { key = KUp      , mods = [] }
-  , bDown            = KeyCombination { key = KDown    , mods = [] }
-  , bQuit            = KeyCombination { key = KChar 'q', mods = [] }
-  , bInstall         = KeyCombination { key = KChar 'i', mods = [] }
-  , bUninstall       = KeyCombination { key = KChar 'u', mods = [] }
-  , bSet             = KeyCombination { key = KChar 's', mods = [] }
-  , bChangelog       = KeyCombination { key = KChar 'c', mods = [] }
-  , bShowAllVersions = KeyCombination { key = KChar 'a', mods = [] }
-  , bShowAllTools    = KeyCombination { key = KChar 't', mods = [] }
+  { bUp = KUp
+  , bDown = KDown
+  , bQuit = KChar 'q'
+  , bInstall = KChar 'i'
+  , bUninstall = KChar 'u'
+  , bSet = KChar 's'
+  , bChangelog = KChar 'c'
+  , bShowAllVersions = KChar 'a'
+  , bShowAllTools = KChar 't'
   }
 
 data AppState = AppState

lib/GHCup/Types/JSON.hs

@@ -349,13 +349,15 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Versio
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo
 deriveToJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
 deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Key
-deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Modifier
+deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "k-") . T.pack . kebab $ str' } ''UserKeyBindings
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel, unwrapUnaryRecords = True } ''Port
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel, unwrapUnaryRecords = True } ''Host
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''UserInfo
 deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' (T.unpack . T.toLower) . T.stripPrefix (T.pack "authority") . T.pack $ str' } ''Authority
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadMirror
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadMirrors
+deriveToJSON defaultOptions { fieldLabelModifier = kebab } ''Settings
+deriveToJSON defaultOptions { fieldLabelModifier = drop 2 . kebab } ''KeyBindings -- move under key-bindings key
 
 instance FromJSON URLSource where
   parseJSON v =
@@ -389,21 +391,4 @@ instance FromJSON URLSource where
       r :: [Either GHCupInfo URI] <- o .: "AddSource"
       pure (AddSource r)
 
-instance FromJSON KeyCombination where
-  parseJSON v = proper v <|> simple v
-   where
-    simple = withObject "KeyCombination" $ \o -> do
-      k <- parseJSON (Object o)
-      pure (KeyCombination k [])
-    proper = withObject "KeyCombination" $ \o -> do
-      k <- o .: "Key"
-      m <- o .: "Mods"
-      pure $ KeyCombination k m
-
-instance ToJSON KeyCombination where
-  toJSON (KeyCombination k m) = object ["Key" .= k, "Mods" .= m]
-
-deriveToJSON defaultOptions { fieldLabelModifier = drop 2 . kebab } ''KeyBindings -- move under key-bindings key
-deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "k-") . T.pack . kebab $ str' } ''UserKeyBindings
 deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "u-") . T.pack . kebab $ str' } ''UserSettings
-deriveToJSON defaultOptions { fieldLabelModifier = kebab } ''Settings

lib/GHCup/Utils.hs

@@ -369,9 +369,7 @@ cabalSet = do
   handleIO' NoSuchThing (\_ -> pure Nothing) $ do
     broken <- liftIO $ isBrokenSymlink cabalbin
     if broken
-      then do
-        logWarn $ "Broken symlink at " <> T.pack cabalbin
-        pure Nothing
+      then pure Nothing
       else do
         link <- liftIO
           $ handleIO' InvalidArgument
@@ -468,9 +466,7 @@ stackSet = do
   handleIO' NoSuchThing (\_ -> pure Nothing) $ do
     broken <- liftIO $ isBrokenSymlink stackBin
     if broken
-      then do
-        logWarn $ "Broken symlink at " <> T.pack stackBin
-        pure Nothing
+      then pure Nothing
       else do
         link <- liftIO
           $ handleIO' InvalidArgument
@@ -524,17 +520,15 @@ isLegacyHLS ver = do
 
 
 -- Return the currently set hls version, if any.
-hlsSet :: (HasLog env, MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
+hlsSet :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
 hlsSet = do
   Dirs {..}  <- getDirs
   let hlsBin = binDir </> "haskell-language-server-wrapper" <> exeExt
 
-  handleIO' NoSuchThing (\_ -> pure Nothing) $ do
-    broken <- liftIO $ isBrokenSymlink hlsBin
+  liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ do
+    broken <- isBrokenSymlink hlsBin
     if broken
-      then do
-        logWarn $ "Broken symlink at " <> T.pack hlsBin
-        pure Nothing
+      then pure Nothing
       else do
         link <- liftIO $ getLinkTarget hlsBin
         Just <$> linkVersion link
@@ -562,7 +556,6 @@ hlsSet = do
 -- | Return the GHC versions the currently selected HLS supports.
 hlsGHCVersions :: ( MonadReader env m
                   , HasDirs env
-                  , HasLog env
                   , MonadIO m
                   , MonadThrow m
                   , MonadCatch m
@@ -1086,7 +1079,7 @@ darwinNotarization :: (MonadReader env m, HasDirs env, MonadIO m)
                    -> FilePath
                    -> m (Either ProcessError ())
 darwinNotarization Darwin path = exec
-  "/usr/bin/xattr"
+  "xattr"
   ["-r", "-d", "com.apple.quarantine", path]
   Nothing
   Nothing

lib/GHCup/Version.hs

@@ -34,7 +34,7 @@ import Data.Void (Void)
 -- Note that when updating this, CI requires that the file exsists AND the same file exists at
 -- 'https://www.haskell.org/ghcup/exp/ghcup-<ver>.yaml' with some newlines added.
 ghcupURL :: URI
-ghcupURL = [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-0.0.8.yaml|]
+ghcupURL = [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-0.0.7.yaml|]
 
 -- | The current ghcup version.
 ghcUpVer :: V.PVP
@@ -53,7 +53,7 @@ versionCmp ver1 (VR_eq ver2)   = ver1 == ver2
 
 versionRange :: V.Versioning -> VersionRange -> Bool
 versionRange ver' (SimpleRange cmps) = all (versionCmp ver') cmps
-versionRange ver' (OrRange cmps range) =
+versionRange ver' (OrRange cmps range) = 
   versionRange ver' (SimpleRange cmps) || versionRange ver' range
 
 pvpToVersion :: MonadThrow m => V.PVP -> Text -> m V.Version