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

Slight style changes

Browse Source
This commit is contained in:
Julian Ospald 2020-06-20 14:37:38 +02:00
parent de70f4820f
commit 7ec6e8604c
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
1 changed files with 10 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
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 ( getSymbolicLinkStatus, isSymbolicLink, readSymbolicLink ) import System.Posix.Files.ByteString ( readSymbolicLink )
import Text.Regex.Posix import Text.Regex.Posix
import URI.ByteString import URI.ByteString
@ -417,24 +417,26 @@ 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)
) )
let ghcbinPath = toFilePath (bindir </> ghcbin) let ghcbinPath = bindir </> ghcbin
ghcIsHadrian <- liftIO $ isHadrian ghcbinPath ghcIsHadrian <- liftIO $ isHadrian ghcbinPath
onlyUnversioned <- if ghcIsHadrian onlyUnversioned <- if ghcIsHadrian
then pure id then pure id
else do else do
(Just symver) <- (Just symver) <-
(B.stripPrefix (toFilePath ghcbin <> "-") . takeFileName) (B.stripPrefix (toFilePath ghcbin <> "-") . takeFileName)
<$> (liftIO $ readSymbolicLink ghcbinPath) <$> (liftIO $ readSymbolicLink $ toFilePath ghcbinPath)
when (B.null symver) when (B.null symver)
(throwIO $ userError $ "Fatal: ghc symlink target is broken") (throwIO $ userError $ "Fatal: ghc symlink target is broken")
pure $ filter (\x -> not $ symver `B.isSuffixOf` toFilePath x) pure $ filter (\x -> not $ symver `B.isSuffixOf` toFilePath x)
pure $ onlyUnversioned files pure $ onlyUnversioned files
where where
-- GHC is moving some builds to Hadrian for bindists, which doesn't create versioned binaries -- GHC is moving some builds to Hadrian for bindists,
-- which doesn't create versioned binaries.
-- https://gitlab.haskell.org/haskell/ghcup-hs/issues/31 -- https://gitlab.haskell.org/haskell/ghcup-hs/issues/31
isHadrian :: ByteString -> IO Bool isHadrian :: Path Abs -- ^ ghcbin path
isHadrian = (not . isSymbolicLink <$>) . getSymbolicLinkStatus -> IO Bool
isHadrian = fmap (/= SymbolicLink) . getFileType
-- | This file, when residing in ~/.ghcup/ghc/<ver>/ signals that -- | This file, when residing in ~/.ghcup/ghc/<ver>/ signals that