Fix parser and completer for 'ghcup compile hls --version'

This commit is contained in:
Julian Ospald 2022-07-12 00:05:08 +02:00
parent 35bda8d67a
commit 284fe1b3b6
Signed by: hasufell
GPG Key ID: 3786C5262ECB4A3F
2 changed files with 10 additions and 7 deletions

View File

@ -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

View File

@ -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))
)
)
<|>