Improve tag completer
This commit is contained in:
parent
10ca9ea827
commit
3baf254251
@ -44,7 +44,7 @@ import Data.Bifunctor
|
|||||||
import Data.Char
|
import Data.Char
|
||||||
import Data.Either
|
import Data.Either
|
||||||
import Data.Functor
|
import Data.Functor
|
||||||
import Data.List ( intercalate, sort )
|
import Data.List ( intercalate, nub, sort )
|
||||||
import Data.List.NonEmpty (NonEmpty ((:|)))
|
import Data.List.NonEmpty (NonEmpty ((:|)))
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.String.Interpolate
|
import Data.String.Interpolate
|
||||||
@ -70,6 +70,7 @@ import URI.ByteString
|
|||||||
|
|
||||||
import qualified Data.ByteString as B
|
import qualified Data.ByteString as B
|
||||||
import qualified Data.ByteString.UTF8 as UTF8
|
import qualified Data.ByteString.UTF8 as UTF8
|
||||||
|
import qualified Data.Map.Strict as M
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.IO as T
|
import qualified Data.Text.IO as T
|
||||||
import qualified Data.Text.Encoding as E
|
import qualified Data.Text.Encoding as E
|
||||||
@ -767,18 +768,41 @@ toolVersionParser = verP' <|> toolP
|
|||||||
-- | same as toolVersionParser, except as an argument.
|
-- | same as toolVersionParser, except as an argument.
|
||||||
toolVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
|
toolVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
|
||||||
toolVersionArgument criteria tool =
|
toolVersionArgument criteria tool =
|
||||||
argument (eitherReader toolVersionEither) (metavar "VERSION|TAG" <> completer tagCompleter <> foldMap (completer . versionCompleter criteria) tool)
|
argument (eitherReader toolVersionEither)
|
||||||
|
(metavar "VERSION|TAG"
|
||||||
|
<> completer (tagCompleter (fromMaybe GHC tool))
|
||||||
|
<> foldMap (completer . versionCompleter criteria) tool)
|
||||||
|
|
||||||
|
|
||||||
versionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion
|
versionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion
|
||||||
versionArgument criteria tool = argument (eitherReader tVersionEither) (metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
|
versionArgument criteria tool = argument (eitherReader tVersionEither) (metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
|
||||||
|
|
||||||
|
|
||||||
tagCompleter :: Completer
|
tagCompleter :: Tool -> Completer
|
||||||
tagCompleter =
|
tagCompleter tool = listIOCompleter $ do
|
||||||
listCompleter [
|
let loggerConfig = LoggerConfig
|
||||||
"recommended", "latest"
|
{ lcPrintDebug = False
|
||||||
]
|
, colorOutter = mempty
|
||||||
|
, rawOutter = mempty
|
||||||
|
}
|
||||||
|
|
||||||
|
runLogger = myLoggerT loggerConfig
|
||||||
|
|
||||||
|
dirs <- getDirs
|
||||||
|
let simpleSettings = Settings False False Never Curl False GHCupURL
|
||||||
|
simpleAppState = AppState simpleSettings dirs defaultKeyBindings
|
||||||
|
runEnv = runLogger . flip runReaderT simpleAppState
|
||||||
|
|
||||||
|
mGhcUpInfo <- runEnv . runE $ readFromCache
|
||||||
|
|
||||||
|
case mGhcUpInfo of
|
||||||
|
VRight dls -> do
|
||||||
|
let allTags = filter (\t -> t /= Old)
|
||||||
|
$ join
|
||||||
|
$ M.elems
|
||||||
|
$ availableToolVersions (_ghcupDownloads dls) tool
|
||||||
|
pure $ nub $ fmap prettyTag allTags
|
||||||
|
VLeft _ -> pure ["recommended", "latest"]
|
||||||
|
|
||||||
|
|
||||||
versionCompleter :: Maybe ListCriteria -> Tool -> Completer
|
versionCompleter :: Maybe ListCriteria -> Tool -> Completer
|
||||||
|
@ -106,6 +106,13 @@ data Tag = Latest
|
|||||||
| UnknownTag String -- ^ used for upwardscompat
|
| UnknownTag String -- ^ used for upwardscompat
|
||||||
deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance
|
deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance
|
||||||
|
|
||||||
|
prettyTag :: Tag -> String
|
||||||
|
prettyTag Recommended = "recommended"
|
||||||
|
prettyTag Latest = "latest"
|
||||||
|
prettyTag Prerelease = "prerelease"
|
||||||
|
prettyTag (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
|
||||||
|
prettyTag (UnknownTag t ) = t
|
||||||
|
prettyTag Old = ""
|
||||||
|
|
||||||
data Architecture = A_64
|
data Architecture = A_64
|
||||||
| A_32
|
| A_32
|
||||||
|
Loading…
Reference in New Issue
Block a user