diff --git a/app/AppConfig.hs b/app/AppConfig.hs index 535e7b0..e315f61 100644 --- a/app/AppConfig.hs +++ b/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 diff --git a/app/Main.hs b/app/Main.hs index 1649bf3..88b2247 100644 --- a/app/Main.hs +++ b/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 = - CmdOptions - <$> Opt.switch +parseOpts = do + version <- Opt.switch (Opt.long "version" <> Opt.help "Print the version number and exit") + 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 = - defConf - { AppConfig.getDebugConsoleOnStart = debugConsole opts - , AppConfig.getCmd = - if T.null $ cmd opts - then AppConfig.getCmd defConf - else cmd opts - } - launchBrick conf (target opts) (workdir opts) + if version opts + then do + putStrLn $ programName <> " " <> programVersion + else do + let conf = + AppConfig.defaultConfig + { AppConfig.getDebugConsoleOnStart = debugConsole opts + , AppConfig.getVerbosity = verbosity 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) - defConf = AppConfig.defaultConfig + parserInfo = Opt.info (Opt.helper <*> parseOpts) (Opt.fullDesc <> programDescription) \ No newline at end of file diff --git a/ghcitui.cabal b/ghcitui.cabal index 9ae60be..258c763 100644 --- a/ghcitui.cabal +++ b/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 diff --git a/lib/Ghcitui/Ghcid/Daemon.hs b/lib/Ghcitui/Ghcid/Daemon.hs index b73c192..27bf728 100644 --- a/lib/Ghcitui/Ghcid/Daemon.hs +++ b/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 - -newtype LogLevel = LogLevel Int deriving (Eq, Ord, Show) - --- | Determines where the daemon logs are written. -data LogOutput = LogOutputStdOut | LogOutputStdErr | LogOutputFile FilePath +import Ghcitui.Ghcid.LogConfig (LogLevel(..), LogOutput(..)) +import Ghcitui.Ghcid.StartupConfig (StartupConfig) +import qualified Ghcitui.Ghcid.StartupConfig as StartupConfig 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 ghci = +emptyInterpreterState :: (Monoid a) => Ghcid.Ghci -> StartupConfig -> InterpState a +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 - , logOutput = LogOutputFile "/tmp/ghcitui.log" + , logLevel = StartupConfig.logLevel startupConfig + , 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 - let startOp = Ghcid.startGhci cmd (Just pwd) (\_ _ -> pure ()) +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 ()) (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) diff --git a/lib/Ghcitui/Ghcid/LogConfig.hs b/lib/Ghcitui/Ghcid/LogConfig.hs new file mode 100644 index 0000000..6d5af2a --- /dev/null +++ b/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) \ No newline at end of file diff --git a/lib/Ghcitui/Ghcid/StartupConfig.hs b/lib/Ghcitui/Ghcid/StartupConfig.hs new file mode 100644 index 0000000..da23b6c --- /dev/null +++ b/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 + } \ No newline at end of file