From 9248597e8e0d98c1585b1069294472dbe80a8838 Mon Sep 17 00:00:00 2001 From: CrystalSplitter Date: Mon, 15 Jan 2024 12:47:28 -0800 Subject: [PATCH] Add start up logging for GHCiD --- lib/ghcitui-core/Ghcitui/Ghcid/Daemon.hs | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/lib/ghcitui-core/Ghcitui/Ghcid/Daemon.hs b/lib/ghcitui-core/Ghcitui/Ghcid/Daemon.hs index a88682d..f0b194c 100644 --- a/lib/ghcitui-core/Ghcitui/Ghcid/Daemon.hs +++ b/lib/ghcitui-core/Ghcitui/Ghcid/Daemon.hs @@ -60,7 +60,7 @@ import Data.String.Interpolate (i) import qualified Data.Text as T import qualified Data.Text.IO as T import qualified Language.Haskell.Ghcid as Ghcid -import System.IO (stderr) +import qualified System.IO as IO import Ghcitui.Ghcid.LogConfig (LogLevel (..), LogOutput (..)) import qualified Ghcitui.Ghcid.ParseContext as ParseContext @@ -164,12 +164,21 @@ startup startup cmd wd logOutput = do -- We don't want any highlighting or colours. let realCmd = "env TERM='dumb' " <> cmd - let startOp = Ghcid.startGhci realCmd (Just wd) (\_ _ -> pure ()) + let startOp = Ghcid.startGhci realCmd (Just wd) startupStreamCallback (ghci, _) <- liftIO startOp let state = emptyInterpreterState ghci logOutput logDebug "|startup| GHCi Daemon initted" state updateState state +startupStreamCallback :: Ghcid.Stream -> String -> IO () +startupStreamCallback stream msg = do + IO.hPutStrLn handle [i|[ghcid startup:#{prefix}] #{msg}|] + IO.hFlush handle + where + (handle, prefix) = case stream of + Ghcid.Stdout -> (IO.stdout, "out" :: String) + Ghcid.Stderr -> (IO.stderr, "err" :: String) + -- | Shut down the GHCi Daemon. quit :: InterpState a -> IO (InterpState a) quit state = do @@ -498,7 +507,7 @@ logHelper outputLoc prefix msg = do liftIO $ case outputLoc of LogOutputFile path -> T.appendFile path fmtMsg LogOutputStdOut -> T.putStrLn fmtMsg - LogOutputStdErr -> T.hPutStrLn stderr fmtMsg + LogOutputStdErr -> T.hPutStrLn IO.stderr fmtMsg where fmtMsg = T.unlines [prefix <> line | line <- T.lines msg]