From 284fe1b3b6a487f20796e307f90902c2b4e96ccd Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Tue, 12 Jul 2022 00:05:08 +0200 Subject: [PATCH] Fix parser and completer for 'ghcup compile hls --version' --- app/ghcup/GHCup/OptParse/Common.hs | 8 +++++--- app/ghcup/GHCup/OptParse/Compile.hs | 9 +++++---- 2 files changed, 10 insertions(+), 7 deletions(-) diff --git a/app/ghcup/GHCup/OptParse/Common.hs b/app/ghcup/GHCup/OptParse/Common.hs index dba8664..95fde6b 100644 --- a/app/ghcup/GHCup/OptParse/Common.hs +++ b/app/ghcup/GHCup/OptParse/Common.hs @@ -440,9 +440,11 @@ tagCompleter tool add = listIOCompleter $ do pure $ nub $ (add ++) $ fmap tagToString allTags VLeft _ -> pure (nub $ ["recommended", "latest"] ++ add) - versionCompleter :: Maybe ListCriteria -> Tool -> Completer -versionCompleter criteria tool = listIOCompleter $ do +versionCompleter criteria tool = versionCompleter' criteria tool (const True) + +versionCompleter' :: Maybe ListCriteria -> Tool -> (Version -> Bool) -> Completer +versionCompleter' criteria tool filter' = listIOCompleter $ do dirs' <- liftIO getAllDirs let loggerConfig = LoggerConfig { lcPrintDebug = False @@ -471,7 +473,7 @@ versionCompleter criteria tool = listIOCompleter $ do runEnv = flip runReaderT appState installedVersions <- runEnv $ listVersions (Just tool) criteria - return $ T.unpack . prettyVer . lVer <$> installedVersions + return $ fmap (T.unpack . prettyVer) . filter filter' . fmap lVer $ installedVersions toolDlCompleter :: Tool -> Completer diff --git a/app/ghcup/GHCup/OptParse/Compile.hs b/app/ghcup/GHCup/OptParse/Compile.hs index 82df4d1..89b8157 100644 --- a/app/ghcup/GHCup/OptParse/Compile.hs +++ b/app/ghcup/GHCup/OptParse/Compile.hs @@ -32,7 +32,8 @@ import Control.Monad.Trans.Resource import Data.Bifunctor import Data.Functor import Data.Maybe -import Data.Versions ( Version, prettyVer, version ) +import Data.Versions ( Version, prettyVer, version, pvp ) +import qualified Data.Versions as V import Data.Text ( Text ) import Haskus.Utils.Variant.Excepts import Options.Applicative hiding ( style ) @@ -43,7 +44,7 @@ import Text.PrettyPrint.HughesPJClass ( prettyShow ) import URI.ByteString hiding ( uriParser ) import qualified Data.Text as T -import Control.Exception.Safe (MonadMask) +import Control.Exception.Safe (MonadMask, displayException) import System.FilePath (isPathSeparator) import Text.Read (readEither) @@ -287,11 +288,11 @@ hlsCompileOpts = HLSCompileOptions <$> ((HLS.HackageDist <$> option (eitherReader - (first (const "Not a valid version") . version . T.pack) + ((>>= first displayException . V.version . V.prettyPVP) . first (const "Not a valid PVP version") . pvp . T.pack) ) (short 'v' <> long "version" <> metavar "VERSION" <> help "The version to compile (pulled from hackage)" - <> (completer $ versionCompleter Nothing HLS) + <> (completer $ versionCompleter' Nothing HLS (either (const False) (const True) . V.pvp . V.prettyVer)) ) ) <|>