Fix regression in JFS support, fixes #787

app/ghcup/BrickMain.hs

@@ -4,7 +4,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeApplications  #-}
 {-# LANGUAGE RankNTypes        #-}
-{-# LANGUAGE ViewPatterns      #-}
 
 module BrickMain where
 
@@ -155,11 +154,8 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
       <+> minHSize 15 (str "Version")
       <+> padLeft (Pad 1) (minHSize 25 $ str "Tags")
       <+> padLeft (Pad 5) (str "Notes")
-  renderList' bis@BrickInternalState{..} =
+  renderList' = withDefAttr listAttr . drawListElements renderItem True
-    let getMinLength = length . intercalate "," . fmap tagToString
+  renderItem _ b listResult@ListResult{..} =
-        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 "✓ ")
@@ -174,7 +170,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
@@ -185,8 +181,8 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
                  (printTool lTool)
                )
           <+> minHSize 15 (str ver)
-          <+> (let l = catMaybes . fmap printTag $ sort lTag'
+          <+> (let l = catMaybes . fmap printTag $ sort lTag
-               in  padLeft (Pad 1) $ minHSize minTagSize $ if null l
+               in  padLeft (Pad 1) $ minHSize 25 $ if null l
                      then emptyWidget
                      else foldr1 (\x y -> x <+> str "," <+> y) l
               )
@@ -204,7 +200,6 @@ 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"
@@ -279,7 +274,6 @@ 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,9 +246,8 @@ toolVersionTagEither s' =
 
 tagEither :: String -> Either String Tag
 tagEither s' = case fmap toLower s' of
-  "recommended"              -> Right Recommended
+  "recommended" -> Right Recommended
-  "latest"                   -> Right Latest
+  "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'
@@ -453,7 +452,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", "latest-prerelease"] ++ add)
+    VLeft _ -> pure  (nub $ ["recommended", "latest"] ++ add)
 
 versionCompleter :: Maybe ListCriteria -> Tool -> Completer
 versionCompleter criteria tool = versionCompleter' criteria tool (const True)
@@ -707,9 +706,6 @@ 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,7 +107,6 @@ 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

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/Types.hs

@@ -154,7 +154,6 @@ 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
@@ -168,7 +167,6 @@ 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
@@ -177,7 +175,6 @@ 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,7 +66,6 @@ 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
@@ -74,7 +73,6 @@ 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

@@ -892,9 +892,6 @@ 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