Skip to content
Snippets Groups Projects

Support Hadrian provided bindists

Merged puffnfresh requested to merge puffnfresh/ghcup-hs:issues/31/hadrian-bindists into master
1 file
+ 19
8
Compare changes
  • Side-by-side
  • Inline
+ 19
8
@@ -54,7 +54,7 @@ import System.IO.Error
@@ -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 ( getSymbolicLinkStatus, isSymbolicLink, readSymbolicLink )
import Text.Regex.Posix
import Text.Regex.Posix
import URI.ByteString
import URI.ByteString
@@ -417,13 +417,24 @@ ghcToolFiles ver = do
@@ -417,13 +417,24 @@ 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)
ghcIsHadrian <- liftIO $ isHadrian ghcbinPath
<$> (liftIO $ readSymbolicLink $ toFilePath (bindir </> ghcbin))
onlyUnversioned <- if ghcIsHadrian
when (B.null symver)
then pure id
(throwIO $ userError $ "Fatal: ghc symlink target is broken")
else do
(Just symver) <-
pure . filter (\x -> not $ symver `B.isSuffixOf` toFilePath x) $ files
(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)
 
 
pure $ onlyUnversioned files
 
where
 
-- GHC is moving some builds to Hadrian for bindists, which doesn't create versioned binaries
 
-- https://gitlab.haskell.org/haskell/ghcup-hs/issues/31
 
isHadrian :: ByteString -> IO Bool
 
isHadrian = (not . isSymbolicLink <$>) . getSymbolicLinkStatus
-- | This file, when residing in ~/.ghcup/ghc/<ver>/ signals that
-- | This file, when residing in ~/.ghcup/ghc/<ver>/ signals that
Loading