Compare commits
6 Commits
latest-pre
...
issue-797
| Author | SHA1 | Date | |
|---|---|---|---|
|
d628848af6
|
|||
|
b547324253
|
|||
|
7ac8989dfc
|
|||
|
cd6666ed30
|
|||
|
5b7478438a
|
|||
|
4a830d9fb7
|
@@ -1,5 +1,11 @@
|
|||||||
# Revision history for ghcup
|
# 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
|
## 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)
|
* Fix GHCup on JFS/ReiserFS and other filesystem that don't support `d_type`, fixes [#766](https://github.com/haskell/ghcup-hs/issues/766)
|
||||||
|
|||||||
@@ -1,6 +1,6 @@
|
|||||||
cabal-version: 2.4
|
cabal-version: 2.4
|
||||||
name: ghcup
|
name: ghcup
|
||||||
version: 0.1.19.1
|
version: 0.1.19.2
|
||||||
license: LGPL-3.0-only
|
license: LGPL-3.0-only
|
||||||
license-file: LICENSE
|
license-file: LICENSE
|
||||||
copyright: Julian Ospald 2020
|
copyright: Julian Ospald 2020
|
||||||
|
|||||||
@@ -124,7 +124,6 @@ readDirEntPortable (DirStreamPortable (basedir, dirs)) = do
|
|||||||
(DirType #{const DT_LNK}, _) -> pure (dt, fp)
|
(DirType #{const DT_LNK}, _) -> pure (dt, fp)
|
||||||
(DirType #{const DT_REG}, _) -> pure (dt, fp)
|
(DirType #{const DT_REG}, _) -> pure (dt, fp)
|
||||||
(DirType #{const DT_SOCK}, _) -> pure (dt, fp)
|
(DirType #{const DT_SOCK}, _) -> pure (dt, fp)
|
||||||
(DirType #{const DT_UNKNOWN}, _) -> pure (dt, fp)
|
|
||||||
(_, _)
|
(_, _)
|
||||||
| fp /= "" -> do
|
| fp /= "" -> do
|
||||||
stat <- getSymbolicLinkStatus (basedir </> fp)
|
stat <- getSymbolicLinkStatus (basedir </> fp)
|
||||||
@@ -136,4 +135,5 @@ readDirEntPortable (DirStreamPortable (basedir, dirs)) = do
|
|||||||
| isRegularFile stat -> DirType #{const DT_REG}
|
| isRegularFile stat -> DirType #{const DT_REG}
|
||||||
| isSocket stat -> DirType #{const DT_SOCK}
|
| isSocket stat -> DirType #{const DT_SOCK}
|
||||||
| otherwise -> DirType #{const DT_UNKNOWN}
|
| otherwise -> DirType #{const DT_UNKNOWN}
|
||||||
|
| otherwise -> pure (dt, fp)
|
||||||
|
|
||||||
|
|||||||
@@ -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
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user