Merge branch 'PR/issue-116'

.gitlab/script/ghcup_version.sh

@@ -107,6 +107,10 @@ fi
 
 eghcup rm $(ghc --numeric-version)
 
+# https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/116
+eghcup install cabal -u https://oleg.fi/cabal-install-3.4.0.0-rc4/cabal-install-3.4.0.0-x86_64-ubuntu-16.04.tar.xz 3.4.0.0-rc4
+eghcup rm cabal 3.4.0.0-rc4
+
 eghcup upgrade
 eghcup upgrade -f
 

app/ghcup/BrickMain.hs

@@ -16,7 +16,6 @@ import           GHCup.Types
 import           GHCup.Utils
 import           GHCup.Utils.File
 import           GHCup.Utils.Logger
-import           GHCup.Utils.Prelude     hiding ((!?))
 
 import           Brick
 import           Brick.Widgets.Border
@@ -419,30 +418,26 @@ install' BrickState { appData = BrickData {..} } (_, ListResult {..}) = do
               , DownloadFailed
               , NoUpdate
               , TarDirDoesNotExist
-              , VerNotFound
               ]
 
   (run $ do
       case lTool of
         GHC   -> do
-          vi <- liftE @_ @'[VerNotFound] $ getVersionInfo lVer GHC dls
-            ?? VerNotFound lVer GHC
+          let vi = getVersionInfo lVer GHC dls
           liftE $ installGHCBin dls lVer pfreq $> vi
         Cabal -> do
-          vi <- liftE @_ @'[VerNotFound] $ getVersionInfo lVer Cabal dls
-            ?? VerNotFound lVer Cabal
+          let vi = getVersionInfo lVer Cabal dls
           liftE $ installCabalBin dls lVer pfreq $> vi
         GHCup -> do
-          let vi = fromJust $ snd <$> getLatest dls GHCup
+          let vi = snd <$> getLatest dls GHCup
           liftE $ upgradeGHCup dls Nothing False pfreq $> vi
         HLS   -> do
-          vi <- liftE @_ @'[VerNotFound] $ getVersionInfo lVer HLS dls
-            ?? VerNotFound lVer HLS
+          let vi = getVersionInfo lVer HLS dls
           liftE $ installHLSBin dls lVer pfreq $> vi
     )
     >>= \case
           VRight vi                         -> do
-            forM_ (_viPostInstall vi) $ \msg ->
+            forM_ (join $ fmap _viPostInstall vi) $ \msg ->
               runLogger $ $(logInfo) msg
             pure $ Right ()
           VLeft  (V (AlreadyInstalled _ _)) -> pure $ Right ()
@@ -480,23 +475,21 @@ del' BrickState { appData = BrickData {..} } (_, ListResult {..}) = do
   l        <- readIORef logger'
   let runLogger = myLoggerT l
 
-  let run = runLogger . flip runReaderT settings . runE @'[NotInstalled, VerNotFound]
+  let run = runLogger . flip runReaderT settings . runE @'[NotInstalled]
 
   (run $ do
-      vi <- liftE @_ @'[VerNotFound] $ getVersionInfo lVer lTool dls
-        ?? VerNotFound lVer lTool
+      let vi = getVersionInfo lVer lTool dls
       case lTool of
-        GHC   -> liftE $ rmGHCVer (GHCTargetVersion lCross lVer) $> Just vi
-        Cabal -> liftE $ rmCabalVer lVer $> Just vi
-        HLS   -> liftE $ rmHLSVer lVer $> Just vi
+        GHC   -> liftE $ rmGHCVer (GHCTargetVersion lCross lVer) $> vi
+        Cabal -> liftE $ rmCabalVer lVer $> vi
+        HLS   -> liftE $ rmHLSVer lVer $> vi
         GHCup -> pure Nothing
     )
     >>= \case
-          VRight (Just vi) -> do
-            forM_ (_viPostRemove vi) $ \msg ->
+          VRight vi -> do
+            forM_ (join $ fmap _viPostRemove vi) $ \msg ->
               runLogger $ $(logInfo) msg
             pure $ Right ()
-          VRight _ -> pure $ Right ()
           VLeft  e -> pure $ Left (prettyShow e)
 
 

app/ghcup/Main.hs

@@ -1128,7 +1128,6 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                       , NotInstalled
                       , BuildFailed
                       , TagNotFound
-                      , VerNotFound
                       , DigestError
                       , DownloadFailed
                       , TarDirDoesNotExist
@@ -1146,7 +1145,6 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                   @'[ FileDoesNotExistError
                     , NotInstalled
                     , TagNotFound
-                    , VerNotFound
                     , NextVerNotFound
                     , NoToolVersionSet
                     ]
@@ -1158,7 +1156,6 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                 . runE
                   @'[ NotInstalled
                     , TagNotFound
-                    , VerNotFound
                     , NextVerNotFound
                     , NoToolVersionSet
                     ]
@@ -1170,7 +1167,6 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                 . runE
                   @'[ NotInstalled
                     , TagNotFound
-                    , VerNotFound
                     , NextVerNotFound
                     , NoToolVersionSet
                     ]
@@ -1178,7 +1174,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
           let runListGHC = runLogger . flip runReaderT appstate
 
           let runRm =
-                runLogger . flip runReaderT appstate . runE @'[NotInstalled, VerNotFound]
+                runLogger . flip runReaderT appstate . runE @'[NotInstalled]
 
           let runDebugInfo =
                 runLogger
@@ -1202,7 +1198,6 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                       , UnknownArchive
                       , TarDirDoesNotExist
                       , NotInstalled
-                      , VerNotFound
 #if !defined(TAR)
                       , ArchiveResult
 #endif
@@ -1279,7 +1274,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                     >>= \case
                           VRight vi -> do
                             runLogger $ $(logInfo) ("GHC installation successful")
-                            forM_ (_viPostInstall vi) $ \msg ->
+                            forM_ (join $ fmap _viPostInstall vi) $ \msg ->
                               runLogger $ $(logInfo) msg
                             pure ExitSuccess
                           VLeft (V (AlreadyInstalled _ v)) -> do
@@ -1317,7 +1312,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                   >>= \case
                         VRight vi -> do
                           runLogger $ $(logInfo) ("Cabal installation successful")
-                          forM_ (_viPostInstall vi) $ \msg ->
+                          forM_ (join $ fmap _viPostInstall vi) $ \msg ->
                             runLogger $ $(logInfo) msg
                           pure ExitSuccess
                         VLeft (V (AlreadyInstalled _ v)) -> do
@@ -1347,7 +1342,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                   >>= \case
                         VRight vi -> do
                           runLogger $ $(logInfo) ("HLS installation successful")
-                          forM_ (_viPostInstall vi) $ \msg ->
+                          forM_ (join $ fmap _viPostInstall vi) $ \msg ->
                             runLogger $ $(logInfo) msg
                           pure ExitSuccess
                         VLeft (V (AlreadyInstalled _ v)) -> do
@@ -1412,13 +1407,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                 (runRm $ do
                     liftE $
                       rmGHCVer ghcVer
-                    vi <- liftE @_ @'[VerNotFound] $ getVersionInfo (_tvVersion ghcVer) GHC dls
-                      ?? VerNotFound (_tvVersion ghcVer) GHC
-                    pure vi
+                    pure (getVersionInfo (_tvVersion ghcVer) GHC dls)
                   )
                   >>= \case
                         VRight vi -> do
-                          forM_ (_viPostRemove vi) $ \msg ->
+                          forM_ (join $ fmap _viPostRemove vi) $ \msg ->
                             runLogger $ $(logInfo) msg
                           pure ExitSuccess
                         VLeft  e -> do
@@ -1429,13 +1422,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                 (runRm $ do
                     liftE $
                       rmCabalVer tv
-                    vi <- liftE @_ @'[VerNotFound] $ getVersionInfo tv Cabal dls
-                      ?? VerNotFound tv Cabal
-                    pure vi
+                    pure (getVersionInfo tv Cabal dls)
                   )
                   >>= \case
                         VRight vi -> do
-                          forM_ (_viPostRemove vi) $ \msg ->
+                          forM_ (join $ fmap _viPostRemove vi) $ \msg ->
                             runLogger $ $(logInfo) msg
                           pure ExitSuccess
                         VLeft  e -> do
@@ -1446,13 +1437,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                 (runRm $ do
                     liftE $
                       rmHLSVer tv
-                    vi <- liftE @_ @'[VerNotFound] $ getVersionInfo tv HLS dls
-                      ?? VerNotFound tv HLS
-                    pure vi
+                    pure (getVersionInfo tv HLS dls)
                   )
                   >>= \case
                         VRight vi -> do
-                          forM_ (_viPostRemove vi) $ \msg ->
+                          forM_ (join $ fmap _viPostRemove vi) $ \msg ->
                             runLogger $ $(logInfo) msg
                           pure ExitSuccess
                         VLeft  e -> do
@@ -1508,9 +1497,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
 
             Compile (CompileGHC GHCCompileOptions {..}) ->
               (runCompileGHC $ do
-                vi <- liftE @_ @'[VerNotFound] $ getVersionInfo targetVer GHC dls
-                  ?? VerNotFound targetVer GHC
-                forM_ (_viPreCompile vi) $ \msg -> do
+                let vi = getVersionInfo targetVer GHC dls
+                forM_ (join $ fmap _viPreCompile vi) $ \msg -> do
                   lift $ $(logInfo) msg
                   lift $ $(logInfo)
                     ("...waiting for 5 seconds, you can still abort...")
@@ -1531,7 +1519,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                       VRight vi -> do
                         runLogger $ $(logInfo)
                           ("GHC successfully compiled and installed")
-                        forM_ (_viPostInstall vi) $ \msg ->
+                        forM_ (join $ fmap _viPostInstall vi) $ \msg ->
                           runLogger $ $(logInfo) msg
                         pure ExitSuccess
                       VLeft (V (AlreadyInstalled _ v)) -> do
@@ -1637,32 +1625,32 @@ fromVersion :: (MonadFail m, MonadReader AppState m, MonadThrow m, MonadIO m, Mo
             => GHCupDownloads
             -> Maybe ToolVersion
             -> Tool
-            -> Excepts '[TagNotFound, VerNotFound, NextVerNotFound, NoToolVersionSet] m (GHCTargetVersion, VersionInfo)
+            -> Excepts '[TagNotFound, NextVerNotFound, NoToolVersionSet] m (GHCTargetVersion, Maybe VersionInfo)
 fromVersion av tv tool = fromVersion' av (toSetToolVer tv) tool
 
 fromVersion' :: (MonadFail m, MonadReader AppState m, MonadThrow m, MonadIO m, MonadCatch m)
              => GHCupDownloads
              -> SetToolVersion
              -> Tool
-             -> Excepts '[TagNotFound, VerNotFound, NextVerNotFound, NoToolVersionSet] m (GHCTargetVersion, VersionInfo)
+             -> Excepts '[TagNotFound, NextVerNotFound, NoToolVersionSet] m (GHCTargetVersion, Maybe VersionInfo)
 fromVersion' av SetRecommended tool =
-  (\(x, y) -> (mkTVer x, y)) <$> getRecommended av tool
+  (\(x, y) -> (mkTVer x, Just y)) <$> getRecommended av tool
     ?? TagNotFound Recommended tool
 fromVersion' av (SetToolVersion v) tool = do
-  vi <- getVersionInfo (_tvVersion v) tool av ?? VerNotFound (_tvVersion v) tool
+  let vi = getVersionInfo (_tvVersion v) tool av
   case pvp $ prettyVer (_tvVersion v) of
     Left _ -> pure (v, vi)
     Right (PVP (major' :|[minor'])) ->
       case getLatestGHCFor (fromIntegral major') (fromIntegral minor') av of
-        Just (v', vi') -> pure (GHCTargetVersion (_tvTarget v) v', vi')
+        Just (v', vi') -> pure (GHCTargetVersion (_tvTarget v) v', Just vi')
         Nothing -> pure (v, vi)
     Right _ -> pure (v, vi)
 fromVersion' av  (SetToolTag Latest) tool =
-  (\(x, y) -> (mkTVer x, y)) <$> getLatest av tool ?? TagNotFound Latest tool
+  (\(x, y) -> (mkTVer x, Just y)) <$> getLatest av tool ?? TagNotFound Latest tool
 fromVersion' av (SetToolTag Recommended) tool =
-  (\(x, y) -> (mkTVer x, y)) <$> getRecommended av tool ?? TagNotFound Recommended tool
+  (\(x, y) -> (mkTVer x, Just y)) <$> getRecommended av tool ?? TagNotFound Recommended tool
 fromVersion' av (SetToolTag (Base pvp'')) GHC =
-  (\(x, y) -> (mkTVer x, y)) <$> getLatestBaseVersion av pvp'' ?? TagNotFound (Base pvp'') GHC
+  (\(x, y) -> (mkTVer x, Just y)) <$> getLatestBaseVersion av pvp'' ?? TagNotFound (Base pvp'') GHC
 fromVersion' av SetNext tool = do
   next <- case tool of
     GHC -> do
@@ -1696,7 +1684,7 @@ fromVersion' av SetNext tool = do
         . sort
         $ hlses) ?? NoToolVersionSet tool
     GHCup -> fail "GHCup cannot be set"
-  vi <- getVersionInfo (_tvVersion next) tool av ?? VerNotFound (_tvVersion next) tool
+  let vi = getVersionInfo (_tvVersion next) tool av
   pure (next, vi)
 fromVersion' _ (SetToolTag t') tool =
   throwE $ TagNotFound t' tool

lib/GHCup/Errors.hs

@@ -115,14 +115,6 @@ instance Pretty TagNotFound where
   pPrint (TagNotFound tag tool) =
     text "Unable to find tag" <+> pPrint tag <+> text [i|of tool "#{tool}"|]
 
--- | Unable to find a version of a tool.
-data VerNotFound = VerNotFound Version Tool
-  deriving Show
-
-instance Pretty VerNotFound where
-  pPrint (VerNotFound ver' tool) =
-    text [i|Unable to find version "#{prettyShow ver'}" of tool "#{tool}"|]
-
 -- | Unable to find the next version of a tool (the one after the currently
 -- set one).
 data NextVerNotFound = NextVerNotFound Tool