Skip to content

Commit 4b1225a

Browse files
committed
Merge branch 'issue-797'
2 parents 48381be + d628848 commit 4b1225a

File tree

2 files changed

+33
-7
lines changed

2 files changed

+33
-7
lines changed

lib/GHCup/Utils.hs

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -335,7 +335,7 @@ ghcSet mtarget = do
335335
getInstalledGHCs :: (MonadReader env m, HasDirs env, MonadIO m) => m [Either FilePath GHCTargetVersion]
336336
getInstalledGHCs = do
337337
ghcdir <- ghcupGHCBaseDir
338-
fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectory (fromGHCupPath ghcdir)
338+
fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectoryDirs (fromGHCupPath ghcdir)
339339
forM fs $ \f -> case parseGHCupGHCDir f of
340340
Right r -> pure $ Right r
341341
Left _ -> pure $ Left f
@@ -438,7 +438,7 @@ getInstalledHLSs = do
438438
Nothing -> pure $ Left f
439439

440440
hlsdir <- ghcupHLSBaseDir
441-
fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectory (fromGHCupPath hlsdir)
441+
fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectoryDirs (fromGHCupPath hlsdir)
442442
new <- forM fs $ \f -> case parseGHCupHLSDir f of
443443
Right r -> pure $ Right r
444444
Left _ -> pure $ Left f
@@ -626,7 +626,7 @@ hlsInternalServerScripts ver mghcVer = do
626626
dir <- ghcupHLSDir ver
627627
let bdir = fromGHCupPath dir </> "bin"
628628
fmap (bdir </>) . filter (\f -> maybe True (\gv -> ("-" <> T.unpack (prettyVer gv)) `isSuffixOf` f) mghcVer)
629-
<$> liftIO (listDirectory bdir)
629+
<$> liftIO (listDirectoryFiles bdir)
630630

631631
-- | Get all binaries for a hls version from the ~/.ghcup/hls/<ver>/lib/haskell-language-server-<ver>/bin directory, if any.
632632
-- Returns the full path.
@@ -639,7 +639,7 @@ hlsInternalServerBinaries ver mghcVer = do
639639
let regex = makeRegexOpts compExtended execBlank ([s|^haskell-language-server-.*$|] :: ByteString)
640640
(Just bdir) <- fmap headMay $ liftIO $ expandFilePath [Left (dir </> "lib"), Right regex, Left "bin"]
641641
fmap (bdir </>) . filter (\f -> maybe True (\gv -> ("-" <> T.unpack (prettyVer gv)) `isSuffixOf` f) mghcVer)
642-
<$> liftIO (listDirectory bdir)
642+
<$> liftIO (listDirectoryFiles bdir)
643643

644644
-- | Get all libraries for a hls version from the ~/.ghcup/hls/<ver>/lib/haskell-language-server-<ver>/lib/<ghc-ver>/
645645
-- directory, if any.
@@ -652,7 +652,7 @@ hlsInternalServerLibs ver ghcVer = do
652652
dir <- fromGHCupPath <$> ghcupHLSDir ver
653653
let regex = makeRegexOpts compExtended execBlank ([s|^haskell-language-server-.*$|] :: ByteString)
654654
(Just bdir) <- fmap headMay $ liftIO $ expandFilePath [Left (dir </> "lib"), Right regex, Left ("lib" </> T.unpack (prettyVer ghcVer))]
655-
fmap (bdir </>) <$> liftIO (listDirectory bdir)
655+
fmap (bdir </>) <$> liftIO (listDirectoryFiles bdir)
656656

657657

658658
-- | Get the wrapper binary for an hls version, if any.
@@ -936,7 +936,7 @@ ghcToolFiles ver = do
936936
whenM (fmap not $ ghcInstalled ver)
937937
(throwE (NotInstalled GHC ver))
938938

939-
files <- liftIO (listDirectory bindir >>= filterM (doesFileExist . (bindir </>)))
939+
files <- liftIO (listDirectoryFiles bindir >>= filterM (doesFileExist . (bindir </>)))
940940
pure (getUniqueTools . groupToolFiles . fmap (dropSuffix exeExt) $ files)
941941

942942
where

lib/GHCup/Utils/Dirs.hs

Lines changed: 27 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -42,6 +42,9 @@ module GHCup.Utils.Dirs
4242
, removeDirectoryRecursive
4343
, removePathForcibly
4444

45+
, listDirectoryFiles
46+
, listDirectoryDirs
47+
4548
-- System.Directory re-exports
4649
, createDirectory
4750
, createDirectoryIfMissing
@@ -130,7 +133,7 @@ import Data.Maybe
130133
import Data.Versions
131134
import GHC.IO.Exception ( IOErrorType(NoSuchThing) )
132135
import Haskus.Utils.Variant.Excepts
133-
import Optics
136+
import Optics hiding ( uncons )
134137
import Safe
135138
import System.Directory hiding ( removeDirectory
136139
, removeDirectoryRecursive
@@ -529,6 +532,29 @@ cleanupTrash = do
529532
) $ liftIO $ removePathForcibly (recycleDir `appendGHCupPath` fp))
530533

531534

535+
-- | List *actual files* in a directory, ignoring empty files and a couple
536+
-- of blacklisted files, such as '.DS_Store' on mac.
537+
listDirectoryFiles :: FilePath -> IO [FilePath]
538+
listDirectoryFiles fp = do
539+
listDirectory fp >>= filterM (doesFileExist . (fp </>)) <&> filter (\fp' -> not (isHidden fp') && not (isBlacklisted fp'))
540+
541+
-- | List *actual directories* in a directory, ignoring empty directories and a couple
542+
-- of blacklisted files, such as '.DS_Store' on mac.
543+
listDirectoryDirs :: FilePath -> IO [FilePath]
544+
listDirectoryDirs fp = do
545+
listDirectory fp >>= filterM (doesDirectoryExist . (fp </>)) <&> filter (\fp' -> not (isHidden fp') && not (isBlacklisted fp'))
546+
547+
isHidden :: FilePath -> Bool
548+
isHidden fp'
549+
| isWindows = False
550+
| Just ('.', _) <- uncons fp' = True
551+
| otherwise = False
552+
553+
isBlacklisted :: FilePath -> Bool
554+
{- HLINT ignore "Use ==" -}
555+
isBlacklisted fp' = fp' `elem` [".DS_Store"]
556+
557+
532558

533559
-- System.Directory re-exports with GHCupPath
534560

0 commit comments

Comments
 (0)