hasufell/ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Support Hadrian provided bindists

Browse Source 
Fixes #31
This commit is contained in:
Brian McKenna 2020-06-18 14:03:25 +00:00
parent a1bcc4b51f
commit a186b07763
1 changed files with 14 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
lib/GHCup/Utils.hs
View File

@ -54,7 +54,7 @@ import System.IO.Error
import System.Posix.FilePath ( getSearchPath import System.Posix.FilePath ( getSearchPath
, takeFileName , takeFileName
) )
import System.Posix.Files.ByteString ( readSymbolicLink ) import System.Posix.Files.ByteString ( getFileStatus, isSymbolicLink, readSymbolicLink )
import Text.Regex.Posix import Text.Regex.Posix
import URI.ByteString import URI.ByteString
@ -417,13 +417,20 @@ ghcToolFiles ver = do
([s|^([a-zA-Z0-9_-]*[a-zA-Z0-9_]-)?ghc$|] :: ByteString) ([s|^([a-zA-Z0-9_-]*[a-zA-Z0-9_]-)?ghc$|] :: ByteString)
) )
(Just symver) <- let ghcbinPath = toFilePath (bindir </> ghcbin)
(B.stripPrefix (toFilePath ghcbin <> "-") . takeFileName) ghcIsLink <- isSymbolicLink <$> (liftIO $ getFileStatus ghcbinPath)
<$> (liftIO $ readSymbolicLink $ toFilePath (bindir </> ghcbin)) onlyUnversioned <- if ghcIsLink
when (B.null symver) then do
(throwIO $ userError $ "Fatal: ghc symlink target is broken") (Just symver) <-
(B.stripPrefix (toFilePath ghcbin <> "-") . takeFileName)
<$> (liftIO $ readSymbolicLink ghcbinPath)
when (B.null symver)
(throwIO $ userError $ "Fatal: ghc symlink target is broken")
pure $ filter (\x -> not $ symver `B.isSuffixOf` toFilePath x)
else
pure id
pure . filter (\x -> not $ symver `B.isSuffixOf` toFilePath x) $ files pure $ onlyUnversioned files
-- | This file, when residing in ~/.ghcup/ghc/<ver>/ signals that -- | This file, when residing in ~/.ghcup/ghc/<ver>/ signals that