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

Remove network call on shell completion

Browse Source
This commit is contained in:
Julian Ospald 2021-02-25 15:46:08 +01:00
parent 47d9766c78
commit 4a50c8ecb7
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
1 changed files with 17 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
app/ghcup/Main.hs
View File

@ -495,7 +495,7 @@ installOpts tool =
) )
) )
) )
<*> (Just <$> toolVersionArgument True Nothing tool) <*> (Just <$> toolVersionArgument Nothing tool)
) )
<|> (pure (Nothing, Nothing)) <|> (pure (Nothing, Nothing))
) )
@ -560,7 +560,7 @@ setParser =
setOpts :: Maybe Tool -> Parser SetOptions setOpts :: Maybe Tool -> Parser SetOptions
setOpts tool = SetOptions <$> optional (toolVersionArgument False (Just ListInstalled) tool) setOpts tool = SetOptions <$> optional (toolVersionArgument (Just ListInstalled) tool)
listOpts :: Parser ListOptions listOpts :: Parser ListOptions
listOpts = listOpts =
@ -596,14 +596,14 @@ rmParser =
<> command <> command
"cabal" "cabal"
( RmCabal ( RmCabal
<$> (info (versionParser' False (Just ListInstalled) (Just Cabal) <**> helper) <$> (info (versionParser' (Just ListInstalled) (Just Cabal) <**> helper)
(progDesc "Remove Cabal version") (progDesc "Remove Cabal version")
) )
) )
<> command <> command
"hls" "hls"
( RmHLS ( RmHLS
<$> (info (versionParser' False (Just ListInstalled) (Just HLS) <**> helper) <$> (info (versionParser' (Just ListInstalled) (Just HLS) <**> helper)
(progDesc "Remove haskell-language-server version") (progDesc "Remove haskell-language-server version")
) )
) )
@ -614,7 +614,7 @@ rmParser =
rmOpts :: Maybe Tool -> Parser RmOptions rmOpts :: Maybe Tool -> Parser RmOptions
rmOpts tool = RmOptions <$> versionArgument False (Just ListInstalled) tool rmOpts tool = RmOptions <$> versionArgument (Just ListInstalled) tool
changelogP :: Parser ChangeLogOptions changelogP :: Parser ChangeLogOptions
@ -636,7 +636,7 @@ changelogP =
) )
) )
) )
<*> optional (toolVersionArgument True Nothing Nothing) <*> optional (toolVersionArgument Nothing Nothing)
compileP :: Parser CompileCommand compileP :: Parser CompileCommand
compileP = subparser compileP = subparser
@ -765,13 +765,13 @@ toolVersionParser = verP' <|> toolP
) )
-- | same as toolVersionParser, except as an argument. -- | same as toolVersionParser, except as an argument.
toolVersionArgument :: Bool -> Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion toolVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
toolVersionArgument networkSensitive criteria tool = toolVersionArgument criteria tool =
argument (eitherReader toolVersionEither) (metavar "VERSION|TAG" <> completer tagCompleter <> foldMap (completer . versionCompleter networkSensitive criteria) tool) argument (eitherReader toolVersionEither) (metavar "VERSION|TAG" <> completer tagCompleter <> foldMap (completer . versionCompleter criteria) tool)
versionArgument :: Bool -> Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion versionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion
versionArgument networkSensitive criteria tool = argument (eitherReader tVersionEither) (metavar "VERSION" <> foldMap (completer . versionCompleter networkSensitive criteria) tool) versionArgument criteria tool = argument (eitherReader tVersionEither) (metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
tagCompleter :: Completer tagCompleter :: Completer
@ -781,8 +781,8 @@ tagCompleter =
] ]
versionCompleter :: Bool -> Maybe ListCriteria -> Tool -> Completer versionCompleter :: Maybe ListCriteria -> Tool -> Completer
versionCompleter networkSensitive criteria tool = versionCompleter criteria tool =
listIOCompleter $ do listIOCompleter $ do
let let
loggerConfig = loggerConfig =
@ -795,11 +795,6 @@ versionCompleter networkSensitive criteria tool =
runLogger = runLogger =
myLoggerT loggerConfig myLoggerT loggerConfig
downloadWithUserSource = do
userConf <- runE @'[ JSONError ] ghcupConfigFile
getDownloadsF $
veitherCont (const GHCupURL) (fromMaybe GHCupURL . uUrlSource) userConf
mpFreq <- mpFreq <-
runLogger . runE $ runLogger . runE $
platformRequest platformRequest
@ -815,13 +810,7 @@ versionCompleter networkSensitive criteria tool =
runLogger . flip runReaderT simpleAppState runLogger . flip runReaderT simpleAppState
mGhcUpInfo <- mGhcUpInfo <-
runEnv . runE $ runEnv . runE $ readFromCache
if networkSensitive then do
downloadWithUserSource
else
catchE
(\(FileDoesNotExistError _) -> downloadWithUserSource)
readFromCache
forFold mGhcUpInfo $ \(GHCupInfo _ dls) -> do forFold mGhcUpInfo $ \(GHCupInfo _ dls) -> do
installedVersions <- installedVersions <-
@ -838,10 +827,10 @@ versionParser = option
(short 'v' <> long "version" <> metavar "VERSION" <> help "The target version" (short 'v' <> long "version" <> metavar "VERSION" <> help "The target version"
) )
versionParser' :: Bool -> Maybe ListCriteria -> Maybe Tool -> Parser Version versionParser' :: Maybe ListCriteria -> Maybe Tool -> Parser Version
versionParser' networkSensitive criteria tool = argument versionParser' criteria tool = argument
(eitherReader (first show . version . T.pack)) (eitherReader (first show . version . T.pack))
(metavar "VERSION" <> foldMap (completer . versionCompleter networkSensitive criteria) tool) (metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
tagEither :: String -> Either String Tag tagEither :: String -> Either String Tag