Merge branch 'issue-797'
This commit is contained in:
commit
4b1225ad71
@ -335,7 +335,7 @@ ghcSet mtarget = do
|
|||||||
getInstalledGHCs :: (MonadReader env m, HasDirs env, MonadIO m) => m [Either FilePath GHCTargetVersion]
|
getInstalledGHCs :: (MonadReader env m, HasDirs env, MonadIO m) => m [Either FilePath GHCTargetVersion]
|
||||||
getInstalledGHCs = do
|
getInstalledGHCs = do
|
||||||
ghcdir <- ghcupGHCBaseDir
|
ghcdir <- ghcupGHCBaseDir
|
||||||
fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectory (fromGHCupPath ghcdir)
|
fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectoryDirs (fromGHCupPath ghcdir)
|
||||||
forM fs $ \f -> case parseGHCupGHCDir f of
|
forM fs $ \f -> case parseGHCupGHCDir f of
|
||||||
Right r -> pure $ Right r
|
Right r -> pure $ Right r
|
||||||
Left _ -> pure $ Left f
|
Left _ -> pure $ Left f
|
||||||
@ -438,7 +438,7 @@ getInstalledHLSs = do
|
|||||||
Nothing -> pure $ Left f
|
Nothing -> pure $ Left f
|
||||||
|
|
||||||
hlsdir <- ghcupHLSBaseDir
|
hlsdir <- ghcupHLSBaseDir
|
||||||
fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectory (fromGHCupPath hlsdir)
|
fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectoryDirs (fromGHCupPath hlsdir)
|
||||||
new <- forM fs $ \f -> case parseGHCupHLSDir f of
|
new <- forM fs $ \f -> case parseGHCupHLSDir f of
|
||||||
Right r -> pure $ Right r
|
Right r -> pure $ Right r
|
||||||
Left _ -> pure $ Left f
|
Left _ -> pure $ Left f
|
||||||
@ -626,7 +626,7 @@ hlsInternalServerScripts ver mghcVer = do
|
|||||||
dir <- ghcupHLSDir ver
|
dir <- ghcupHLSDir ver
|
||||||
let bdir = fromGHCupPath dir </> "bin"
|
let bdir = fromGHCupPath dir </> "bin"
|
||||||
fmap (bdir </>) . filter (\f -> maybe True (\gv -> ("-" <> T.unpack (prettyVer gv)) `isSuffixOf` f) mghcVer)
|
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.
|
-- | 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.
|
-- Returns the full path.
|
||||||
@ -639,7 +639,7 @@ hlsInternalServerBinaries ver mghcVer = do
|
|||||||
let regex = makeRegexOpts compExtended execBlank ([s|^haskell-language-server-.*$|] :: ByteString)
|
let regex = makeRegexOpts compExtended execBlank ([s|^haskell-language-server-.*$|] :: ByteString)
|
||||||
(Just bdir) <- fmap headMay $ liftIO $ expandFilePath [Left (dir </> "lib"), Right regex, Left "bin"]
|
(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)
|
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>/
|
-- | Get all libraries for a hls version from the ~/.ghcup/hls/<ver>/lib/haskell-language-server-<ver>/lib/<ghc-ver>/
|
||||||
-- directory, if any.
|
-- directory, if any.
|
||||||
@ -652,7 +652,7 @@ hlsInternalServerLibs ver ghcVer = do
|
|||||||
dir <- fromGHCupPath <$> ghcupHLSDir ver
|
dir <- fromGHCupPath <$> ghcupHLSDir ver
|
||||||
let regex = makeRegexOpts compExtended execBlank ([s|^haskell-language-server-.*$|] :: ByteString)
|
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))]
|
(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.
|
-- | Get the wrapper binary for an hls version, if any.
|
||||||
@ -936,7 +936,7 @@ ghcToolFiles ver = do
|
|||||||
whenM (fmap not $ ghcInstalled ver)
|
whenM (fmap not $ ghcInstalled ver)
|
||||||
(throwE (NotInstalled GHC 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)
|
pure (getUniqueTools . groupToolFiles . fmap (dropSuffix exeExt) $ files)
|
||||||
|
|
||||||
where
|
where
|
||||||
|
@ -42,6 +42,9 @@ module GHCup.Utils.Dirs
|
|||||||
, removeDirectoryRecursive
|
, removeDirectoryRecursive
|
||||||
, removePathForcibly
|
, removePathForcibly
|
||||||
|
|
||||||
|
, listDirectoryFiles
|
||||||
|
, listDirectoryDirs
|
||||||
|
|
||||||
-- System.Directory re-exports
|
-- System.Directory re-exports
|
||||||
, createDirectory
|
, createDirectory
|
||||||
, createDirectoryIfMissing
|
, createDirectoryIfMissing
|
||||||
@ -130,7 +133,7 @@ import Data.Maybe
|
|||||||
import Data.Versions
|
import Data.Versions
|
||||||
import GHC.IO.Exception ( IOErrorType(NoSuchThing) )
|
import GHC.IO.Exception ( IOErrorType(NoSuchThing) )
|
||||||
import Haskus.Utils.Variant.Excepts
|
import Haskus.Utils.Variant.Excepts
|
||||||
import Optics
|
import Optics hiding ( uncons )
|
||||||
import Safe
|
import Safe
|
||||||
import System.Directory hiding ( removeDirectory
|
import System.Directory hiding ( removeDirectory
|
||||||
, removeDirectoryRecursive
|
, removeDirectoryRecursive
|
||||||
@ -529,6 +532,29 @@ cleanupTrash = do
|
|||||||
) $ liftIO $ removePathForcibly (recycleDir `appendGHCupPath` fp))
|
) $ 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
|
-- System.Directory re-exports with GHCupPath
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user