Clean up Daemon start up and messaging

app/AppConfig.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module AppConfig where
+module AppConfig (AppConfig(..), defaultConfig, resolveStartupSplashPath) where
 
 import Data.Maybe (fromMaybe)
 import qualified Data.Text as T
@@ -29,6 +29,8 @@ data AppConfig = AppConfig
     -- ^ Prompt to show for the live interpreter.
     , getDebugConsoleOnStart :: !Bool
     -- ^ Display the debug console on start up.
+    , getDebugLogPath :: !FilePath
+    , getVerbosity :: !Int
     , getStartupSplashPath :: !(Maybe FilePath)
     , getCmd :: !T.Text
     -- ^ Command to run to initialise the interpreter.
@@ -41,6 +43,8 @@ defaultConfig =
     AppConfig
         { getInterpreterPrompt = "ghci> "
         , getDebugConsoleOnStart = False
+        , getDebugLogPath = ""
+        , getVerbosity = 0
         , getStartupSplashPath = Nothing
         , getCmd = "cabal v2-repl --repl-options='-fno-it'"
         , getStartupCommands = mempty

app/Main.hs

@@ -1,5 +1,12 @@
+{-# LANGUAGE ApplicativeDo #-}
+{-# LANGUAGE RecordWildCards #-}
+
 module Main where
 
+import qualified Paths_ghcitui as CabalPkg
+import qualified Data.Version
+
+import Control.Applicative (many)
 import qualified Data.Text as T
 import qualified Options.Applicative as Opt
 
@@ -8,7 +15,10 @@ import BrickUI (launchBrick)
 
 -- | Holds passed in command line options.
 data CmdOptions = CmdOptions
-    { debugConsole :: !Bool
+    { version :: !Bool
+    , debugConsole :: !Bool
+    , verbosity :: !Int
+    , debugLogPath :: !FilePath
     , cmd :: !T.Text
     , workdir :: !FilePath
     -- ^ Launch the TUI at this work directory.
@@ -18,43 +28,74 @@ data CmdOptions = CmdOptions
     deriving (Show, Eq)
 
 parseOpts :: Opt.Parser CmdOptions
-parseOpts =
+parseOpts = do
-    CmdOptions
+    version <- Opt.switch (Opt.long "version" <> Opt.help "Print the version number and exit")
-        <$> Opt.switch
+    debugConsole <-
+        Opt.switch
             ( Opt.long "debug-console"
-                <> Opt.short 'd'
                 <> Opt.help "Display the debug console"
             )
-        <*> Opt.strOption
+    verbosity <-
+        length <$> many (Opt.flag' () (Opt.short 'v' <> Opt.help verbosityHelp))
+    debugLogPath <-
+        Opt.strOption
+            ( Opt.long "daemon-log"
+                <> Opt.help daemonLogHelp
+                <> Opt.metavar "LOGFILE"
+                <> Opt.value "/tmp/ghcitui.log"
+            )
+    cmd <-
+        Opt.strOption
             ( Opt.long "cmd"
                 <> Opt.short 'c'
                 <> Opt.metavar "CMD"
                 <> Opt.help "Command to start the internal interpreter"
                 <> Opt.value ""
             )
-        <*> Opt.strOption
+    workdir <-
+        Opt.strOption
             ( Opt.long "workdir"
                 <> Opt.short 'C'
                 <> Opt.metavar "DIR"
                 <> Opt.help "Set working dir"
                 <> Opt.value ""
             )
-        <*> Opt.argument Opt.str (Opt.metavar "TARGET" <> Opt.value "")
+    target <- Opt.argument Opt.str (Opt.metavar "TARGET" <> Opt.value "")
+    pure CmdOptions{..}
+  where
+    verbosityHelp =
+        "Set verbosity for output logs."
+            <> " Pass multiple times (e.g -vvv) to increase the logging."
+            <> " Use --daemon-log to specify where the logs go."
+    daemonLogHelp =
+        "File path for debugging daemon logs."
+            <> " Used with -v."
+            <> " Setting this to 'stdout' or 'stderr' sends logs to each, respectively."
+            <> " Defaults to /tmp/ghcitui.log."
+
+-- | The cabal package version.
+programVersion :: String
+programVersion = Data.Version.showVersion CabalPkg.version
 
 main :: IO ()
 main = do
     opts <- Opt.execParser parserInfo
-    let conf =
+    if version opts
-            defConf
+        then do
-                { AppConfig.getDebugConsoleOnStart = debugConsole opts
+            putStrLn $ programName <> " " <> programVersion
-                , AppConfig.getCmd =
+        else do
-                    if T.null $ cmd opts
+            let conf =
-                        then AppConfig.getCmd defConf
+                    AppConfig.defaultConfig
-                        else cmd opts
+                        { AppConfig.getDebugConsoleOnStart = debugConsole opts
-                }
+                        , AppConfig.getVerbosity = verbosity opts
-    launchBrick conf (target opts) (workdir opts)
+                        , AppConfig.getDebugLogPath = debugLogPath opts
+                        , AppConfig.getCmd =
+                            if T.null $ cmd opts
+                                then AppConfig.getCmd AppConfig.defaultConfig
+                                else cmd opts
+                        }
+            launchBrick conf (target opts) (workdir opts)
   where
     programName = "ghcitui"
     programDescription = Opt.progDesc (programName <> ": A TUI interface for GHCi")
-    parserInfo = Opt.info (Opt.helper <*> parseOpts) (Opt.fullDesc <> programDescription)
+    parserInfo = Opt.info (Opt.helper <*> parseOpts) (Opt.fullDesc <> programDescription)
-    defConf = AppConfig.defaultConfig

ghcitui.cabal

@@ -10,6 +10,7 @@ description:
     * A source view window, with debug keybindings.
     * Live variable bindings.
     * Live loaded modules.
+    * Visible trace history.
     * An GHCi session in the current context.
 
 bug-reports:        https://github.com/CrystalSplitter/ghcitui
@@ -22,6 +23,8 @@ maintainer:         gamewhizzit@gmail.com
 category: Debug
 extra-source-files: CHANGELOG.md
                     , LICENSE
+                    , MANUAL.rst
+                    , README.md
 
 source-repository head
     type:       git
@@ -50,6 +53,8 @@ executable ghcitui
                         , AppConfig
                         , Events
                         , HelpText
+                        -- Cabal autogen module for package version info.
+                        , Paths_ghcitui
     ghc-options:        -rtsopts
                         -threaded
                         -Wall
@@ -70,7 +75,7 @@ library ghcitui-lib
     hs-source-dirs:     lib
     build-depends:      base >= 4.17 && < 5
                         , array ^>= 0.5.4.0
-                        , containers ^>= 0.6.7
+                        , containers >= 0.6.7 && < 0.8
                         , errors ^>= 2.3.0
                         , ghcid ^>= 0.8.8
                         , regex-base ^>= 0.94.0.2
@@ -81,9 +86,11 @@ library ghcitui-lib
                         , transformers ^>= 0.6.1.0
     exposed-modules:    Ghcitui.Ghcid.Daemon
                         , Ghcitui.Ghcid.ParseContext
+                        , Ghcitui.Ghcid.LogConfig
                         , Ghcitui.Loc
                         , Ghcitui.Util
                         , Ghcitui.NameBinding
+    other-modules:      Ghcitui.Ghcid.StartupConfig
     ghc-options:        -Wall
                         -Wcompat
                         -Wincomplete-record-updates

lib/Ghcitui/Ghcid/Daemon.hs

@@ -19,6 +19,7 @@ module Ghcitui.Ghcid.Daemon
 
       -- * Startup and shutdown
     , startup
+    , StartupConfig(..)
     , quit
 
       -- * Base operations with the daemon
@@ -49,6 +50,7 @@ module Ghcitui.Ghcid.Daemon
     , run
     , DaemonIO
     , DaemonError
+    , LogOutput(..)
     ) where
 
 import Control.Error
@@ -65,11 +67,9 @@ import qualified Ghcitui.Loc as Loc
 import qualified Ghcitui.NameBinding as NameBinding
 import Ghcitui.Util (showT)
 import qualified Ghcitui.Util as Util
-
+import Ghcitui.Ghcid.LogConfig (LogLevel(..), LogOutput(..))
-newtype LogLevel = LogLevel Int deriving (Eq, Ord, Show)
+import Ghcitui.Ghcid.StartupConfig (StartupConfig)
-
+import qualified Ghcitui.Ghcid.StartupConfig as StartupConfig
--- | Determines where the daemon logs are written.
-data LogOutput = LogOutputStdOut | LogOutputStdErr | LogOutputFile FilePath
 
 data InterpState a = InterpState
     { _ghci :: Ghcid.Ghci
@@ -113,8 +113,8 @@ instance Show (InterpState a) where
 {- | Create an empty/starting interpreter state.
 Usually you don't want to call this directly. Instead use 'startup'.
 -}
-emptyInterpreterState :: (Monoid a) => Ghcid.Ghci -> InterpState a
+emptyInterpreterState :: (Monoid a) => Ghcid.Ghci -> StartupConfig -> InterpState a
-emptyInterpreterState ghci =
+emptyInterpreterState ghci startupConfig =
     InterpState
         { _ghci = ghci
         , func = Nothing
@@ -124,12 +124,23 @@ emptyInterpreterState ghci =
         , breakpoints = mempty
         , bindings = Right mempty
         , status = Right mempty
-        , logLevel = LogLevel 3
+        , logLevel = StartupConfig.logLevel startupConfig
-        , logOutput = LogOutputFile "/tmp/ghcitui.log"
+        , logOutput = StartupConfig.logOutput startupConfig
         , execHist = mempty
         , traceHist = mempty
         }
 
+-- | Reset anything context-based in a 'InterpState'.
+contextReset :: (Monoid a) => InterpState a -> InterpState a
+contextReset state = state {
+    func = Nothing
+    , pauseLoc = Nothing
+    , stack = mempty
+    , bindings = Right mempty
+    , status = Right mempty
+    , traceHist = mempty
+}
+
 -- | Append a string to the interpreter's history.
 appendExecHist :: T.Text -> InterpState a -> InterpState a
 appendExecHist cmd s@InterpState{execHist} = s{execHist = cmd : execHist}
@@ -145,12 +156,18 @@ startup
     -- ^ Command to run (e.g. "ghci" or "cabal repl")
     -> FilePath
     -- ^ Working directory to run the start up command in.
+    -> StartupConfig
+    -- ^ Where do we put the logging?
     -> DaemonIO (InterpState ())
     -- ^ The newly created interpreter handle.
-startup cmd pwd = do
+startup cmd wd logOutput = do
-    let startOp = Ghcid.startGhci cmd (Just pwd) (\_ _ -> pure ())
+    -- We don't want any highlighting or colours.
+    let realCmd = "env TERM='dumb' " <> cmd
+    let startOp = Ghcid.startGhci realCmd (Just wd) (\_ _ -> pure ())
     (ghci, _) <- liftIO startOp
-    updateState (emptyInterpreterState ghci)
+    let state = emptyInterpreterState ghci logOutput
+    logDebug "|startup| GHCi Daemon initted" state
+    updateState state
 
 -- | Shut down the GHCi Daemon.
 quit :: InterpState a -> IO (InterpState a)
@@ -187,12 +204,12 @@ updateContext state@InterpState{_ghci} = do
         )
         state
     if T.null feedback
-        then pure (emptyInterpreterState _ghci) -- We exited everything.
+        then pure $ contextReset state -- We exited everything.
         else do
             let ctx = ParseContext.parseContext feedback
             case ctx of
                 ParseContext.PCError er -> error [i|Failed to update context: #{er}|]
-                ParseContext.PCNoContext -> pure (emptyInterpreterState _ghci)
+                ParseContext.PCNoContext -> pure $ contextReset state
                 ParseContext.PCContext
                     ParseContext.ParseContextOut{func, filepath, pcSourceRange} ->
                         pure
@@ -292,7 +309,7 @@ exec :: (Monoid a) => T.Text -> InterpState a -> ExceptT DaemonError IO (InterpS
 exec cmd state@InterpState{_ghci} = do
     logDebug ("|exec| CMD: " <> cmd) state
     msgs <- liftIO $ Ghcid.exec _ghci (T.unpack cmd)
-    logDebug [i|{|exec| OUT:\n#{Util.linesToText msgs}\n}|] state
+    logDebug [i||exec| OUT:\n#{Util.linesToText msgs}\n|] state
     newState <-
         updateState
             ( -- Only append the command to the history if it has something interesting.
@@ -367,7 +384,7 @@ setBreakpointLine loc state = do
                         then
                             throwE
                                 (BreakpointError "Cannot set breakpoint at unknown line number")
-                        else pure (mod' <> " " <> line <> " " <> colno)
+                        else pure [i|#{mod'} #{line} #{colno}|]
         pure (":break " <> breakPos)
 
 -- | Delete a breakpoint at a given line.
@@ -447,12 +464,12 @@ getBpInFile fp state =
 logDebug :: (MonadIO m) => T.Text -> InterpState a -> m ()
 logDebug msg state =
     liftIO $ do
-        when (logLevel state >= LogLevel 3) $
+        when (logLevel state >= LogLevel 2) $
             logHelper output "[DEBUG]: " msg
   where
     output = logOutput state
 
--- | Log a message at the Error level.
+{- Log a message at the Error level.
 logError :: (MonadIO m) => T.Text -> InterpState a -> m ()
 logError msg state =
     liftIO $ do
@@ -460,6 +477,7 @@ logError msg state =
             logHelper output "[ERROR]: " msg
   where
     output = logOutput state
+-}
 
 logHelper
     :: (MonadIO m)

lib/Ghcitui/Ghcid/LogConfig.hs

@@ -0,0 +1,7 @@
+module Ghcitui.Ghcid.LogConfig where
+
+-- | Determines how verbose logging should be.
+newtype LogLevel = LogLevel Int deriving (Eq, Ord, Show)
+
+-- | Determines where the daemon logs are written.
+data LogOutput = LogOutputStdOut | LogOutputStdErr | LogOutputFile FilePath deriving (Show)

lib/Ghcitui/Ghcid/StartupConfig.hs

@@ -0,0 +1,9 @@
+module Ghcitui.Ghcid.StartupConfig where
+
+import Ghcitui.Ghcid.LogConfig (LogLevel, LogOutput)
+
+-- | Configuration passed during Daemon 'startup'
+data StartupConfig = StartupConfig
+    { logLevel :: !LogLevel
+    , logOutput :: !LogOutput
+    }