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.File
import GHCup.Prelude.Logger import GHCup.Prelude.Logger
import GHCup.Prelude.Process import GHCup.Prelude.Process
import GHCup.Prompts
import Brick import Brick
import Brick.Widgets.Border import Brick.Widgets.Border
@ -98,7 +99,7 @@ keyHandlers KeyBindings {..} =
[ (bQuit, const "Quit" , halt) [ (bQuit, const "Quit" , halt)
, (bInstall, const "Install" , withIOAction install') , (bInstall, const "Install" , withIOAction install')
, (bUninstall, const "Uninstall", withIOAction del') , (bUninstall, const "Uninstall", withIOAction del')
, (bSet, const "Set" , withIOAction ((liftIO .) . set')) , (bSet, const "Set" , withIOAction set')
, (bChangelog, const "ChangeLog", withIOAction changelog') , (bChangelog, const "ChangeLog", withIOAction changelog')
, ( bShowAllVersions , ( bShowAllVersions
, \BrickSettings {..} -> , \BrickSettings {..} ->
@ -486,9 +487,13 @@ install' _ (_, ListResult {..}) = do
<> "Also check the logs in ~/.ghcup/logs" <> "Also check the logs in ~/.ghcup/logs"
set' :: BrickState -> (Int, ListResult) -> IO (Either String ()) set' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m)
set' _ (_, ListResult {..}) = do => BrickState
settings <- readIORef settings' -> (Int, ListResult)
-> m (Either String ())
set' bs input@(_, ListResult {..}) = do
settings <- liftIO $ readIORef settings'
let run = let run =
flip runReaderT settings flip runReaderT settings
@ -504,7 +509,16 @@ set' _ (_, ListResult {..}) = do
) )
>>= \case >>= \case
VRight _ -> pure $ Right () 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) del' :: (MonadReader AppState m, MonadIO m, MonadFail m, MonadMask m, MonadUnliftIO m)