Silence hlint

CHANGELOG.md

@@ -1,5 +1,11 @@
 # Revision history for ghcup
 
+## 0.1.19.2 -- ????-??-??
+
+* 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)
+
 ## 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,6 +4,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeApplications  #-}
 {-# LANGUAGE RankNTypes        #-}
+{-# LANGUAGE ViewPatterns      #-}
 
 module BrickMain where
 
@@ -154,8 +155,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 +174,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 +185,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 +204,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 +279,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)

app/ghcup/GHCup/OptParse/Common.hs

@@ -246,8 +246,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'
@@ -452,7 +453,7 @@ tagCompleter tool add = listIOCompleter $ do
       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' (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/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

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

lib/GHCup/Types.hs

@@ -154,6 +154,7 @@ instance NFData VersionInfo
 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 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 +177,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

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

lib/GHCup/Utils.hs

@@ -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
@@ -438,7 +438,7 @@ getInstalledHLSs = do
         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 @@ 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 +639,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,7 +652,7 @@ 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.
@@ -892,6 +892,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
 
@@ -933,7 +936,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

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
@@ -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