ghcup 0.1.19.1 → 0.1.19.2
raw patch · 11 files changed
+156/−104 lines, 11 files
Files
- CHANGELOG.md +7/−0
- app/ghcup/BrickMain.hs +11/−5
- app/ghcup/GHCup/OptParse/Common.hs +7/−3
- app/ghcup/GHCup/OptParse/List.hs +1/−0
- ghcup.cabal +1/−1
- lib/GHCup/Prelude/File/Posix/Traversals.hsc +1/−1
- lib/GHCup/Types.hs +3/−0
- lib/GHCup/Types/JSON.hs +2/−0
- lib/GHCup/Utils.hs +9/−6
- lib/GHCup/Utils/Dirs.hs +27/−1
- test/golden/windows/GHCupInfo.json +87/−87
CHANGELOG.md view
@@ -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 view
@@ -4,6 +4,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ViewPatterns #-} module BrickMain where @@ -154,8 +155,11 @@ <+> 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 +174,7 @@ = 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 +185,8 @@ (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 +204,7 @@ 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 +279,7 @@ , (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)
app/ghcup/GHCup/OptParse/Common.hs view
@@ -246,8 +246,9 @@ 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'@@ -452,7 +453,7 @@ let allTags = filter (/= Old) $ _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 +707,9 @@ 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/List.hs view
@@ -107,6 +107,7 @@ 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
ghcup.cabal view
@@ -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
lib/GHCup/Prelude/File/Posix/Traversals.hsc view
@@ -124,7 +124,6 @@ (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 @@ | isRegularFile stat -> DirType #{const DT_REG} | isSocket stat -> DirType #{const DT_SOCK} | otherwise -> DirType #{const DT_UNKNOWN}+ | otherwise -> pure (dt, fp)
lib/GHCup/Types.hs view
@@ -154,6 +154,7 @@ data Tag = Latest | Recommended | Prerelease+ | LatestPrerelease | Base PVP | Old -- ^ old versions are hidden by default in TUI | UnknownTag String -- ^ used for upwardscompat@@ -167,6 +168,7 @@ 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 +177,7 @@ 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
lib/GHCup/Types/JSON.hs view
@@ -66,6 +66,7 @@ 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 @@ "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
lib/GHCup/Utils.hs view
@@ -335,7 +335,7 @@ 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@@ -438,7 +438,7 @@ 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@@ -626,7 +626,7 @@ 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 +639,7 @@ 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,7 +652,7 @@ 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.@@ -892,6 +892,9 @@ 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 @@ -933,7 +936,7 @@ 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
lib/GHCup/Utils/Dirs.hs view
@@ -42,6 +42,9 @@ , removeDirectoryRecursive , removePathForcibly + , listDirectoryFiles+ , listDirectoryDirs+ -- System.Directory re-exports , createDirectory , createDirectoryIfMissing@@ -130,7 +133,7 @@ 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@@ -527,6 +530,29 @@ forM_ contents (\fp -> handleIO (\e -> logDebug ("Resource cleanup failed for " <> T.pack fp <> ", error was: " <> T.pack (displayException e)) ) $ 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"]
test/golden/windows/GHCupInfo.json view
@@ -195,8 +195,8 @@ "dlUri": "https:g" }, "viTags": [- "base-3.2.2",- "Prerelease",+ "base-6.5.1",+ "base-2.2.5", "𪔊\u0007\u0015" ], "viTestDL": {@@ -271,7 +271,7 @@ "viPreCompile": "thzbtjc", "viSourceDL": null, "viTags": [- "old",+ "LatestPrerelease", "old" ], "viTestDL": {@@ -993,8 +993,8 @@ "Latest", "Recommended", "Prerelease",- "base-2.3.5",- "\u0005EL"+ "base-6.3.2",+ "base-6.3.1" ], "viTestDL": null },@@ -1140,9 +1140,9 @@ "viSourceDL": null, "viTags": [ "Latest",- "base-2.1.2",- "base-5.2.1",- "old"+ "LatestPrerelease",+ "base-5.6.5",+ "LatestPrerelease" ], "viTestDL": { "dlCSize": -5,@@ -1584,13 +1584,13 @@ "dlUri": "https:l" }, "viTags": [- "base-1.1.6",+ "LatestPrerelease", "Latest", "old",- "base-4.6.2",+ "base-4.2.4", "l𠹟F", "old",- "Recommended"+ "LatestPrerelease" ], "viTestDL": { "dlCSize": 0,@@ -1897,7 +1897,7 @@ "old", "Latest", "Recommended",- "Prerelease"+ "base-1.3.3" ], "viTestDL": { "dlCSize": 5,@@ -2348,10 +2348,10 @@ "dlUri": "http:" }, "viTags": [- "t\u001e\u001aB8",+ "base-5.5.1", "old", "",- "old"+ "LatestPrerelease" ], "viTestDL": { "dlCSize": -4,@@ -3337,9 +3337,9 @@ }, "viTags": [ "Prerelease",- "base-5.6.1",- "base-3.3.3",- "base-3.2.1",+ "old",+ "*𭡕3i",+ "base-5.1.4", "Latest", ":ᄻ[" ],@@ -3767,9 +3767,9 @@ }, "viTags": [ "Prerelease",- "base-2.4.6",- "base-4.1.3",- "base-4.4.6"+ "base-2.2.4",+ "\u0008",+ "LatestPrerelease" ], "viTestDL": null },@@ -3901,8 +3901,8 @@ }, "viTags": [ "Latest",- "Latest",- "base-3.1.4",+ "base-3.3.5",+ "LatestPrerelease", "Recommended", "Prerelease", "old",@@ -4030,8 +4030,8 @@ "Recommended", "Prerelease", "Recommended",- "Latest",- "old"+ "base-2.4.6",+ "LatestPrerelease" ], "viTestDL": null },@@ -4212,7 +4212,7 @@ "viSourceDL": null, "viTags": [ "X\u001d^Y",- "base-2.3.5"+ "base-3.5.1" ], "viTestDL": null },@@ -4497,10 +4497,10 @@ "viTags": [ "old", "Latest",- "base-5.6.4",+ "oj&,m", "\u0019\u0007", "Recommended",- "Latest"+ "LatestPrerelease" ], "viTestDL": null }@@ -4718,12 +4718,12 @@ "dlUri": "http:k" }, "viTags": [- "base-5.3.4",+ "old", "Recommended", "Recommended",- "base-4.3.5",- "Latest",- "Rs;h~"+ "base-3.5.1",+ "LatestPrerelease",+ "base-3.3.3" ], "viTestDL": { "dlCSize": -3,@@ -4928,12 +4928,12 @@ "viPreCompile": null, "viSourceDL": null, "viTags": [- "base-1.5.5",+ "LatestPrerelease", "Latest", "Latest", "old", "Latest",- "base-3.6.4",+ "LatestPrerelease", "old" ], "viTestDL": {@@ -5027,12 +5027,12 @@ }, "viTags": [ "Latest",- "base-3.6.5",- "base-3.4.1",+ "old",+ "base-1.6.1", "𬰗𗛞Q#", "", "Prerelease",- "base-5.1.4"+ "base-6.6.2" ], "viTestDL": { "dlCSize": 6,@@ -5368,12 +5368,12 @@ "dlUri": "http:rjevxi" }, "viTags": [- "base-1.6.1",+ "U:3\u000fd", "SI🢐", "old", "𤔄\u001a~F", "Latest",- "base-4.5.4"+ "LatestPrerelease" ], "viTestDL": { "dlCSize": null,@@ -5697,10 +5697,10 @@ "dlUri": "http:viiv" }, "viTags": [- "base-3.1.6",+ "base-1.5.6", "Prerelease", "Recommended",- ")\u0005\u0015"+ "base-1.3.2" ], "viTestDL": { "dlCSize": 5,@@ -7482,7 +7482,7 @@ "Recommended", "old", "old",- "Latest"+ "(>" ], "viTestDL": { "dlCSize": null,@@ -8175,11 +8175,11 @@ "dlUri": "http:ndqpk" }, "viTags": [- "\"5\u0006F",+ "base-2.1.6", "Recommended", "Prerelease",+ "LatestPrerelease", "old",- "base-3.3.1", "Recommended" ], "viTestDL": null@@ -8199,10 +8199,10 @@ "dlUri": "https:gqhlp" }, "viTags": [- "base-4.3.4",- "Recommended", "old",- "base-4.1.4"+ "Recommended",+ "LatestPrerelease",+ "base-6.5.6" ], "viTestDL": { "dlCSize": null,@@ -8400,7 +8400,7 @@ "\u0001", "Prerelease", "Prerelease",- "base-3.6.3",+ "1Aⳃ", "Latest" ], "viTestDL": {@@ -8427,13 +8427,13 @@ "dlUri": "http:pvmi" }, "viTags": [- "old",- "old",- "Latest",+ "LatestPrerelease",+ "LatestPrerelease",+ "LatestPrerelease", "old", ")", "Recommended",- "old"+ "LatestPrerelease" ], "viTestDL": { "dlCSize": -2,@@ -8941,9 +8941,9 @@ "dlUri": "http:oth" }, "viTags": [- "base-4.1.5",+ "\u001c\u001f", "フ",- "base-1.4.5"+ "LatestPrerelease" ], "viTestDL": { "dlCSize": -5,@@ -10152,9 +10152,9 @@ "viPreCompile": "deajwn", "viSourceDL": null, "viTags": [- "base-6.4.5",- "base-5.1.1",- "base-4.4.6",+ "base-1.4.3",+ "LatestPrerelease",+ "LatestPrerelease", "Latest", "Latest", "Prerelease",@@ -10479,11 +10479,11 @@ "viPreCompile": "", "viSourceDL": null, "viTags": [- "Prerelease",+ "s", "Recommended", "old", "N\u001b",- "base-5.5.2",+ "LatestPrerelease", "", "Recommended" ],@@ -10716,8 +10716,8 @@ "viSourceDL": null, "viTags": [ "Recommended",- "base-3.6.1",- "base-4.3.3",+ "base-4.3.2",+ "base-2.3.4", "Recommended", "Latest" ],@@ -11178,8 +11178,8 @@ "viTags": [ "Prerelease", "Latest",- "base-5.3.2",- "[3憥"+ "5𨥶$𬰇",+ "base-3.1.6" ], "viTestDL": { "dlCSize": 1,@@ -11698,7 +11698,7 @@ "viTags": [ "𥭏}\u000e", "\u0007/",- "base-6.5.3",+ "LatestPrerelease", "Latest" ], "viTestDL": {@@ -13992,7 +13992,7 @@ }, "viTags": [ "Prerelease",- "base-4.6.2",+ "base-7.5.2", "3g7", "Recommended" ],@@ -14463,10 +14463,10 @@ }, "viTags": [ "Recommended",- "base-3.4.3",- "base-4.3.5",+ "LatestPrerelease",+ "base-1.2.2", "Latest",- "base-5.4.2"+ "LatestPrerelease" ], "viTestDL": { "dlCSize": null,@@ -14650,8 +14650,8 @@ }, "viTags": [ "Latest",- "",- "base-3.5.6"+ "base-5.6.2",+ "old" ], "viTestDL": { "dlCSize": -1,@@ -14735,11 +14735,11 @@ "dlUri": "http:koxgqu" }, "viTags": [- "base-6.3.3",- "base-2.4.2",- "Latest",- "base-3.1.6",- "",+ "base-4.4.6",+ "B\u0004",+ "old",+ "LatestPrerelease",+ "base-4.5.5", "Latest" ], "viTestDL": {@@ -15054,12 +15054,12 @@ "dlUri": "http:s" }, "viTags": [- "Latest",- "base-5.1.1",- "𫠼",+ "9or𰉒",+ "old",+ "base-2.4.4", "Recommended", "OHk(\u0007",- "old"+ "LatestPrerelease" ], "viTestDL": { "dlCSize": 1,@@ -15251,10 +15251,10 @@ "viTags": [ "Latest", "Latest",- "Latest",- "𮧬", "old",+ "𮧬", "old",+ "LatestPrerelease", "" ], "viTestDL": {@@ -15615,11 +15615,11 @@ "dlUri": "https:oat" }, "viTags": [- "base-6.6.4",- "Recommended",+ "",+ "old", "Recommended", "old",- "Prerelease"+ "base-6.3.4" ], "viTestDL": { "dlCSize": null,@@ -15904,13 +15904,13 @@ "dlUri": "https:rwxmrn" }, "viTags": [- "base-7.2.1",+ "old", "Prerelease",- "X",+ "base-2.5.3", "Latest",- "z 7\u0008N\u000e",+ "base-5.3.3", "old",- "\u0006g"+ "base-7.2.1" ], "viTestDL": { "dlCSize": 5,