Skip to content

Commit

Permalink
Fix support for 'more'
Browse files Browse the repository at this point in the history
Co-authored-by: Divam <[email protected]>
  • Loading branch information
hasufell and dfordivam committed Sep 24, 2024
1 parent 8588cf8 commit a2cae45
Showing 1 changed file with 4 additions and 6 deletions.
10 changes: 4 additions & 6 deletions lib/GHCup/Utils/Pager.hs
Original file line number Diff line number Diff line change
Expand Up @@ -33,22 +33,20 @@ getPager = do
. fmap (maybe (fail "could not find") pure <=< findExecutable)
$ pagers

-- 'more' reads from STDERR, and requires std_err to be 'Inherit'
sendToPager :: FilePath -> [Text] -> IO (Either IOException ())
sendToPager pager text = try @IOException
$ withCreateProcess (shell pager) { std_in = CreatePipe
, std_err = CreatePipe
, std_err = Inherit
, std_out = Inherit
, delegate_ctlc = True
}
$ \(Just stdinH) _ (Just stderrH) ph -> do
$ \(Just stdinH) _ _ ph -> do
forM_ text $ T.hPutStrLn stdinH
hClose stdinH
exitCode <- waitForProcess ph
case exitCode of
ExitFailure i ->
do errContents <- hGetContents stderrH
fail (unlines [mappend "Pager exited with exit code " (show i)
,errContents])
ExitFailure i -> fail ("Pager exited with exit code " <> show i)
_ -> pure ()


Expand Down

0 comments on commit a2cae45

Please sign in to comment.