From 86b0e4b31bc6233f43257b8222f7750c4f906de4 Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Tue, 28 Jul 2020 21:44:25 +0200
Subject: [PATCH] Fix `cabalSet` for pre-release versions

---
 lib/GHCup/Utils.hs | 39 +++++++++++++++++++++++++++------------
 1 file changed, 27 insertions(+), 12 deletions(-)

diff --git a/lib/GHCup/Utils.hs b/lib/GHCup/Utils.hs
index 052a057..9b9534d 100644
--- a/lib/GHCup/Utils.hs
+++ b/lib/GHCup/Utils.hs
@@ -259,18 +259,33 @@ cabalInstalled ver = do
 cabalSet :: (MonadIO m, MonadThrow m) => m (Maybe Version)
 cabalSet = do
   cabalbin <- (</> [rel|cabal|]) <$> liftIO ghcupBinDir
-  mc       <- liftIO $ handleIO (\_ -> pure Nothing) $ fmap Just $ executeOut
-    cabalbin
-    ["--numeric-version"]
-    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
+  b        <- fmap (== SymbolicLink) $ liftIO $ getFileType cabalbin
+  if
+    | b -> do
+      liftIO $ handleIO' NoSuchThing (\_ -> pure $ Nothing) $ do
+        link <- readSymbolicLink $ toFilePath cabalbin
+        Just <$> linkVersion link
+    | otherwise -> do -- legacy behavior
+      mc <- liftIO $ handleIO (\_ -> pure Nothing) $ fmap Just $ executeOut
+        cabalbin
+        ["--numeric-version"]
+        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'
+