Skip to content

Commit

Permalink
Cancel pager before writing to stdout
Browse files Browse the repository at this point in the history
  • Loading branch information
sol committed Sep 19, 2023
1 parent 3cf6725 commit 7983656
Show file tree
Hide file tree
Showing 3 changed files with 36 additions and 23 deletions.
51 changes: 32 additions & 19 deletions src/EventQueue.hs
Original file line number Diff line number Diff line change
Expand Up @@ -70,26 +70,39 @@ readEvents chan = do
data Status = Terminate | Restart (Maybe [String])
deriving (Eq, Show)

processQueue :: (String -> IO ()) -> FilePath -> EventQueue -> IO () -> IO () -> IO Status
processQueue echo dir chan triggerAll trigger = go
processQueue :: IO () -> (String -> IO ()) -> FilePath -> EventQueue -> IO () -> IO () -> IO Status
processQueue cleanup echo dir chan triggerAll trigger = go
where
go = readEvents chan >>= processEvents echo dir >>= \ case
NoneAction -> do
go
TriggerAction files -> do
output files
trigger
go
TriggerAllAction -> do
triggerAll
go
RestartAction file t -> do
output [file <> " (" <> show t <> ", restarting)"]
return $ Restart Nothing
RestartWithAction args -> do
return $ Restart (Just args)
DoneAction -> do
return Terminate
go :: IO Status
go = do
action <- readEvents chan >>= processEvents echo dir
runCleanup action
case action of
NoneAction -> do
go
TriggerAction files -> do
output files
trigger
go
TriggerAllAction -> do
triggerAll
go
RestartAction file t -> do
output [file <> " (" <> show t <> ", restarting)"]
return $ Restart Nothing
RestartWithAction args -> do
return $ Restart (Just args)
DoneAction -> do
return Terminate

runCleanup :: Action -> IO ()
runCleanup = \ case
NoneAction -> pass
TriggerAction {} -> cleanup
TriggerAllAction -> cleanup
RestartAction {} -> cleanup
RestartWithAction {} -> cleanup
DoneAction -> cleanup

output :: [String] -> IO ()
output = mapM_ (\ name -> echo . withInfoColor $ "--> " <> name <> "\n")
Expand Down
2 changes: 1 addition & 1 deletion src/Run.hs
Original file line number Diff line number Diff line change
Expand Up @@ -144,7 +144,7 @@ runWith RunArgs {..} = do
triggerAction = saveOutput (trigger session hooks)
triggerAllAction = saveOutput (triggerAll session hooks)
triggerAction
processQueue (sessionConfig.configEcho . encodeUtf8) dir queue triggerAllAction triggerAction
processQueue runCleanupAction (sessionConfig.configEcho . encodeUtf8) dir queue triggerAllAction triggerAction
case status of
Restart mExtraArgs -> go (fromMaybe extraArgs mExtraArgs)
Terminate -> return ()
Expand Down
6 changes: 3 additions & 3 deletions test/EventQueueSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,7 @@ spec = do
watchFiles dir queue $ do
threadDelay 100_000
touch $ dir </> "FooSpec.hs"
timeout (processQueue silent dir queue pass pass) `shouldReturn` Just (Restart Nothing)
timeout (processQueue pass silent dir queue pass pass) `shouldReturn` Just (Restart Nothing)

context "when a spec is removed" $ do
it "restarts" $ do
Expand All @@ -33,7 +33,7 @@ spec = do
watchFiles dir queue $ do
threadDelay 100_000
removeFile file
timeout (processQueue silent dir queue pass pass) `shouldReturn` Just (Restart Nothing)
timeout (processQueue pass silent dir queue pass pass) `shouldReturn` Just (Restart Nothing)

context "when .ghci is modified" $ do
it "restarts" $ do
Expand All @@ -44,7 +44,7 @@ spec = do
watchFiles dir queue $ do
threadDelay 100_000
touch file
timeout (processQueue silent dir queue pass pass) `shouldReturn` Just (Restart Nothing)
timeout (processQueue pass silent dir queue pass pass) `shouldReturn` Just (Restart Nothing)

describe "processEvents" $ do
around withGitRepository $ do
Expand Down

0 comments on commit 7983656

Please sign in to comment.