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

when setting an uninstalled tool in tui, asks user to install first

Browse Source
This commit is contained in:
Arjun Kathuria 2022-06-25 13:45:07 +05:30
parent c7eceb2330
commit 0e1fd68d93
1 changed files with 19 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
app/ghcup/BrickMain.hs
View File

@ -17,6 +17,7 @@ import GHCup.Prelude ( decUTF8Safe )
import GHCup.Prelude.File
import GHCup.Prelude.Logger
import GHCup.Prelude.Process
import GHCup.Prompts
import Brick
import Brick.Widgets.Border
@ -98,7 +99,7 @@ keyHandlers KeyBindings {..} =
[ (bQuit, const "Quit" , halt)
, (bInstall, const "Install" , withIOAction install')
, (bUninstall, const "Uninstall", withIOAction del')
, (bSet, const "Set" , withIOAction ((liftIO .) . set'))
, (bSet, const "Set" , withIOAction set')
, (bChangelog, const "ChangeLog", withIOAction changelog')
, ( bShowAllVersions
, \BrickSettings {..} ->
@ -486,9 +487,13 @@ install' _ (_, ListResult {..}) = do
<> "Also check the logs in ~/.ghcup/logs"
set' :: BrickState -> (Int, ListResult) -> IO (Either String ())
set' _ (_, ListResult {..}) = do
settings <- readIORef settings'
set' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m)
=> BrickState
-> (Int, ListResult)
-> m (Either String ())
set' bs input@(_, ListResult {..}) = do
settings <- liftIO $ readIORef settings'
let run =
flip runReaderT settings
@ -504,7 +509,16 @@ set' _ (_, ListResult {..}) = do
)
>>= \case
VRight _ -> pure $ Right ()
VLeft e -> pure $ Left (prettyShow e)
VLeft e -> case e of
(V (NotInstalled tool tver)) -> do
promptAnswer <- liftIO $ getUserPromptResponse userPrompt
case promptAnswer of
PromptYes -> install' bs input
PromptNo -> pure $ Left (prettyShow e)
where
userPrompt = "The tool/version you're trying to set is not installed, would you like to install it first? "
_ -> pure $ Left (prettyShow e)
del' :: (MonadReader AppState m, MonadIO m, MonadFail m, MonadMask m, MonadUnliftIO m)