WIP

.github/workflows/bootstrap.yaml

@@ -51,5 +51,8 @@ jobs:
 
       - if: runner.os == 'Windows'
         name: Run bootstrap
-        run: ./scripts/bootstrap/bootstrap-haskell.ps1 -InstallDir ${GITHUB_WORKSPACE} -BootstrapUrl ${GITHUB_WORKSPACE}/bootstrap-haskell -InBash
+        run: |
+          $curDir = Get-Location
+          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

.github/workflows/release.yaml

@@ -96,7 +96,7 @@ jobs:
             ARCH: ARM
           - os: [self-hosted, Linux, ARM64]
             ARTIFACT: "aarch64-linux-ghcup"
-            GHC_VER: 9.2.5
+            GHC_VER: 9.2.6
             ARCH: ARM64
     steps:
       - uses: docker://arm64v8/debian:10
@@ -166,11 +166,11 @@ jobs:
         include:
           - os: [self-hosted, macOS, ARM64]
             ARTIFACT: "aarch64-apple-darwin-ghcup"
-            GHC_VER: 9.2.5
+            GHC_VER: 9.2.6
             ARCH: ARM64
           - os: macOS-10.15
             ARTIFACT: "x86_64-apple-darwin-ghcup"
-            GHC_VER: 9.2.5
+            GHC_VER: 9.2.6
             ARCH: 64
           - os: windows-latest
             ARTIFACT: "x86_64-mingw64-ghcup"
@@ -337,7 +337,7 @@ jobs:
             DISTRO: Ubuntu
           - os: [self-hosted, Linux, ARM64]
             ARTIFACT: "aarch64-linux-ghcup"
-            GHC_VER: 9.2.5
+            GHC_VER: 9.2.6
             ARCH: ARM64
             DISTRO: Ubuntu
 
@@ -400,12 +400,12 @@ jobs:
         include:
           - os: [self-hosted, macOS, ARM64]
             ARTIFACT: "aarch64-apple-darwin-ghcup"
-            GHC_VER: 9.2.5
+            GHC_VER: 9.2.6
             ARCH: ARM64
             DISTRO: na
           - os: macOS-10.15
             ARTIFACT: "x86_64-apple-darwin-ghcup"
-            GHC_VER: 9.2.5
+            GHC_VER: 9.2.6
             ARCH: 64
             DISTRO: na
           - os: windows-latest

CHANGELOG.md

@@ -1,5 +1,12 @@
 # Revision history for ghcup
 
+## 0.1.19.2 -- 2023-2-24
+
+* Follow-up fix for JFS/ReiserFS and other filesystem that don't support `d_type`, fixes [#787](https://github.com/haskell/ghcup-hs/issues/787)
+    - the previous release had a bug that invalidated that broke it
+* Implement 'latest-prerelease' tag wrt [#788](https://github.com/haskell/ghcup-hs/issues/788)
+* Fix 'Could not parse version of stray directory.DS_Store' warnings on macOs wrt [#797](https://github.com/haskell/ghcup-hs/issues/797)
+
 ## 0.1.19.1 -- 2023-2-19
 
 * Fix GHCup on JFS/ReiserFS and other filesystem that don't support `d_type`, fixes [#766](https://github.com/haskell/ghcup-hs/issues/766)

app/ghcup/BrickMain.hs

@@ -4,13 +4,13 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeApplications  #-}
 {-# LANGUAGE RankNTypes        #-}
+{-# LANGUAGE ViewPatterns      #-}
 
 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,6 +19,7 @@ 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
@@ -52,6 +53,7 @@ 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
@@ -154,8 +156,11 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
       <+> minHSize 15 (str "Version")
       <+> padLeft (Pad 1) (minHSize 25 $ str "Tags")
       <+> padLeft (Pad 5) (str "Notes")
-  renderList' = withDefAttr listAttr . drawListElements renderItem True
-  renderItem _ b listResult@ListResult{..} =
+  renderList' bis@BrickInternalState{..} =
+    let getMinLength = length . intercalate "," . fmap tagToString
+        minLength = V.maximum $ V.map (getMinLength . lTag) clr
+    in withDefAttr listAttr . drawListElements (renderItem minLength) True $ bis
+  renderItem minTagSize _ b listResult@ListResult{lTag = lTag', ..} =
     let marks = if
           | lSet       -> (withAttr (attrName "set") $ str "✔✔")
           | lInstalled -> (withAttr (attrName "installed") $ str "✓ ")
@@ -170,7 +175,7 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
           = updateAttrMap (const dimAttrs) . withAttr (attrName "no-bindist")
           | otherwise  = id
         hooray
-          | elem Latest lTag && not lInstalled =
+          | elem Latest lTag' && not lInstalled =
               withAttr (attrName "hooray")
           | otherwise = id
         active = if b then putCursor "GHCup" (Location (0,0)) . forceAttr (attrName "active") else id
@@ -181,8 +186,8 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
                  (printTool lTool)
                )
           <+> minHSize 15 (str ver)
-          <+> (let l = catMaybes . fmap printTag $ sort lTag
-               in  padLeft (Pad 1) $ minHSize 25 $ if null l
+          <+> (let l = catMaybes . fmap printTag $ sort lTag'
+               in  padLeft (Pad 1) $ minHSize minTagSize $ if null l
                      then emptyWidget
                      else foldr1 (\x y -> x <+> str "," <+> y) l
               )
@@ -200,6 +205,7 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
   printTag Prerelease     = Just $ withAttr (attrName "prerelease") $ str "prerelease"
   printTag (Base pvp'')   = Just $ str ("base-" ++ T.unpack (prettyPVP pvp''))
   printTag Old            = Nothing
+  printTag LatestPrerelease = Just $ withAttr (attrName "latest-prerelease") $ str "latest-prerelease"
   printTag (UnknownTag t) = Just $ str t
 
   printTool Cabal = str "cabal"
@@ -274,6 +280,7 @@ defaultAttributes no_color = attrMap
   , (attrName "recommended"  , Vty.defAttr `withForeColor` Vty.green)
   , (attrName "hls-powered"  , Vty.defAttr `withForeColor` Vty.green)
   , (attrName "latest"       , Vty.defAttr `withForeColor` Vty.yellow)
+  , (attrName "latest-prerelease" , Vty.defAttr `withForeColor` Vty.red)
   , (attrName "prerelease"   , Vty.defAttr `withForeColor` Vty.red)
   , (attrName "compiled"     , Vty.defAttr `withForeColor` Vty.blue)
   , (attrName "stray"        , Vty.defAttr `withForeColor` Vty.blue)
@@ -471,7 +478,7 @@ install' _ (_, ListResult {..}) = do
     )
     >>= \case
           VRight (vi, Dirs{..}, Just ce) -> do
-            forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
+            forM_ (view viPostInstall =<< vi) $ \msg -> logInfo msg
             case lTool of
               GHCup -> do
                 up <- liftIO $ fmap (either (const Nothing) Just)
@@ -483,7 +490,7 @@ install' _ (_, ListResult {..}) = do
               _ -> pure ()
             pure $ Right ()
           VRight (vi, _, _) -> do
-            forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
+            forM_ (view viPostInstall =<< vi) $ \msg -> logInfo msg
             logInfo "Please restart 'ghcup' for the changes to take effect"
             pure $ Right ()
           VLeft  (V (AlreadyInstalled _ _)) -> pure $ Right ()
@@ -558,7 +565,7 @@ del' _ (_, ListResult {..}) = do
     >>= \case
           VRight vi -> do
             logGHCPostRm (mkTVer lVer)
-            forM_ (_viPostRemove =<< vi) $ \msg ->
+            forM_ (view viPostRemove =<< vi) $ \msg ->
               logInfo msg
             pure $ Right ()
           VLeft  e -> pure $ Left (prettyHFError e)

app/ghcup/GHCup/OptParse/Common.hs

@@ -57,6 +57,7 @@ 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
@@ -246,8 +247,9 @@ toolVersionTagEither s' =
 
 tagEither :: String -> Either String Tag
 tagEither s' = case fmap toLower s' of
-  "recommended" -> Right Recommended
-  "latest"      -> Right Latest
+  "recommended"              -> Right Recommended
+  "latest"                   -> Right Latest
+  "latest-prerelease"        -> Right LatestPrerelease
   ('b':'a':'s':'e':'-':ver') -> case pvp (T.pack ver') of
                                   Right x -> Right (Base x)
                                   Left  _ -> Left $ "Invalid PVP version for base " <> ver'
@@ -450,9 +452,9 @@ tagCompleter tool add = listIOCompleter $ do
   case mGhcUpInfo of
     VRight ghcupInfo -> do
       let allTags = filter (/= Old)
-            $ _viTags =<< M.elems (availableToolVersions (_ghcupDownloads ghcupInfo) tool)
+            $ (view viTags) =<< M.elems (availableToolVersions (_ghcupDownloads ghcupInfo) tool)
       pure $ nub $ (add ++) $ fmap tagToString allTags
-    VLeft _ -> pure  (nub $ ["recommended", "latest"] ++ add)
+    VLeft _ -> pure  (nub $ ["recommended", "latest", "latest-prerelease"] ++ add)
 
 versionCompleter :: Maybe ListCriteria -> Tool -> Completer
 versionCompleter criteria tool = versionCompleter' criteria tool (const True)
@@ -706,6 +708,9 @@ fromVersion' (SetToolVersion v) tool = do
 fromVersion' (SetToolTag Latest) tool = do
   GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
   bimap mkTVer Just <$> getLatest dls tool ?? TagNotFound Latest tool
+fromVersion' (SetToolTag LatestPrerelease) tool = do
+  GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
+  bimap mkTVer Just <$> getLatestPrerelease dls tool ?? TagNotFound LatestPrerelease tool
 fromVersion' (SetToolTag Recommended) tool = do
   GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
   bimap mkTVer Just <$> getRecommended dls tool ?? TagNotFound Recommended tool

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,6 +36,7 @@ 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 )
@@ -511,7 +512,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
           HLS.SourceDist targetVer -> do
             GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
             let vi = getVersionInfo targetVer HLS dls
-            forM_ (_viPreCompile =<< vi) $ \msg -> do
+            forM_ (view viPreCompile =<< vi) $ \msg -> do
               lift $ logInfo msg
               lift $ logInfo
                 "...waiting for 5 seconds, you can still abort..."
@@ -539,7 +540,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
               VRight (vi, tv) -> do
                 runLogger $ logInfo
                   "HLS successfully compiled and installed"
-                forM_ (_viPostInstall =<< vi) $ \msg ->
+                forM_ (view viPostInstall =<< vi) $ \msg ->
                   runLogger $ logInfo msg
                 liftIO $ putStr (T.unpack $ prettyVer tv)
                 pure ExitSuccess
@@ -563,7 +564,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
           GHC.SourceDist targetVer -> do
             GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
             let vi = getVersionInfo targetVer GHC dls
-            forM_ (_viPreCompile =<< vi) $ \msg -> do
+            forM_ (view viPreCompile =<< vi) $ \msg -> do
               lift $ logInfo msg
               lift $ logInfo
                 "...waiting for 5 seconds, you can still abort..."
@@ -593,7 +594,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
               VRight (vi, tv) -> do
                 runLogger $ logInfo
                   "GHC successfully compiled and installed"
-                forM_ (_viPostInstall =<< vi) $ \msg ->
+                forM_ (view viPostInstall =<< vi) $ \msg ->
                   runLogger $ logInfo msg
                 liftIO $ putStr (T.unpack $ tVerToText tv)
                 pure ExitSuccess

app/ghcup/GHCup/OptParse/Install.hs

@@ -23,6 +23,7 @@ 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)
@@ -36,6 +37,7 @@ 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 )
@@ -345,7 +347,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
         >>= \case
               VRight vi -> do
                 runLogger $ logInfo "GHC installation successful"
-                forM_ (_viPostInstall =<< vi) $ \msg ->
+                forM_ (view viPostInstall =<< vi) $ \msg ->
                   runLogger $ logInfo msg
                 pure ExitSuccess
 
@@ -413,7 +415,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
       >>= \case
             VRight vi -> do
               runLogger $ logInfo "Cabal installation successful"
-              forM_ (_viPostInstall =<< vi) $ \msg ->
+              forM_ (view viPostInstall =<< vi) $ \msg ->
                 runLogger $ logInfo msg
               pure ExitSuccess
             VLeft e@(V (AlreadyInstalled _ _)) -> do
@@ -463,7 +465,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
       >>= \case
             VRight vi -> do
               runLogger $ logInfo "HLS installation successful"
-              forM_ (_viPostInstall =<< vi) $ \msg ->
+              forM_ (view viPostInstall =<< vi) $ \msg ->
                 runLogger $ logInfo msg
               pure ExitSuccess
             VLeft e@(V (AlreadyInstalled _ _)) -> do
@@ -512,7 +514,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
       >>= \case
             VRight vi -> do
               runLogger $ logInfo "Stack installation successful"
-              forM_ (_viPostInstall =<< vi) $ \msg ->
+              forM_ (view viPostInstall =<< vi) $ \msg ->
                 runLogger $ logInfo msg
               pure ExitSuccess
             VLeft e@(V (AlreadyInstalled _ _)) -> do

app/ghcup/GHCup/OptParse/List.hs

@@ -107,6 +107,7 @@ printListResult no_color raw lr = do
     printTag Prerelease         = color Red "prerelease"
     printTag (Base       pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
     printTag (UnknownTag t    ) = t
+    printTag LatestPrerelease   = color Red "latest-prerelease"
     printTag Old                = ""
 
   let

app/ghcup/GHCup/OptParse/Rm.hs

@@ -3,7 +3,6 @@
 {-# LANGUAGE TypeApplications  #-}
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell   #-}
 {-# LANGUAGE QuasiQuotes       #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE RankNTypes #-}
@@ -34,6 +33,7 @@ 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_ (_viPostRemove =<< vi) $ \msg ->
+    forM_ (view viPostRemove =<< vi) $ \msg ->
       runLogger $ logInfo msg

app/ghcup/GHCup/OptParse/Upgrade.hs

@@ -28,6 +28,7 @@ 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)
@@ -144,7 +145,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_ (_viPostInstall vi) $ \msg ->
+        forM_ (view 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

@@ -1,6 +1,6 @@
 cabal-version:      2.4
 name:               ghcup
-version:            0.1.19.1
+version:            0.1.19.2
 license:            LGPL-3.0-only
 license-file:       LICENSE
 copyright:          Julian Ospald 2020
@@ -258,6 +258,7 @@ 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
                    )
-                => Version
+                => VersionRev
                 -> InstallDir
                 -> Bool           -- force install
                 -> Excepts
@@ -198,7 +198,7 @@ installCabalBin :: ( MonadMask m
                      ()
 installCabalBin ver installDir forceInstall = do
   dlinfo <- liftE $ getDownloadInfo Cabal ver
-  installCabalBindist dlinfo ver installDir forceInstall
+  installCabalBindist dlinfo (vVersion ver) installDir forceInstall
 
 
     -----------------

lib/GHCup/Download.hs

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

lib/GHCup/GHC.hs

@@ -78,6 +78,7 @@ 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
@@ -105,7 +106,7 @@ testGHCVer :: ( MonadFail m
               , MonadIO m
               , MonadUnliftIO m
               )
-           => Version
+           => VersionRev
            -> [T.Text]
            -> Excepts
                 '[ DigestError
@@ -120,11 +121,11 @@ testGHCVer :: ( MonadFail m
                  ]
                 m
                 ()
-testGHCVer ver addMakeArgs = do
+testGHCVer (VersionRev ver vr) addMakeArgs = do
   GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
 
   dlInfo <-
-    preview (ix GHC % ix ver % viTestDL % _Just) dls
+    preview (ix GHC % ix ver % viDownload % to M.toAscList % maybe _last ix vr % to snd % viTestDL % _Just) dls
       ?? NoDownload
 
   liftE $ testGHCBindist dlInfo ver addMakeArgs
@@ -243,7 +244,7 @@ fetchGHCSrc :: ( MonadFail m
                , MonadIO m
                , MonadUnliftIO m
                )
-            => Version
+            => VersionRev
             -> Maybe FilePath
             -> Excepts
                  '[ DigestError
@@ -254,10 +255,10 @@ fetchGHCSrc :: ( MonadFail m
                   ]
                  m
                  FilePath
-fetchGHCSrc v mfp = do
+fetchGHCSrc (VersionRev v vr) mfp = do
   GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
   dlInfo <-
-    preview (ix GHC % ix v % viSourceDL % _Just) dls
+    preview (ix GHC % ix v % viDownload % to M.toAscList % maybe _last ix vr % to snd % viSourceDL % _Just) dls
       ?? NoDownload
   liftE $ downloadCached' dlInfo Nothing mfp
 
@@ -804,7 +805,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
 
         -- download source tarball
         dlInfo <-
-          preview (ix GHC % ix (tver ^. tvVersion) % viSourceDL % _Just) dls
+          preview (ix GHC % ix (tver ^. tvVersion) % viDownload % _last % 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 % viSourceDL % _Just) dls
+        preview (ix HLS % ix tver % viDownload % _last % 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 []) _viTags listVer
+                                           , lTag    = maybe (if isOld then [Old] else []) (view viTags) listVer
                                            , lCross  = Nothing
                                            , lTool   = GHCup
                                            , fromSrc = False
@@ -337,7 +337,8 @@ listVersions lt' criteria = do
                -> [Either FilePath Version]
                -> (Version, VersionInfo)
                -> m ListResult
-  toListResult t cSet cabals hlsSet' hlses stackSet' stacks (v, _viTags -> tags) = do
+  toListResult t cSet cabals hlsSet' hlses stackSet' stacks (v, vi) = do
+    let tags = view viTags vi
     case t of
       GHC -> do
         lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo GHC v

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

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

lib/GHCup/Prelude/MegaParsec.hs

@@ -28,6 +28,8 @@ 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
@@ -86,7 +88,33 @@ ghcTargetVerP =
     <$> (MP.try (Just <$> parseUntil1 (MP.chunk "-" *> verP') <* MP.chunk "-")
         <|> ((\ _ x -> x) Nothing <$> mempty)
         )
-    <*> (version' <* MP.eof)
+    <*> version'
+ 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
@@ -122,3 +150,44 @@ 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,6 +44,8 @@ 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)
@@ -135,6 +137,19 @@ 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
@@ -147,13 +162,54 @@ data VersionInfo = VersionInfo
   }
   deriving (Eq, GHC.Generic, Show)
 
-instance NFData VersionInfo
+data VersionDownload = VersionDownload
+  { _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.
 data Tag = Latest
          | Recommended
          | Prerelease
+         | LatestPrerelease
          | Base PVP
          | Old                -- ^ old versions are hidden by default in TUI
          | UnknownTag String  -- ^ used for upwardscompat
@@ -167,6 +223,7 @@ tagToString Latest             = "latest"
 tagToString Prerelease         = "prerelease"
 tagToString (Base       pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
 tagToString (UnknownTag t    ) = t
+tagToString LatestPrerelease   = "latest-prerelease"
 tagToString Old                = ""
 
 instance Pretty Tag where
@@ -175,6 +232,7 @@ instance Pretty Tag where
   pPrint Prerelease         = text "prerelease"
   pPrint (Base       pvp'') = text ("base-" ++ T.unpack (prettyPVP pvp''))
   pPrint (UnknownTag t    ) = text t
+  pPrint LatestPrerelease   = text "latest-prerelease"
   pPrint Old                = mempty
 
 data Architecture = A_64
@@ -583,12 +641,6 @@ 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
 
@@ -596,10 +648,30 @@ 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

@@ -66,6 +66,7 @@ instance ToJSON Tag where
   toJSON Prerelease         = String "Prerelease"
   toJSON Old                = String "old"
   toJSON (Base       pvp'') = String ("base-" <> prettyPVP pvp'')
+  toJSON LatestPrerelease   = String "LatestPrerelease"
   toJSON (UnknownTag x    ) = String (T.pack x)
 
 instance FromJSON Tag where
@@ -73,6 +74,7 @@ instance FromJSON Tag where
     "Latest"                             -> pure Latest
     "Recommended"                        -> pure Recommended
     "Prerelease"                         -> pure Prerelease
+    "LatestPrerelease"                   -> pure LatestPrerelease
     "old"                                -> pure Old
     ('b' : 'a' : 's' : 'e' : '-' : ver') -> case pvp (T.pack ver') of
       Right x -> pure $ Base x
@@ -318,11 +320,18 @@ 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 } ''VersionInfo
+deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfoLegacy
+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,6 +37,7 @@ 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
                       )
-                   => Version
+                   => VersionRev
                    -> Excepts '[NotInstalled] m ()
 rmMinorHLSSymlinks ver = do
   Dirs {..}  <- lift getDirs
@@ -281,7 +281,7 @@ rmPlainHLS = do
     -----------------------------------
 
 
--- | Whether the given GHC versin is installed.
+-- | Whether the given GHC version 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 GHCTargetVersion)
+       -> m (Maybe GHCTargetVersionRev)
 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 GHCTargetVersion
+  ghcLinkVersion :: MonadThrow m => FilePath -> m GHCTargetVersionRev
   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 <- ghcTargetVerP
+           x <- ghcTargetVerRevP
            MP.setInput rest
            pure x
          )
@@ -335,7 +335,7 @@ ghcSet mtarget = do
 getInstalledGHCs :: (MonadReader env m, HasDirs env, MonadIO m) => m [Either FilePath GHCTargetVersion]
 getInstalledGHCs = do
   ghcdir <- ghcupGHCBaseDir
-  fs     <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectory (fromGHCupPath ghcdir)
+  fs     <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectoryDirs (fromGHCupPath ghcdir)
   forM fs $ \f -> case parseGHCupGHCDir f of
     Right r -> pure $ Right r
     Left  _ -> pure $ Left f
@@ -347,13 +347,13 @@ getInstalledCabals :: ( MonadReader env m
                       , MonadIO m
                       , MonadCatch m
                       )
-                   => m [Either FilePath Version]
+                   => m [Either FilePath VersionRev]
 getInstalledCabals = do
   Dirs {..} <- getDirs
   bins   <- liftIO $ handleIO (\_ -> pure []) $ findFiles
     binDir
     (makeRegexOpts compExtended execBlank ([s|^cabal-.*$|] :: ByteString))
-  vs <- forM bins $ \f -> case version . T.pack <$> (stripSuffix exeExt =<< stripPrefix "cabal-" f) of
+  vs <- forM bins $ \f -> case versionRev . 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) => Version -> m Bool
+cabalInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => VersionRev -> 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 Version)
+cabalSet :: (HasLog env, MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe VersionRev)
 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 Version
+  linkVersion :: MonadThrow m => FilePath -> m VersionRev
   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-" *> version'
+  cabalParse = MP.chunk "cabal-" *> versionRevP
   -- 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 Version]
+                 => m [Either FilePath VersionRev]
 getInstalledHLSs = do
   Dirs {..}  <- getDirs
   bins                          <- liftIO $ handleIO (\_ -> pure []) $ findFiles
@@ -431,14 +431,14 @@ getInstalledHLSs = do
     )
   legacy <- forM bins $ \f ->
     case
-          version . T.pack <$> (stripSuffix exeExt =<< stripPrefix "haskell-language-server-wrapper-" f)
+          versionRev . T.pack <$> (stripSuffix exeExt =<< stripPrefix "haskell-language-server-wrapper-" f)
       of
         Just (Right r) -> pure $ Right r
         Just (Left  _) -> pure $ Left f
         Nothing        -> pure $ Left f
 
   hlsdir <- ghcupHLSBaseDir
-  fs     <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectory (fromGHCupPath hlsdir)
+  fs     <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectoryDirs (fromGHCupPath hlsdir)
   new <- forM fs $ \f -> case parseGHCupHLSDir f of
     Right r -> pure $ Right r
     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 Version]
+                   => m [Either FilePath VersionRev]
 getInstalledStacks = do
   Dirs {..}  <- getDirs
   bins                          <- liftIO $ handleIO (\_ -> pure []) $ findFiles
@@ -458,7 +458,7 @@ getInstalledStacks = do
                    ([s|^stack-.*$|] :: ByteString)
     )
   forM bins $ \f ->
-    case version . T.pack <$> (stripSuffix exeExt =<< stripPrefix "stack-" f) of
+    case versionRev . 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) => Version -> m Bool
+stackInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => VersionRev -> 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) => Version -> m Bool
+hlsInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => VersionRev -> 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 Version)
+hlsSet :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe VersionRev)
 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 Version
+  linkVersion :: MonadThrow m => FilePath -> m VersionRev
   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-" *> version'
+    cabalParse = MP.chunk "haskell-language-server-wrapper-" *> versionRevP
     -- 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 [Version]
+               => m [VersionRev]
 hlsGHCVersions = do
   h <- hlsSet
   fromMaybe [] <$> forM h hlsGHCVersions'
@@ -579,12 +579,12 @@ hlsGHCVersions' :: ( MonadReader env m
                    , MonadThrow m
                    , MonadCatch m
                    )
-                => Version
-                -> m [Version]
+                => VersionRev
+                -> m [VersionRev]
 hlsGHCVersions' v' = do
   bins <- hlsServerBinaries v' Nothing
   let vers = fmap
-        (version
+        (versionRev
           . 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)
-                  => Version
+                  => VersionRev
                   -> Maybe Version   -- ^ optional GHC version
                   -> m [FilePath]
-hlsServerBinaries ver mghcVer = do
+hlsServerBinaries (VersionRev ver rv) mghcVer = do
   Dirs {..}  <- getDirs
   liftIO $ handleIO (\_ -> pure []) $ findFiles
     binDir
@@ -611,6 +611,7 @@ hlsServerBinaries ver mghcVer = do
         <> maybe [s|.*|] escapeVerRex mghcVer
         <> [s|~|]
         <> escapeVerRex ver
+        <> E.encodeUtf8 (T.pack ("-r" <> show rv))
         <> E.encodeUtf8 (T.pack exeExt)
         <> [s|$|] :: ByteString
       )
@@ -626,7 +627,7 @@ hlsInternalServerScripts ver mghcVer = do
   dir <- ghcupHLSDir ver
   let bdir = fromGHCupPath dir </> "bin"
   fmap (bdir </>) . filter (\f -> maybe True (\gv -> ("-" <> T.unpack (prettyVer gv)) `isSuffixOf` f) mghcVer)
-    <$> liftIO (listDirectory bdir)
+    <$> liftIO (listDirectoryFiles bdir)
 
 -- | Get all binaries for a hls version from the ~/.ghcup/hls/<ver>/lib/haskell-language-server-<ver>/bin directory, if any.
 -- Returns the full path.
@@ -639,7 +640,7 @@ hlsInternalServerBinaries ver mghcVer = do
   let regex = makeRegexOpts compExtended execBlank ([s|^haskell-language-server-.*$|] :: ByteString)
   (Just bdir) <- fmap headMay $ liftIO $ expandFilePath [Left (dir </> "lib"), Right regex, Left "bin"]
   fmap (bdir </>) . filter (\f -> maybe True (\gv -> ("-" <> T.unpack (prettyVer gv)) `isSuffixOf` f) mghcVer)
-    <$> liftIO (listDirectory bdir)
+    <$> liftIO (listDirectoryFiles bdir)
 
 -- | Get all libraries for a hls version from the ~/.ghcup/hls/<ver>/lib/haskell-language-server-<ver>/lib/<ghc-ver>/
 -- directory, if any.
@@ -652,21 +653,25 @@ hlsInternalServerLibs ver ghcVer = do
   dir <- fromGHCupPath <$> ghcupHLSDir ver
   let regex = makeRegexOpts compExtended execBlank ([s|^haskell-language-server-.*$|] :: ByteString)
   (Just bdir) <- fmap headMay $ liftIO $ expandFilePath [Left (dir </> "lib"), Right regex, Left ("lib" </> T.unpack (prettyVer ghcVer))]
-  fmap (bdir </>) <$> liftIO (listDirectory bdir)
+  fmap (bdir </>) <$> liftIO (listDirectoryFiles bdir)
 
 
 -- | Get the wrapper binary for an hls version, if any.
 hlsWrapperBinary :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
-                 => Version
+                 => VersionRev
                  -> m (Maybe FilePath)
-hlsWrapperBinary ver = do
+hlsWrapperBinary (VersionRev ver rv) = do
   Dirs {..}  <- getDirs
   wrapper <- liftIO $ handleIO (\_ -> pure []) $ findFiles
     binDir
     (makeRegexOpts
       compExtended
       execBlank
-      ([s|^haskell-language-server-wrapper-|] <> escapeVerRex ver <> E.encodeUtf8 (T.pack exeExt) <> [s|$|] :: ByteString
+      ([s|^haskell-language-server-wrapper-|]
+      <> escapeVerRex ver
+      <> E.encodeUtf8 (T.pack ("-r" <> show rv))
+      <> E.encodeUtf8 (T.pack exeExt)
+      <> [s|$|] :: ByteString
       )
     )
   case wrapper of
@@ -677,7 +682,7 @@ hlsWrapperBinary ver = do
 
 
 -- | Get all binaries for an hls version, if any.
-hlsAllBinaries :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m) => Version -> m [FilePath]
+hlsAllBinaries :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m) => VersionRev -> m [FilePath]
 hlsAllBinaries ver = do
   hls     <- hlsServerBinaries ver Nothing
   wrapper <- hlsWrapperBinary ver
@@ -781,6 +786,9 @@ 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
+
 
 
 
@@ -892,6 +900,9 @@ getTagged tag =
 getLatest :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
 getLatest av tool = headOf (ix tool % getTagged Latest) av
 
+getLatestPrerelease :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
+getLatestPrerelease av tool = headOf (ix tool % getTagged LatestPrerelease) av
+
 getRecommended :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
 getRecommended av tool = headOf (ix tool % getTagged Recommended) av
 
@@ -924,7 +935,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)
-             => GHCTargetVersion
+             => GHCTargetVersionRev
              -> Excepts '[NotInstalled] m [FilePath]
 ghcToolFiles ver = do
   bindir <- ghcInternalBinDir ver
@@ -933,7 +944,7 @@ ghcToolFiles ver = do
   whenM (fmap not $ ghcInstalled ver)
         (throwE (NotInstalled GHC ver))
 
-  files <- liftIO (listDirectory bindir >>= filterM (doesFileExist . (bindir </>)))
+  files <- liftIO (listDirectoryFiles bindir >>= filterM (doesFileExist . (bindir </>)))
   pure (getUniqueTools . groupToolFiles . fmap (dropSuffix exeExt) $ files)
 
  where
@@ -1282,7 +1293,7 @@ warnAboutHlsCompatibility :: ( MonadReader env m
                           => m ()
 warnAboutHlsCompatibility = do
   supportedGHC <- hlsGHCVersions
-  currentGHC   <- fmap _tvVersion <$> ghcSet Nothing
+  currentGHC   <- fmap _tvVersionRev <$> ghcSet Nothing
   currentHLS   <- hlsSet
 
   case (currentGHC, currentHLS) of

lib/GHCup/Utils/Dirs.hs

@@ -42,6 +42,9 @@ module GHCup.Utils.Dirs
   , removeDirectoryRecursive
   , removePathForcibly
 
+  , listDirectoryFiles
+  , listDirectoryDirs
+
   -- System.Directory re-exports
   , createDirectory
   , createDirectoryIfMissing
@@ -130,7 +133,7 @@ import           Data.Maybe
 import           Data.Versions
 import           GHC.IO.Exception               ( IOErrorType(NoSuchThing) )
 import           Haskus.Utils.Variant.Excepts
-import           Optics
+import           Optics hiding ( uncons )
 import           Safe
 import           System.Directory hiding ( removeDirectory
                                          , removeDirectoryRecursive
@@ -414,9 +417,9 @@ parseGHCupGHCDir :: MonadThrow m => FilePath -> m GHCTargetVersion
 parseGHCupGHCDir (T.pack -> fp) =
   throwEither $ MP.parse ghcTargetVerP "" fp
 
-parseGHCupHLSDir :: MonadThrow m => FilePath -> m Version
+parseGHCupHLSDir :: MonadThrow m => FilePath -> m VersionRev
 parseGHCupHLSDir (T.pack -> fp) =
-  throwEither $ MP.parse version' "" fp
+  throwEither $ versionRev fp
 
 -- TODO: inlined from GHCup.Prelude
 throwEither :: (Exception a, MonadThrow m) => Either a b -> m b
@@ -529,6 +532,29 @@ cleanupTrash = do
       ) $ liftIO $ removePathForcibly (recycleDir `appendGHCupPath` fp))
 
 
+-- | List *actual files* in a directory, ignoring empty files and a couple
+-- of blacklisted files, such as '.DS_Store' on mac.
+listDirectoryFiles :: FilePath -> IO [FilePath]
+listDirectoryFiles fp = do
+  listDirectory fp >>= filterM (doesFileExist . (fp </>)) <&> filter (\fp' -> not (isHidden fp') && not (isBlacklisted fp'))
+
+-- | List *actual directories* in a directory, ignoring empty directories and a couple
+-- of blacklisted files, such as '.DS_Store' on mac.
+listDirectoryDirs :: FilePath -> IO [FilePath]
+listDirectoryDirs fp = do
+  listDirectory fp >>= filterM (doesDirectoryExist . (fp </>)) <&> filter (\fp' -> not (isHidden fp') && not (isBlacklisted fp'))
+
+isHidden :: FilePath -> Bool
+isHidden fp'
+  | isWindows = False
+  | Just ('.', _) <- uncons fp' = True
+  | otherwise = False
+
+isBlacklisted :: FilePath -> Bool
+{- HLINT ignore "Use ==" -}
+isBlacklisted fp' = fp' `elem` [".DS_Store"]
+
+
 
 -- System.Directory re-exports with GHCupPath
 

scripts/bootstrap/bootstrap-haskell

@@ -28,7 +28,7 @@
 
 plat="$(uname -s)"
 arch=$(uname -m)
-ghver="0.1.19.0"
+ghver="0.1.19.2"
 : "${GHCUP_BASE_URL:=https://downloads.haskell.org/~ghcup}"
 
 export GHCUP_SKIP_UPDATE_CHECK=yes

scripts/releasing/pull_release_artifacts.sh

@@ -7,6 +7,7 @@ shopt -s extglob
 
 RELEASE=$1
 SIGNER=$2
+TAG=${RELEASE/v/}
 
 echo "RELEASE: $RELEASE"
 echo "SIGNER: $SIGNER"
@@ -18,17 +19,19 @@ done
 [ ! -e "gh-release-artifacts/${RELEASE}" ]
 
 mkdir -p "gh-release-artifacts/${RELEASE}"
+
+git archive --format=tar.gz -o "gh-release-artifacts/${RELEASE}/ghcup-${TAG}-src.tar.gz" --prefix="ghcup-${TAG}/" HEAD
+
 cd "gh-release-artifacts/${RELEASE}"
 
 # github
-gh release download $RELEASE
-
-rm test-*
+gh release download "$RELEASE"
 
 # cirrus
-curl -L -o x86_64-portbld-freebsd-ghcup-${RELEASE} \
+curl -L -o "x86_64-portbld-freebsd-ghcup-${TAG}" \
 	"https://api.cirrus-ci.com/v1/artifact/github/haskell/ghcup-hs/build/binaries/out/x86_64-portbld-freebsd-ghcup-${RELEASE}?branch=${RELEASE}"
 
-sha256sum *ghcup* > SHA256SUMS
+sha256sum ./*-ghcup-* > SHA256SUMS
 gpg --detach-sign -u "${SIGNER}" SHA256SUMS
 
+gh release upload "$RELEASE" "ghcup-${TAG}-src.tar.gz" "x86_64-portbld-freebsd-ghcup-${TAG}" SHA256SUMS SHA256SUMS.sig

scripts/releasing/sftp-symlink-artifacts.sh

@@ -21,8 +21,7 @@ rm i386-linux-ghcup
 rm x86_64-apple-darwin-ghcup
 rm x86_64-linux-ghcup
 rm x86_64-mingw64-ghcup.exe
-rm x86_64-freebsd12-ghcup
-rm x86_64-freebsd13-ghcup
+rm x86_64-portbld-freebsd-ghcup
 
 symlink ${ver}/aarch64-apple-darwin-ghcup-${ver} aarch64-apple-darwin-ghcup
 symlink ${ver}/aarch64-linux-ghcup-${ver} aarch64-linux-ghcup

test/GHCup/ArbitraryTypes.hs

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