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

Fix cabalSet for pre-release versions

Browse Source
This commit is contained in:
Julian Ospald 2020-07-28 21:44:25 +02:00
parent af811f3dbc
commit 86b0e4b31b
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
1 changed files with 27 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
lib/GHCup/Utils.hs
View File

@ -259,18 +259,33 @@ cabalInstalled ver = do
cabalSet :: (MonadIO m, MonadThrow m) => m (Maybe Version) cabalSet :: (MonadIO m, MonadThrow m) => m (Maybe Version)
cabalSet = do cabalSet = do
cabalbin <- (</> [rel|cabal|]) <$> liftIO ghcupBinDir cabalbin <- (</> [rel|cabal|]) <$> liftIO ghcupBinDir
mc <- liftIO $ handleIO (\_ -> pure Nothing) $ fmap Just $ executeOut b <- fmap (== SymbolicLink) $ liftIO $ getFileType cabalbin
cabalbin if
["--numeric-version"] | b -> do
Nothing liftIO $ handleIO' NoSuchThing (\_ -> pure $ Nothing) $ do
fmap join $ forM mc $ \c -> if link <- readSymbolicLink $ toFilePath cabalbin
| not (B.null (_stdOut c)) Just <$> linkVersion link
, _exitCode c == ExitSuccess -> do | otherwise -> do -- legacy behavior
let reportedVer = fst . B.spanEnd (== _lf) . _stdOut $ c mc <- liftIO $ handleIO (\_ -> pure Nothing) $ fmap Just $ executeOut
case version $ decUTF8Safe reportedVer of cabalbin
Left e -> throwM e ["--numeric-version"]
Right r -> pure $ Just r Nothing
| otherwise -> pure Nothing fmap join $ forM mc $ \c -> if
| not (B.null (_stdOut c)), _exitCode c == ExitSuccess -> do
let reportedVer = fst . B.spanEnd (== _lf) . _stdOut $ c
case version $ decUTF8Safe reportedVer of
Left e -> throwM e
Right r -> pure $ Just r
| otherwise -> pure Nothing
where
linkVersion :: MonadThrow m => ByteString -> m Version
linkVersion bs = do
t <- throwEither $ E.decodeUtf8' bs
throwEither $ MP.parse parser "" t
where
parser =
MP.chunk "cabal-" *> version'