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

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

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
app/ghcup/GHCup/OptParse/Common.hs
View File

@ -440,9 +440,11 @@ tagCompleter tool add = listIOCompleter $ do
pure $ nub $ (add ++) $ fmap tagToString allTags pure $ nub $ (add ++) $ fmap tagToString allTags
VLeft _ -> pure (nub $ ["recommended", "latest"] ++ add) VLeft _ -> pure (nub $ ["recommended", "latest"] ++ add)
versionCompleter :: Maybe ListCriteria -> Tool -> Completer 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 dirs' <- liftIO getAllDirs
let loggerConfig = LoggerConfig let loggerConfig = LoggerConfig
{ lcPrintDebug = False { lcPrintDebug = False
@ -471,7 +473,7 @@ versionCompleter criteria tool = listIOCompleter $ do
runEnv = flip runReaderT appState runEnv = flip runReaderT appState
installedVersions <- runEnv $ listVersions (Just tool) criteria 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 toolDlCompleter :: Tool -> Completer

9
app/ghcup/GHCup/OptParse/Compile.hs
View File

@ -32,7 +32,8 @@ import Control.Monad.Trans.Resource
import Data.Bifunctor import Data.Bifunctor
import Data.Functor import Data.Functor
import Data.Maybe 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 Data.Text ( Text )
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style ) import Options.Applicative hiding ( style )
@ -43,7 +44,7 @@ import Text.PrettyPrint.HughesPJClass ( prettyShow )
import URI.ByteString hiding ( uriParser ) import URI.ByteString hiding ( uriParser )
import qualified Data.Text as T import qualified Data.Text as T
import Control.Exception.Safe (MonadMask) import Control.Exception.Safe (MonadMask, displayException)
import System.FilePath (isPathSeparator) import System.FilePath (isPathSeparator)
import Text.Read (readEither) import Text.Read (readEither)
@ -287,11 +288,11 @@ hlsCompileOpts =
HLSCompileOptions HLSCompileOptions
<$> ((HLS.HackageDist <$> option <$> ((HLS.HackageDist <$> option
(eitherReader (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 (short 'v' <> long "version" <> metavar "VERSION" <> help
"The version to compile (pulled from hackage)" "The version to compile (pulled from hackage)"
<> (completer $ versionCompleter Nothing HLS) <> (completer $ versionCompleter' Nothing HLS (either (const False) (const True) . V.pvp . V.prettyVer))
) )
) )
<|> <|>