Test on JFS, fixes #792

.github/workflows/bootstrap.yaml

@@ -56,3 +56,51 @@ jobs:
           Write-Host "Current Working Directory: $curDir"
           ./scripts/bootstrap/bootstrap-haskell.ps1 -InstallDir ${GITHUB_WORKSPACE} -BootstrapUrl ("{0}/scripts/bootstrap/bootstrap-haskell" -f $curDir) -InBash
         shell: pwsh
+
+  jfs:
+    name: jfs
+    runs-on: [self-hosted, Linux, ARM64, JFS]
+    defaults:
+      run:
+        working-directory: /mnt/jfs
+    env:
+      BOOTSTRAP_HASKELL_CABAL_VERSION: 3.6.2.0
+      BOOTSTRAP_HASKELL_GHC_VERSION: 8.10.7
+      BOOTSTRAP_HASKELL_NONINTERACTIVE: yes
+      GHCUP_INSTALL_BASE_PREFIX: "/mnt/jfs"
+    steps:
+      - uses: docker://hasufell/arm64v8-ubuntu-haskell:focal
+        name: Cleanup
+        with:
+          args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +"
+
+      - name: Checkout code
+        uses: actions/checkout@v3
+
+      - uses: docker://hasufell/arm64v8-ubuntu-haskell:focal
+        name: Run build (arm64v8 linux)
+        with:
+          args: sh ./.github/scripts/bootstrap.sh
+        env:
+          BOOTSTRAP_HASKELL_CABAL_VERSION: ${{ env.BOOTSTRAP_HASKELL_CABAL_VERSION }}
+          BOOTSTRAP_HASKELL_GHC_VERSION: ${{ env.BOOTSTRAP_HASKELL_GHC_VERSION }}
+          BOOTSTRAP_HASKELL_NONINTERACTIVE: ${{ env.BOOTSTRAP_HASKELL_NONINTERACTIVE }}
+          GHCUP_INSTALL_BASE_PREFIX: ${{ env.GHCUP_INSTALL_BASE_PREFIX }}
+
+  some:
+    name: some
+    runs-on: ubuntu-20.04
+    steps:
+      - name: Checkout code
+        uses: actions/checkout@v3
+        with:
+          submodules: 'true'
+
+      - name: Test ghcup bug
+        run: |
+          ls -lah /usr/local/.ghcup/cache
+          ghcup --version
+          ghcup --verbose list
+
+
+

app/ghcup/BrickMain.hs

@@ -11,6 +11,7 @@ module BrickMain where
 import           GHCup
 import           GHCup.Download
 import           GHCup.Errors
+import           GHCup.Types.Optics ( getDirs )
 import           GHCup.Types         hiding ( LeanAppState(..) )
 import           GHCup.Utils
 import           GHCup.OptParse.Common (logGHCPostRm)
@@ -19,7 +20,6 @@ import           GHCup.Prelude.File
 import           GHCup.Prelude.Logger
 import           GHCup.Prelude.Process
 import           GHCup.Prompts
-import           GHCup.Types.Optics hiding ( getGHCupInfo )
 
 import           Brick
 import           Brick.Widgets.Border
@@ -53,7 +53,6 @@ import           System.Exit
 import           System.IO.Unsafe
 import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 import           URI.ByteString
-import           Optics ( view )
 
 import qualified Data.Text                     as T
 import qualified Data.Text.Lazy.Builder        as B
@@ -478,7 +477,7 @@ install' _ (_, ListResult {..}) = do
     )
     >>= \case
           VRight (vi, Dirs{..}, Just ce) -> do
-            forM_ (view viPostInstall =<< vi) $ \msg -> logInfo msg
+            forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
             case lTool of
               GHCup -> do
                 up <- liftIO $ fmap (either (const Nothing) Just)
@@ -490,7 +489,7 @@ install' _ (_, ListResult {..}) = do
               _ -> pure ()
             pure $ Right ()
           VRight (vi, _, _) -> do
-            forM_ (view viPostInstall =<< vi) $ \msg -> logInfo msg
+            forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
             logInfo "Please restart 'ghcup' for the changes to take effect"
             pure $ Right ()
           VLeft  (V (AlreadyInstalled _ _)) -> pure $ Right ()
@@ -565,7 +564,7 @@ del' _ (_, ListResult {..}) = do
     >>= \case
           VRight vi -> do
             logGHCPostRm (mkTVer lVer)
-            forM_ (view viPostRemove =<< vi) $ \msg ->
+            forM_ (_viPostRemove =<< vi) $ \msg ->
               logInfo msg
             pure $ Right ()
           VLeft  e -> pure $ Left (prettyHFError e)

app/ghcup/GHCup/OptParse/Common.hs

@@ -57,7 +57,6 @@ import           System.Process                  ( readProcess )
 import           System.FilePath
 import           Text.HTML.TagSoup       hiding ( Tag )
 import           URI.ByteString
-import           Optics ( view )
 
 import qualified Data.ByteString.UTF8          as UTF8
 import qualified Data.Map.Strict               as M
@@ -452,7 +451,7 @@ tagCompleter tool add = listIOCompleter $ do
   case mGhcUpInfo of
     VRight ghcupInfo -> do
       let allTags = filter (/= Old)
-            $ (view viTags) =<< M.elems (availableToolVersions (_ghcupDownloads ghcupInfo) tool)
+            $ _viTags =<< M.elems (availableToolVersions (_ghcupDownloads ghcupInfo) tool)
       pure $ nub $ (add ++) $ fmap tagToString allTags
     VLeft _ -> pure  (nub $ ["recommended", "latest", "latest-prerelease"] ++ add)
 

app/ghcup/GHCup/OptParse/Compile.hs

@@ -16,11 +16,11 @@ import qualified GHCup.GHC as GHC
 import qualified GHCup.HLS as HLS
 import           GHCup.Errors
 import           GHCup.Types
+import           GHCup.Types.Optics
 import           GHCup.Utils
 import           GHCup.Prelude.Logger
 import           GHCup.Prelude.String.QQ
 import           GHCup.OptParse.Common
-import           GHCup.Types.Optics
 
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
@@ -36,7 +36,6 @@ import           Data.Versions                  ( Version, prettyVer, version, p
 import qualified Data.Versions as V
 import           Data.Text                      ( Text )
 import           Haskus.Utils.Variant.Excepts
-import           Optics
 import           Options.Applicative     hiding ( style )
 import           Options.Applicative.Help.Pretty ( text )
 import           Prelude                 hiding ( appendFile )
@@ -512,7 +511,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
           HLS.SourceDist targetVer -> do
             GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
             let vi = getVersionInfo targetVer HLS dls
-            forM_ (view viPreCompile =<< vi) $ \msg -> do
+            forM_ (_viPreCompile =<< vi) $ \msg -> do
               lift $ logInfo msg
               lift $ logInfo
                 "...waiting for 5 seconds, you can still abort..."
@@ -540,7 +539,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
               VRight (vi, tv) -> do
                 runLogger $ logInfo
                   "HLS successfully compiled and installed"
-                forM_ (view viPostInstall =<< vi) $ \msg ->
+                forM_ (_viPostInstall =<< vi) $ \msg ->
                   runLogger $ logInfo msg
                 liftIO $ putStr (T.unpack $ prettyVer tv)
                 pure ExitSuccess
@@ -564,7 +563,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
           GHC.SourceDist targetVer -> do
             GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
             let vi = getVersionInfo targetVer GHC dls
-            forM_ (view viPreCompile =<< vi) $ \msg -> do
+            forM_ (_viPreCompile =<< vi) $ \msg -> do
               lift $ logInfo msg
               lift $ logInfo
                 "...waiting for 5 seconds, you can still abort..."
@@ -594,7 +593,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
               VRight (vi, tv) -> do
                 runLogger $ logInfo
                   "GHC successfully compiled and installed"
-                forM_ (view viPostInstall =<< vi) $ \msg ->
+                forM_ (_viPostInstall =<< vi) $ \msg ->
                   runLogger $ logInfo msg
                 liftIO $ putStr (T.unpack $ tVerToText tv)
                 pure ExitSuccess

app/ghcup/GHCup/OptParse/Install.hs

@@ -23,7 +23,6 @@ import           GHCup.Utils.Dirs
 import           GHCup.Prelude
 import           GHCup.Prelude.Logger
 import           GHCup.Prelude.String.QQ
-import           GHCup.Types.Optics
 
 import           Codec.Archive
 #if !MIN_VERSION_base(4,13,0)
@@ -37,7 +36,6 @@ import           Data.Maybe
 import           Haskus.Utils.Variant.Excepts
 import           Options.Applicative     hiding ( style )
 import           Options.Applicative.Help.Pretty ( text )
-import           Optics
 import           Prelude                 hiding ( appendFile )
 import           System.Exit
 import           URI.ByteString          hiding ( uriParser )
@@ -347,7 +345,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
         >>= \case
               VRight vi -> do
                 runLogger $ logInfo "GHC installation successful"
-                forM_ (view viPostInstall =<< vi) $ \msg ->
+                forM_ (_viPostInstall =<< vi) $ \msg ->
                   runLogger $ logInfo msg
                 pure ExitSuccess
 
@@ -415,7 +413,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
       >>= \case
             VRight vi -> do
               runLogger $ logInfo "Cabal installation successful"
-              forM_ (view viPostInstall =<< vi) $ \msg ->
+              forM_ (_viPostInstall =<< vi) $ \msg ->
                 runLogger $ logInfo msg
               pure ExitSuccess
             VLeft e@(V (AlreadyInstalled _ _)) -> do
@@ -465,7 +463,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
       >>= \case
             VRight vi -> do
               runLogger $ logInfo "HLS installation successful"
-              forM_ (view viPostInstall =<< vi) $ \msg ->
+              forM_ (_viPostInstall =<< vi) $ \msg ->
                 runLogger $ logInfo msg
               pure ExitSuccess
             VLeft e@(V (AlreadyInstalled _ _)) -> do
@@ -514,7 +512,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
       >>= \case
             VRight vi -> do
               runLogger $ logInfo "Stack installation successful"
-              forM_ (view viPostInstall =<< vi) $ \msg ->
+              forM_ (_viPostInstall =<< vi) $ \msg ->
                 runLogger $ logInfo msg
               pure ExitSuccess
             VLeft e@(V (AlreadyInstalled _ _)) -> do

app/ghcup/GHCup/OptParse/Rm.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE TypeApplications  #-}
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell   #-}
 {-# LANGUAGE QuasiQuotes       #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE RankNTypes #-}
@@ -33,7 +34,6 @@ import           Haskus.Utils.Variant.Excepts
 import           Options.Applicative     hiding ( style )
 import           Prelude                 hiding ( appendFile )
 import           System.Exit
-import           Optics
 
 import qualified Data.Text                     as T
 import Control.Exception.Safe (MonadMask)
@@ -227,5 +227,5 @@ rm rmCommand runAppState runLogger = case rmCommand of
               pure $ ExitFailure 15
 
   postRmLog vi =
-    forM_ (view viPostRemove =<< vi) $ \msg ->
+    forM_ (_viPostRemove =<< vi) $ \msg ->
       runLogger $ logInfo msg

app/ghcup/GHCup/OptParse/Upgrade.hs

@@ -28,7 +28,6 @@ import           Haskus.Utils.Variant.Excepts
 import           Options.Applicative     hiding ( style )
 import           Prelude                 hiding ( appendFile )
 import           System.Exit
-import           Optics ( view )
 
 import qualified Data.Text                     as T
 import Control.Exception.Safe (MonadMask)
@@ -145,7 +144,7 @@ upgrade uOpts force' fatal Dirs{..} runAppState runLogger = do
         let vi = fromJust $ snd <$> getLatest dls GHCup
         runLogger $ logInfo $
           "Successfully upgraded GHCup to version " <> pretty_v
-        forM_ (view viPostInstall vi) $ \msg ->
+        forM_ (_viPostInstall vi) $ \msg ->
           runLogger $ logInfo msg
         pure ExitSuccess
       VLeft (V NoUpdate) -> do

cabal.project

@@ -9,7 +9,7 @@ constraints: http-io-streams -brotli,
              any.aeson >= 2.0.1.0
 
 package libarchive
-  flags: +system-libarchive
+  flags: -system-libarchive
 
 package aeson-pretty
   flags: +lib-only

ghcup.cabal

@@ -258,7 +258,6 @@ executable ghcup
     , libarchive             ^>=3.0.3.0
     , megaparsec             >=8.0.0    && <9.3
     , mtl                    ^>=2.2
-    , optics                ^>=0.4
     , optparse-applicative   >=0.15.1.0 && <0.18
     , pretty                 ^>=1.1.3.1
     , pretty-terminal        ^>=0.1.0.0

lib/GHCup/Cabal.hs

@@ -177,7 +177,7 @@ installCabalBin :: ( MonadMask m
                    , MonadUnliftIO m
                    , MonadFail m
                    )
-                => VersionRev
+                => Version
                 -> InstallDir
                 -> Bool           -- force install
                 -> Excepts
@@ -198,7 +198,7 @@ installCabalBin :: ( MonadMask m
                      ()
 installCabalBin ver installDir forceInstall = do
   dlinfo <- liftE $ getDownloadInfo Cabal ver
-  installCabalBindist dlinfo (vVersion ver) installDir forceInstall
+  installCabalBindist dlinfo ver installDir forceInstall
 
 
     -----------------

lib/GHCup/Download.hs

@@ -277,19 +277,19 @@ getDownloadInfo :: ( MonadReader env m
                    , HasGHCupInfo env
                    )
                 => Tool
-                -> VersionRev
+                -> Version
                 -- ^ tool version
                 -> Excepts
                      '[NoDownload]
                      m
                      DownloadInfo
-getDownloadInfo t (VersionRev v vr) = do
+getDownloadInfo t v = do
   (PlatformRequest a p mv) <- lift getPlatformReq
   GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
 
   let distro_preview f g =
         let platformVersionSpec =
-              preview (ix t % ix v % viDownload % ix vr % viArch % ix a % ix (f p)) dls
+              preview (ix t % ix v % viArch % ix a % ix (f p)) dls
             mv' = g mv
         in  fmap snd
               .   find

lib/GHCup/GHC.hs

@@ -78,7 +78,6 @@ import qualified Data.Text                     as T
 import qualified Data.Text.IO                  as T
 import qualified Data.Text.Encoding            as E
 import qualified Text.Megaparsec               as MP
-import qualified Data.Map.Strict               as M
 
 
 data GHCVer v = SourceDist v
@@ -106,7 +105,7 @@ testGHCVer :: ( MonadFail m
               , MonadIO m
               , MonadUnliftIO m
               )
-           => VersionRev
+           => Version
            -> [T.Text]
            -> Excepts
                 '[ DigestError
@@ -121,11 +120,11 @@ testGHCVer :: ( MonadFail m
                  ]
                 m
                 ()
-testGHCVer (VersionRev ver vr) addMakeArgs = do
+testGHCVer ver addMakeArgs = do
   GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
 
   dlInfo <-
-    preview (ix GHC % ix ver % viDownload % to M.toAscList % maybe _last ix vr % to snd % viTestDL % _Just) dls
+    preview (ix GHC % ix ver % viTestDL % _Just) dls
       ?? NoDownload
 
   liftE $ testGHCBindist dlInfo ver addMakeArgs
@@ -244,7 +243,7 @@ fetchGHCSrc :: ( MonadFail m
                , MonadIO m
                , MonadUnliftIO m
                )
-            => VersionRev
+            => Version
             -> Maybe FilePath
             -> Excepts
                  '[ DigestError
@@ -255,10 +254,10 @@ fetchGHCSrc :: ( MonadFail m
                   ]
                  m
                  FilePath
-fetchGHCSrc (VersionRev v vr) mfp = do
+fetchGHCSrc v mfp = do
   GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
   dlInfo <-
-    preview (ix GHC % ix v % viDownload % to M.toAscList % maybe _last ix vr % to snd % viSourceDL % _Just) dls
+    preview (ix GHC % ix v % viSourceDL % _Just) dls
       ?? NoDownload
   liftE $ downloadCached' dlInfo Nothing mfp
 
@@ -805,7 +804,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
 
         -- download source tarball
         dlInfo <-
-          preview (ix GHC % ix (tver ^. tvVersion) % viDownload % _last % viSourceDL % _Just) dls
+          preview (ix GHC % ix (tver ^. tvVersion) % viSourceDL % _Just) dls
             ?? NoDownload
         dl <- liftE $ downloadCached dlInfo Nothing
 

lib/GHCup/HLS.hs

@@ -368,7 +368,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
 
       -- download source tarball
       dlInfo <-
-        preview (ix HLS % ix tver % viDownload % _last % viSourceDL % _Just) dls
+        preview (ix HLS % ix tver % viSourceDL % _Just) dls
           ?? NoDownload
       dl <- liftE $ downloadCached dlInfo Nothing
 

lib/GHCup/List.hs

@@ -308,7 +308,7 @@ listVersions lt' criteria = do
         isOld  = maybe True (> currentVer) latestVer && maybe True (> currentVer) recommendedVer
     in if | Map.member currentVer av -> Nothing
           | otherwise -> Just $ ListResult { lVer    = currentVer
-                                           , lTag    = maybe (if isOld then [Old] else []) (view viTags) listVer
+                                           , lTag    = maybe (if isOld then [Old] else []) _viTags listVer
                                            , lCross  = Nothing
                                            , lTool   = GHCup
                                            , fromSrc = False
@@ -337,8 +337,7 @@ listVersions lt' criteria = do
                -> [Either FilePath Version]
                -> (Version, VersionInfo)
                -> m ListResult
-  toListResult t cSet cabals hlsSet' hlses stackSet' stacks (v, vi) = do
+  toListResult t cSet cabals hlsSet' hlses stackSet' stacks (v, _viTags -> tags) = do
-    let tags = view viTags vi
     case t of
       GHC -> do
         lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo GHC v

lib/GHCup/Prelude/MegaParsec.hs

@@ -28,8 +28,6 @@ import           System.FilePath
 import qualified Data.List.NonEmpty            as NE
 import qualified Data.Text                     as T
 import qualified Text.Megaparsec               as MP
-import Data.Char (digitToInt)
-import Data.Data (Proxy(..))
 
 
 choice' :: (MonadFail f, MP.MonadParsec e s f) => [f a] -> f a
@@ -88,33 +86,7 @@ ghcTargetVerP =
     <$> (MP.try (Just <$> parseUntil1 (MP.chunk "-" *> verP') <* MP.chunk "-")
         <|> ((\ _ x -> x) Nothing <$> mempty)
         )
-    <*> version'
+    <*> (version' <* MP.eof)
- where
-  verP' :: MP.Parsec Void Text Text
-  verP' = do
-    v <- version'
-    let startsWithDigists =
-          and
-            . take 3
-            . concatMap
-              (map
-                (\case
-                  (Digits _) -> True
-                  (Str    _) -> False
-                ) . NE.toList)
-            . NE.toList
-            $ _vChunks v
-    if startsWithDigists && isNothing (_vEpoch v)
-      then pure $ prettyVer v
-      else fail "Oh"
-
-ghcTargetVerRevP :: MP.Parsec Void Text GHCTargetVersionRev
-ghcTargetVerRevP =
-  (\x y -> GHCTargetVersionRev x y)
-    <$> (MP.try (Just <$> parseUntil1 (MP.chunk "-" *> verP') <* MP.chunk "-")
-        <|> ((\ _ x -> x) Nothing <$> mempty)
-        )
-    <*> versionRevP
  where
   verP' :: MP.Parsec Void Text Text
   verP' = do
@@ -150,44 +122,3 @@ verP suffix = do
 
 pathSep :: MP.Parsec Void Text Char
 pathSep = MP.oneOf pathSeparators
-
-versionRevP :: MP.Parsec Void Text VersionRev
-versionRevP = MP.label "versionRev" $
-  MP.try (parseUntil (MP.try (MP.chunk "-r")) >>= versionWithRev) <|> ((`VersionRev` 0) <$> version')
- where
-  versionWithRev ver = do
-    rest <- MP.getInput
-    MP.setInput ver
-    v <- version'
-    MP.setInput rest
-    _ <- MP.chunk "-r"
-    rev <- parseInt
-    pure $ VersionRev v rev
-
-  digit = MP.oneOf ['0'..'9'] MP.<?> "digit"
-  parseInt :: MP.Parsec Void Text Int
-  parseInt = MP.label "parseInt" $ do
-    i <- MP.tokensToChunk (Proxy :: Proxy Text) <$> some digit
-    pure $ numberValue 10 $ T.unpack i
-
-  numberValue :: Int -> String -> Int
-  numberValue base = foldl (\ x -> ((fromIntegral base * x) +) . fromIntegral . digitToInt) 0
-
-userVersionRevP :: MP.Parsec Void Text UserVersionRev
-userVersionRevP = MP.label "userVersionRev" $
-  ((\(VersionRev v r) -> UserVersionRev v (Just r)) <$> MP.try versionRevP) <|> ((`UserVersionRev` Nothing) <$> version')
-
-
--- | Read a @VersionRev@ from a String.
---
--- - 3.3.2    -> VersionRev { vVersion = 3.3.3, vRev = 0 }
--- - 2.3.4-r3 -> VersionRev { vVersion = 2.3.4, vRev = 3 }
-versionRev :: Text -> Either (MP.ParseErrorBundle Text Void) VersionRev
-versionRev = MP.parse versionRevP ""
-
--- | Read a @UserVersionRev@ from a String.
---
--- - 3.3.2    -> UserVersionRev { vVersion = 3.3.3, vRev = Nothing }
--- - 2.3.4-r3 -> UserVersionRev { vVersion = 2.3.4, vRev = Just 3 }
-userVersionRev :: Text -> Either (MP.ParseErrorBundle Text Void) UserVersionRev
-userVersionRev = MP.parse userVersionRevP ""

lib/GHCup/Types.hs

@@ -44,8 +44,6 @@ import           Graphics.Vty                   ( Key(..) )
 import qualified Data.ByteString.Lazy          as BL
 import qualified Data.Text                     as T
 import qualified GHC.Generics                  as GHC
-import qualified Data.Map.Strict               as M
-
 
 
 #if !defined(BRICK)
@@ -137,19 +135,6 @@ instance NFData GlobalTool
 -- | All necessary information of a tool version, including
 -- source download and per-architecture downloads.
 data VersionInfo = VersionInfo
-  { _viTags        :: [Tag]              -- ^ version specific tag
-  , _viChangeLog   :: Maybe URI
-  , _viDownload    :: Map Int VersionDownload
-  -- informative messages
-  , _viPostInstall :: Maybe Text
-  , _viPostRemove  :: Maybe Text
-  , _viPreCompile  :: Maybe Text
-  }
-  deriving (Eq, GHC.Generic, Show)
-
-instance NFData VersionInfo
-
-data VersionInfoLegacy = VersionInfoLegacy
   { _viTags        :: [Tag]              -- ^ version specific tag
   , _viChangeLog   :: Maybe URI
   , _viSourceDL    :: Maybe DownloadInfo -- ^ source tarball
@@ -162,47 +147,7 @@ data VersionInfoLegacy = VersionInfoLegacy
   }
   deriving (Eq, GHC.Generic, Show)
 
-data VersionDownload = VersionDownload
+instance NFData VersionInfo
-  { _viSourceDL    :: Maybe DownloadInfo -- ^ source tarball
-  , _viTestDL      :: Maybe DownloadInfo -- ^ test tarball
-  , _viArch        :: ArchitectureSpec   -- ^ descend for binary downloads per arch
-
-  }
-  deriving (Eq, GHC.Generic, Show)
-
-instance NFData VersionDownload
-
-fromVersionInfoLegacy :: VersionInfoLegacy -> VersionInfo
-fromVersionInfoLegacy VersionInfoLegacy{..} =
-  VersionInfo {_viDownload = M.singleton 0 $ VersionDownload { _viSourceDL = _viSourceDL
-                                                             , _viTestDL = _viTestDL
-                                                             , _viArch = _viArch
-                                                             }
-              , ..}
-
-
--- | A version with a revision, denoting bindist 'versions' that are purely distribution specific.
---
--- The revision starts at 0.
-data VersionRev = VersionRev { vVersion :: Version, vRev :: Int }
-  deriving (Ord, Eq, GHC.Generic, Show)
-
-showVersionRev :: VersionRev -> Text
-showVersionRev (VersionRev v 0) = prettyVer v
-showVersionRev (VersionRev v r) = prettyVer v <> "-r" <> T.pack (show r)
-
--- | Similar to @VersionRev@, except that revision is optional. The absence of a revision has
--- a particular meaning:
---
--- * for install/prefetch: we want the latest available revision
--- * for compile: it depends
--- * for rm/set/unset/whereis/changelog: we want the revision that is installed (there can be only one)
---
--- Translating @UserVersionRev@ to @VersionRev@ requires context of the GHCup metadata,
--- installed versions and the to be executed command.
-data UserVersionRev = UserVersionRev { uvVersion :: Version, uvRev :: Maybe Int }
-  deriving (Ord, Eq, GHC.Generic, Show)
-
 
 
 -- | A tag. These are currently attached to a version of a tool.
@@ -641,6 +586,12 @@ data GHCTargetVersion = GHCTargetVersion
   }
   deriving (Ord, Eq, Show)
 
+data GitBranch = GitBranch
+  { ref  :: String
+  , repo :: Maybe String
+  }
+  deriving (Ord, Eq, Show)
+
 mkTVer :: Version -> GHCTargetVersion
 mkTVer = GHCTargetVersion Nothing
 
@@ -648,30 +599,10 @@ tVerToText :: GHCTargetVersion -> Text
 tVerToText (GHCTargetVersion (Just t) v') = t <> "-" <> prettyVer v'
 tVerToText (GHCTargetVersion Nothing  v') = prettyVer v'
 
--- | A GHC identified by the target platform triple
--- and the version.
-data GHCTargetVersionRev = GHCTargetVersionRev
-  { _tvTargetRev  :: Maybe Text
-  , _tvVersionRev :: VersionRev
-  }
-  deriving (Ord, Eq, Show)
-
-mkTVerRev :: VersionRev -> GHCTargetVersionRev
-mkTVerRev = GHCTargetVersionRev Nothing
-
-tVerRevToText :: GHCTargetVersionRev -> Text
-tVerRevToText (GHCTargetVersionRev (Just t) v') = t <> "-" <> showVersionRev v'
-tVerRevToText (GHCTargetVersionRev Nothing  v') = showVersionRev v'
-
 -- | Assembles a path of the form: <target-triple>-<version>
 instance Pretty GHCTargetVersion where
   pPrint = text . T.unpack . tVerToText
 
-data GitBranch = GitBranch
-  { ref  :: String
-  , repo :: Maybe String
-  }
-  deriving (Ord, Eq, Show)
 
 -- | A comparator and a version.
 data VersionCmp = VR_gt Versioning

lib/GHCup/Types/JSON.hs

@@ -320,18 +320,11 @@ instance FromJSONKey (Maybe VersionRange)  where
       Right x -> pure $ Just x
       Left  e -> fail $ "Failure in (Maybe VersionRange) (FromJSONKey)" <> MP.errorBundlePretty e
 
+
+
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requirements
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadInfo
-deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfoLegacy
+deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo
-deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionDownload
-
-instance FromJSON VersionInfo where
-  parseJSON v = parseLegacy v <|> parseNew v
-   where
-    parseLegacy = fmap fromVersionInfoLegacy . parseJSON @VersionInfoLegacy
-    parseNew = genericParseJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel }
-
-deriveToJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo
 deriveToJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
 deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Key

lib/GHCup/Types/Optics.hs

@@ -37,7 +37,6 @@ makeLenses ''PlatformResult
 makeLenses ''DownloadInfo
 makeLenses ''Tag
 makeLenses ''VersionInfo
-makeLenses ''VersionDownload
 
 makeLenses ''GHCTargetVersion
 

lib/GHCup/Utils.hs

@@ -160,7 +160,7 @@ rmMinorGHCSymlinks :: ( MonadReader env m
 rmMinorGHCSymlinks tv@GHCTargetVersion{..} = do
   Dirs {..}  <- lift getDirs
 
-  files <- liftE $ ghcToolFiles tv
+  files                         <- liftE $ ghcToolFiles tv
   forM_ files $ \f -> do
     let f_xyz = f <> "-" <> T.unpack (prettyVer _tvVersion) <> exeExt
     let fullF = binDir </> f_xyz
@@ -181,7 +181,7 @@ rmPlainGHC :: ( MonadReader env m
            -> Excepts '[NotInstalled] m ()
 rmPlainGHC target = do
   Dirs {..}  <- lift getDirs
-  mtv <- lift $ ghcSet target
+  mtv                           <- lift $ ghcSet target
   forM_ mtv $ \tv -> do
     files <- liftE $ ghcToolFiles tv
     forM_ files $ \f -> do
@@ -228,7 +228,7 @@ rmMinorHLSSymlinks :: ( MonadReader env m
                       , MonadFail m
                       , MonadMask m
                       )
-                   => VersionRev
+                   => Version
                    -> Excepts '[NotInstalled] m ()
 rmMinorHLSSymlinks ver = do
   Dirs {..}  <- lift getDirs
@@ -281,7 +281,7 @@ rmPlainHLS = do
     -----------------------------------
 
 
--- | Whether the given GHC version is installed.
+-- | Whether the given GHC versin is installed.
 ghcInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) => GHCTargetVersion -> m Bool
 ghcInstalled ver = do
   ghcdir <- ghcupGHCDir ver
@@ -299,7 +299,7 @@ ghcSrcInstalled ver = do
 ghcSet :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
        => Maybe Text   -- ^ the target of the GHC version, if any
                        --  (e.g. armv7-unknown-linux-gnueabihf)
-       -> m (Maybe GHCTargetVersionRev)
+       -> m (Maybe GHCTargetVersion)
 ghcSet mtarget = do
   Dirs {..}  <- getDirs
   let ghc = maybe "ghc" (\t -> T.unpack t <> "-ghc") mtarget
@@ -311,7 +311,7 @@ ghcSet mtarget = do
     link <- liftIO $ getLinkTarget ghcBin
     Just <$> ghcLinkVersion link
  where
-  ghcLinkVersion :: MonadThrow m => FilePath -> m GHCTargetVersionRev
+  ghcLinkVersion :: MonadThrow m => FilePath -> m GHCTargetVersion
   ghcLinkVersion (T.pack . dropSuffix exeExt -> t) = throwEither $ MP.parse parser "ghcLinkVersion" t
    where
     parser =
@@ -321,7 +321,7 @@ ghcSet mtarget = do
            r    <- parseUntil1 pathSep
            rest <- MP.getInput
            MP.setInput r
-           x <- ghcTargetVerRevP
+           x <- ghcTargetVerP
            MP.setInput rest
            pure x
          )
@@ -347,13 +347,13 @@ getInstalledCabals :: ( MonadReader env m
                       , MonadIO m
                       , MonadCatch m
                       )
-                   => m [Either FilePath VersionRev]
+                   => m [Either FilePath Version]
 getInstalledCabals = do
   Dirs {..} <- getDirs
   bins   <- liftIO $ handleIO (\_ -> pure []) $ findFiles
     binDir
     (makeRegexOpts compExtended execBlank ([s|^cabal-.*$|] :: ByteString))
-  vs <- forM bins $ \f -> case versionRev . T.pack <$> (stripSuffix exeExt =<< stripPrefix "cabal-" f) of
+  vs <- forM bins $ \f -> case version . T.pack <$> (stripSuffix exeExt =<< stripPrefix "cabal-" f) of
     Just (Right r) -> pure $ Right r
     Just (Left  _) -> pure $ Left f
     Nothing        -> pure $ Left f
@@ -361,14 +361,14 @@ getInstalledCabals = do
 
 
 -- | Whether the given cabal version is installed.
-cabalInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => VersionRev -> m Bool
+cabalInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
 cabalInstalled ver = do
   vers <- fmap rights getInstalledCabals
   pure $ elem ver vers
 
 
 -- Return the currently set cabal version, if any.
-cabalSet :: (HasLog env, MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe VersionRev)
+cabalSet :: (HasLog env, MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
 cabalSet = do
   Dirs {..}  <- getDirs
   let cabalbin = binDir </> "cabal" <> exeExt
@@ -395,7 +395,7 @@ cabalSet = do
   -- We try to be extra permissive with link destination parsing,
   -- because of:
   --   https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/119
-  linkVersion :: MonadThrow m => FilePath -> m VersionRev
+  linkVersion :: MonadThrow m => FilePath -> m Version
   linkVersion = throwEither . MP.parse parser "linkVersion" . T.pack . dropSuffix exeExt
 
   parser
@@ -403,7 +403,7 @@ cabalSet = do
     <|> MP.try (stripRelativePath *> cabalParse)
     <|> cabalParse
   -- parses the version of "cabal-3.2.0.0" -> "3.2.0.0"
-  cabalParse = MP.chunk "cabal-" *> versionRevP
+  cabalParse = MP.chunk "cabal-" *> version'
   -- parses any path component ending with path separator,
   -- e.g. "foo/"
   stripPathComponet = parseUntil1 pathSep *> MP.some pathSep
@@ -420,7 +420,7 @@ cabalSet = do
 -- @~\/.ghcup\/bin/haskell-language-server-wrapper-<\hlsver\>@,
 -- as well as @~\/.ghcup\/hls\/<\hlsver\>@
 getInstalledHLSs :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m)
-                 => m [Either FilePath VersionRev]
+                 => m [Either FilePath Version]
 getInstalledHLSs = do
   Dirs {..}  <- getDirs
   bins                          <- liftIO $ handleIO (\_ -> pure []) $ findFiles
@@ -431,7 +431,7 @@ getInstalledHLSs = do
     )
   legacy <- forM bins $ \f ->
     case
-          versionRev . T.pack <$> (stripSuffix exeExt =<< stripPrefix "haskell-language-server-wrapper-" f)
+          version . T.pack <$> (stripSuffix exeExt =<< stripPrefix "haskell-language-server-wrapper-" f)
       of
         Just (Right r) -> pure $ Right r
         Just (Left  _) -> pure $ Left f
@@ -448,7 +448,7 @@ getInstalledHLSs = do
 -- | Get all installed stacks, by matching on
 -- @~\/.ghcup\/bin/stack-<\stackver\>@.
 getInstalledStacks :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m)
-                   => m [Either FilePath VersionRev]
+                   => m [Either FilePath Version]
 getInstalledStacks = do
   Dirs {..}  <- getDirs
   bins                          <- liftIO $ handleIO (\_ -> pure []) $ findFiles
@@ -458,7 +458,7 @@ getInstalledStacks = do
                    ([s|^stack-.*$|] :: ByteString)
     )
   forM bins $ \f ->
-    case versionRev . T.pack <$> (stripSuffix exeExt =<< stripPrefix "stack-" f) of
+    case version . T.pack <$> (stripSuffix exeExt =<< stripPrefix "stack-" f) of
         Just (Right r) -> pure $ Right r
         Just (Left  _) -> pure $ Left f
         Nothing        -> pure $ Left f
@@ -509,13 +509,13 @@ stackSet = do
     stripRelativePath = MP.many (MP.try stripPathComponet)
 
 -- | Whether the given Stack version is installed.
-stackInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => VersionRev -> m Bool
+stackInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
 stackInstalled ver = do
   vers <- fmap rights getInstalledStacks
   pure $ elem ver vers
 
 -- | Whether the given HLS version is installed.
-hlsInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => VersionRev -> m Bool
+hlsInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
 hlsInstalled ver = do
   vers <- fmap rights getInstalledHLSs
   pure $ elem ver vers
@@ -527,7 +527,7 @@ isLegacyHLS ver = do
 
 
 -- Return the currently set hls version, if any.
-hlsSet :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe VersionRev)
+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
@@ -540,7 +540,7 @@ hlsSet = do
         link <- liftIO $ getLinkTarget hlsBin
         Just <$> linkVersion link
  where
-  linkVersion :: MonadThrow m => FilePath -> m VersionRev
+  linkVersion :: MonadThrow m => FilePath -> m Version
   linkVersion = throwEither . MP.parse parser "" . T.pack . dropSuffix exeExt
    where
     parser
@@ -548,7 +548,7 @@ hlsSet = do
       <|> MP.try (stripRelativePath *> cabalParse)
       <|> cabalParse
     -- parses the version of "haskell-language-server-wrapper-1.1.0" -> "1.1.0"
-    cabalParse = MP.chunk "haskell-language-server-wrapper-" *> versionRevP
+    cabalParse = MP.chunk "haskell-language-server-wrapper-" *> version'
     -- parses any path component ending with path separator,
     -- e.g. "foo/"
     stripPathComponet = parseUntil1 pathSep *> MP.some pathSep
@@ -567,7 +567,7 @@ hlsGHCVersions :: ( MonadReader env m
                   , MonadThrow m
                   , MonadCatch m
                   )
-               => m [VersionRev]
+               => m [Version]
 hlsGHCVersions = do
   h <- hlsSet
   fromMaybe [] <$> forM h hlsGHCVersions'
@@ -579,12 +579,12 @@ hlsGHCVersions' :: ( MonadReader env m
                    , MonadThrow m
                    , MonadCatch m
                    )
-                => VersionRev
+                => Version
-                -> m [VersionRev]
+                -> m [Version]
 hlsGHCVersions' v' = do
   bins <- hlsServerBinaries v' Nothing
   let vers = fmap
-        (versionRev
+        (version
           . T.pack
           . fromJust
           . stripPrefix "haskell-language-server-"
@@ -597,10 +597,10 @@ hlsGHCVersions' v' = do
 
 -- | Get all server binaries for an hls version from the ~/.ghcup/bin directory, if any.
 hlsServerBinaries :: (MonadReader env m, HasDirs env, MonadIO m)
-                  => VersionRev
+                  => Version
                   -> Maybe Version   -- ^ optional GHC version
                   -> m [FilePath]
-hlsServerBinaries (VersionRev ver rv) mghcVer = do
+hlsServerBinaries ver mghcVer = do
   Dirs {..}  <- getDirs
   liftIO $ handleIO (\_ -> pure []) $ findFiles
     binDir
@@ -611,7 +611,6 @@ hlsServerBinaries (VersionRev ver rv) mghcVer = do
         <> maybe [s|.*|] escapeVerRex mghcVer
         <> [s|~|]
         <> escapeVerRex ver
-        <> E.encodeUtf8 (T.pack ("-r" <> show rv))
         <> E.encodeUtf8 (T.pack exeExt)
         <> [s|$|] :: ByteString
       )
@@ -658,20 +657,16 @@ hlsInternalServerLibs ver ghcVer = do
 
 -- | Get the wrapper binary for an hls version, if any.
 hlsWrapperBinary :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
-                 => VersionRev
+                 => Version
                  -> m (Maybe FilePath)
-hlsWrapperBinary (VersionRev ver rv) = do
+hlsWrapperBinary ver = do
   Dirs {..}  <- getDirs
   wrapper <- liftIO $ handleIO (\_ -> pure []) $ findFiles
     binDir
     (makeRegexOpts
       compExtended
       execBlank
-      ([s|^haskell-language-server-wrapper-|]
+      ([s|^haskell-language-server-wrapper-|] <> escapeVerRex ver <> E.encodeUtf8 (T.pack exeExt) <> [s|$|] :: ByteString
-      <> escapeVerRex ver
-      <> E.encodeUtf8 (T.pack ("-r" <> show rv))
-      <> E.encodeUtf8 (T.pack exeExt)
-      <> [s|$|] :: ByteString
       )
     )
   case wrapper of
@@ -682,7 +677,7 @@ hlsWrapperBinary (VersionRev ver rv) = do
 
 
 -- | Get all binaries for an hls version, if any.
-hlsAllBinaries :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m) => VersionRev -> m [FilePath]
+hlsAllBinaries :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m) => Version -> m [FilePath]
 hlsAllBinaries ver = do
   hls     <- hlsServerBinaries ver Nothing
   wrapper <- hlsWrapperBinary ver
@@ -786,9 +781,6 @@ getLatestToolFor tool pvpIn dls = do
   let ps = catMaybes $ fmap (\(v, vi) -> (,vi) <$> versionToPVP v) ls
   pure . fmap (first fst) . headMay . filter (\((v, _), _) -> matchPVPrefix pvpIn v) $ ps
 
--- type ToolVersionSpec = Map Version ToolRevisionSpec
--- type ToolRevisionSpec = Map Int VersionInfo
-
 
 
 
@@ -935,7 +927,7 @@ ghcInternalBinDir ver = do
 --
 --   - @["hsc2hs","haddock","hpc","runhaskell","ghc","ghc-pkg","ghci","runghc","hp2ps"]@
 ghcToolFiles :: (MonadReader env m, HasDirs env, MonadThrow m, MonadFail m, MonadIO m)
-             => GHCTargetVersionRev
+             => GHCTargetVersion
              -> Excepts '[NotInstalled] m [FilePath]
 ghcToolFiles ver = do
   bindir <- ghcInternalBinDir ver
@@ -1293,7 +1285,7 @@ warnAboutHlsCompatibility :: ( MonadReader env m
                           => m ()
 warnAboutHlsCompatibility = do
   supportedGHC <- hlsGHCVersions
-  currentGHC   <- fmap _tvVersionRev <$> ghcSet Nothing
+  currentGHC   <- fmap _tvVersion <$> ghcSet Nothing
   currentHLS   <- hlsSet
 
   case (currentGHC, currentHLS) of

lib/GHCup/Utils/Dirs.hs

@@ -417,9 +417,9 @@ parseGHCupGHCDir :: MonadThrow m => FilePath -> m GHCTargetVersion
 parseGHCupGHCDir (T.pack -> fp) =
   throwEither $ MP.parse ghcTargetVerP "" fp
 
-parseGHCupHLSDir :: MonadThrow m => FilePath -> m VersionRev
+parseGHCupHLSDir :: MonadThrow m => FilePath -> m Version
 parseGHCupHLSDir (T.pack -> fp) =
-  throwEither $ versionRev fp
+  throwEither $ MP.parse version' "" fp
 
 -- TODO: inlined from GHCup.Prelude
 throwEither :: (Exception a, MonadThrow m) => Either a b -> m b

test/GHCup/ArbitraryTypes.hs

@@ -147,10 +147,6 @@ instance Arbitrary Architecture where
   arbitrary = genericArbitrary
   shrink    = genericShrink
 
-instance Arbitrary VersionDownload where
-  arbitrary = genericArbitrary
-  shrink    = genericShrink
-
 instance Arbitrary VersionInfo where
   arbitrary = genericArbitrary
   shrink    = genericShrink