ghcitui 0.1.0.0 → 0.2.0.0

raw patch · 16 files changed

+284/−54 lines, 16 filesdep ~vtyPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: vty

API changes (from Hackage documentation)

Files

• CHANGELOG.md +35/−0
• MANUAL.rst +1/−0
• README.md +1/−1
• gen/MANUAL.txt +2/−0
• ghcitui.cabal +8/−3
• lib/ghcitui-brick/Ghcitui/Brick/AppInterpState.hs +13/−5
• lib/ghcitui-brick/Ghcitui/Brick/AppState.hs +5/−1
• lib/ghcitui-brick/Ghcitui/Brick/BrickUI.hs +0/−1
• lib/ghcitui-brick/Ghcitui/Brick/DrawSourceViewer.hs +17/−8
• lib/ghcitui-brick/Ghcitui/Brick/Events.hs +94/−18
• lib/ghcitui-core/Ghcitui/Ghcid/Daemon.hs +48/−13
• lib/ghcitui-core/Ghcitui/Ghcid/LogConfig.hs +1/−1
• lib/ghcitui-core/Ghcitui/Ghcid/ParseContext.hs +1/−2
• lib/ghcitui-core/Ghcitui/Ghcid/ParseError.hs +6/−0
• lib/ghcitui-core/Ghcitui/Ghcid/ParseTabCompletions.hs +51/−0
• lib/ghcitui-core/Ghcitui/Loc.hs +1/−1

@@ -1,5 +1,39 @@ # Revision history for ghcitui +## 0.2.0.0 -- 2024-02-11++### New Features++- Rudimentary tab completion! (credit: https://github.com/bradrn)++### API Changes++- **Ghcitui.Brick**+  - Added functions to support tab completion.+- **Ghcitui.Core**+  - Added `Ghcitui.Ghcid.ParseTabCompletions` module.+  - Added `Ghcitui.Ghcid.Daemon.tabComplete`.+  - Moved ParseError to its own module (`Ghcitui.Ghcid.ParseError`).+  - Removed lazy data fields in records in+    - `Ghcitui.Ghcid.Daemon.BreakpointArg`+    - `Ghcitui.Ghcid.Daemon.InterpState`+    - Possibly a few more+- **Other**+  - Update version for `vty`.++### Bug fixes++- Fix issue with CRLF line endings caused weird source viewer wrapping behaviour.++### Misc++- Added help message on start up splash to mention '?' keybinding.+- Increased the cabal `tested-with` range.++### Known issues++See https://github.com/CrystalSplitter/ghcitui/issues for the latest issues.+ ## 0.1.0.0 -- 2024-01-21  First release! This is a "public beta" release, which we try to get feedback for higher priority@@ -29,3 +63,4 @@ - String variables which contain quotes are not parsed correctly. - Unable to interrupt expressions (hopefully fixed in a future version?) - Currently no remapping of keybindings or colours.+- CRLF line endings don't work (fixed in 0.2.0.0)

@@ -147,6 +147,7 @@ - ``+``, ``-`` while in scrolling mode: Increase/decrease the live   panel size. - ``<Enter>``: Enter a command to the REPL.+- ``<Tab>``: Autocomplete (yes there's basic autocomplete support)  ******* Modules

@@ -13,7 +13,7 @@      (' _ '                    \/_/   \/_____/  \/_/ ``` -![GitHub Actions Workflow Status](https://img.shields.io/github/actions/workflow/status/CrystalSplitter/ghcitui/haskell.yaml)+![GitHub Actions Workflow Status](https://img.shields.io/github/actions/workflow/status/CrystalSplitter/ghcitui/haskell.yaml) ![Hackage Version](https://img.shields.io/hackage/v/ghcitui)  This is an experimental front-end terminal interface for `ghci`. It provides a source viewer, keybindings, an interactive

@@ -129,6 +129,8 @@         • <Enter>: Enter a command to the REPL. +       • <Tab>: Autocomplete (yes there's basic autocomplete support)+    Modules        • ?: Display help inside GHCiTUI. 

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               ghcitui-version:            0.1.0.0+version:            0.2.0.0 synopsis:           A Terminal User Interface (TUI) for GHCi  description:@@ -27,7 +27,10 @@ license:            BSD-3-Clause maintainer:         crystal@crystalwobsite.gay stability:          experimental-tested-with:        GHC == 9.2.8, GHC == 9.4.8, GHC == 9.8.1+tested-with:        GHC == 9.2.8+                    ||==9.4.7+                    ||==9.4.8+                    ||==9.8.1  extra-source-files: LICENSE                     , assets/splash.txt@@ -82,6 +85,8 @@     exposed-modules:    Ghcitui.Ghcid.Daemon                         , Ghcitui.Ghcid.LogConfig                         , Ghcitui.Ghcid.ParseContext+                        , Ghcitui.Ghcid.ParseError+                        , Ghcitui.Ghcid.ParseTabCompletions                         , Ghcitui.Loc                         , Ghcitui.NameBinding                         , Ghcitui.Util@@ -112,7 +117,7 @@                         , text                         , text-zipper ^>= 0.13                         , vector >= 0.10 && < 0.14-                        , vty >= 5.38 && < 6.2+                        , vty >= 5.38 && < 6.3                         , word-wrap ^>= 0.5     exposed-modules:    Ghcitui.Brick     other-modules:      Ghcitui.Brick.AppConfig

@@ -1,4 +1,3 @@-{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE RecordWildCards #-}  module Ghcitui.Brick.AppInterpState@@ -18,14 +17,21 @@ import qualified Data.Text as T import Lens.Micro as Lens +{- | The state of the Live Interpreter (GHCi) window. The one at the bottom of+     the TUI normally. It's solely visual TUI state. It holds bits of Brick state,+     and only Brick-related things. For example, the last things you ran in the terminal,+     whether you're scrolling the history, and what's the current command buffer.+-} data AppInterpState s n = AppInterpState-    { _liveEditor :: BE.Editor s n+    { _liveEditor :: !(BE.Editor s n)+    -- ^ Brick editor for the actual interactive prompt.     , _viewLock :: !Bool     -- ^ Whether we're locked to the bottom of the interpreter (True) window or not (False).-    , _commandBuffer :: [s]+    , _commandBuffer :: ![s]     -- ^ The text currently typed into the editor, but not yet executed or in the history.-    , _cmdHistory :: [[s]]+    , _cmdHistory :: ![[s]]     , historyPos :: !Int+    -- ^ Current position     }  -- | Lens accessor for the editor. See '_liveEditor'.@@ -40,7 +46,9 @@ commandBuffer :: Lens.Lens' (AppInterpState s n) [s] commandBuffer = Lens.lens _commandBuffer (\ais x -> ais{_commandBuffer = x}) --- | Return the interpreter command history.+{- | Return the interpreter command history (what you've typed in the past.)+     Sorted most recent first, oldest last.+-} cmdHistory :: AppInterpState s n -> [[s]] cmdHistory = _cmdHistory 

@@ -220,9 +220,13 @@                         )                         s             Right contents -> do-                let newSourceMap = Map.insert filepath contents s.sourceMap+                let newSourceMap = Map.insert filepath (stripCREndings contents) s.sourceMap                 let logMsg = "updated source map with " <> T.pack filepath                 pure (writeDebugLog logMsg s{sourceMap = newSourceMap})++-- | Remove CR line endings.+stripCREndings :: T.Text -> T.Text+stripCREndings = T.replace "\r" ""  listAvailableSources :: AppState n -> [(T.Text, FilePath)] listAvailableSources = Loc.moduleFileMapAssocs . Daemon.moduleFileMap . interpState

@@ -1,7 +1,6 @@ {-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} - module Ghcitui.Brick.BrickUI     ( launchBrick     , AppState (..)

@@ -31,15 +31,24 @@     currentlyRunning = Daemon.isExecuting (AppState.interpState s)     srcWindow = s ^. AppState.sourceWindow     notRunningWidget =-        padWidget splashWidget-            <=> padWidget (B.txt "Nothing executing. Maybe run something?")+        withStyle+            ( padTop (B.hCenter splashWidget)+                <=> padTop+                    ( B.hCenter (B.txt "Nothing executing. Maybe run something?")+                        <=> B.hCenter (B.txt "Press '?' for help.")+                    )+            )     noSourceWidget =-        padWidget splashWidget <=> padWidget (B.txt "Can't display. Source not found.")-    padWidget w =-        B.padTop (B.Pad 3)-            . B.hCenter-            $ B.withAttr (B.attrName "styled") w-    splashWidget = B.txt $ fromMaybe "No splash file loaded." (AppState.splashContents s)+        withStyle (B.hCenter splashWidget <=> padTop (B.txt "Can't display. Source not found."))+    splashWidget =+        withStyle (B.txt (fromMaybe "No splash file loaded." (AppState.splashContents s)))++    -- Utils+    padTop :: B.Widget n -> B.Widget n+    padTop = B.padTop (B.Pad 3)++    withStyle :: B.Widget n -> B.Widget n+    withStyle = B.withAttr (B.attrName "styled")  -- ------------------------------------------------------------------------------------------------- -- Source Viewer Drawing Details

@@ -9,6 +9,7 @@ import qualified Brick.Widgets.Edit as BE import Control.Error (atDef, fromMaybe, lastDef, note) import Control.Monad.IO.Class (MonadIO (..))+import Data.List (foldl') import qualified Data.Text as T import qualified Data.Text.Zipper as T import qualified Graphics.Vty as V@@ -89,39 +90,57 @@     case ev of         B.VtyEvent (V.EvKey V.KEnter []) -> do             let cmd = T.strip (T.unlines (editorContents appState))-             -- Actually run the command.             (newAppState1, output) <- runDaemon2 (Daemon.execCleaned cmd) appState-             let newEditor =                     BE.applyEdit                         (T.killToEOF . T.gotoBOF)                         (appState ^. liveEditor)-            -- TODO: Should be configurable?-            let interpreterLogLimit = 1000-            let formattedWithPrompt = appState.appConfig.getInterpreterPrompt <> cmd-            let combinedLogs = reverse output <> (formattedWithPrompt : interpLogs appState)             let newAppState2 =                     writeDebugLog ("Handled Enter: Ran '" <> cmd <> "'")                         . Lens.set (appInterpState . AIS.viewLock) True-                        . Lens.over appInterpState (AIS.pushHistory (editorContents appState))-                        $ newAppState1-                            { interpLogs =-                                take interpreterLogLimit combinedLogs-                            }+                        . Lens.over appInterpState (AIS.pushHistory [cmd])+                        $ appendToLogs output cmd newAppState1             let appStateFinalIO = updateSourceMap (Lens.set liveEditor newEditor newAppState2)             B.put =<< liftIO appStateFinalIO             -- Invalidate the entire render state of the application             -- because we don't know what's actually changed here now.             B.invalidateCache         B.VtyEvent (V.EvKey (V.KChar '\t') []) -> do-            -- Tab completion?-            let cmd = T.strip (T.unlines (editorContents appState))-            (newAppState1, _output) <--                runDaemon2-                    (Daemon.execCleaned (":complete " <> cmd))-                    appState-            B.put newAppState1+            -- We want to preserve spaces, but not trailing newlines.+            let cmd = T.dropWhileEnd ('\n' ==) . T.unlines . editorContents $ appState+            -- Tab completion expects input to be 'show'n in quotes.+            -- There's probably a better way of doing this!+            (newAppState, (prefix, completions)) <- runDaemon2 (Daemon.tabComplete cmd) appState+            let maxCompletionLen = maximum $ T.length <$> completions+            let columnPadding = 1+            extent <-+                B.lookupExtent LiveInterpreterViewport >>= \case+                    Just e -> pure e+                    Nothing -> error "Could not find extent of LiveInterpreterViewport"+            let interpWidth = fst . B.extentSize $ extent+            let completionColWidth = min (interpWidth - 2) maxCompletionLen + columnPadding+            let numCols = interpWidth `div` completionColWidth+            let updateCompletions cs s = case cs of+                    -- Only one completion, just replace the entire buffer with it.+                    [c] -> replaceCommandBuffer (prefix <> c <> " ") s+                    -- No completions. Just go to a new prompt.+                    [] -> appendToLogs [] cmd s+                    -- Replace the buffer with the longest possible prefix among options, and+                    -- print the remaining.+                    _ ->+                        replaceCommandBuffer (prefix <> commonPrefixes cs)+                            . appendToLogs (reflowText numCols completionColWidth cs) cmd+                            $ s+            B.put+                . writeDebugLog+                    ( "Handled Tab, Prefix was: '"+                        <> cmd+                        <> "' Completions were: "+                        <> showT completions+                    )+                . updateCompletions completions+                $ newAppState         B.VtyEvent (V.EvKey (V.KChar 'x') [V.MCtrl]) ->             -- Toggle out of the interpreter.             leaveInterpreter@@ -131,6 +150,8 @@                     B.put (Lens.set (appInterpState . AIS.viewLock) True appState)                 else -- Also toggle out of the interpreter.                     leaveInterpreter++        -- Selecting previous commands.         B.VtyEvent (V.EvKey V.KUp _) -> do             let maybeStoreBuffer s =                     if not (AIS.isScanningHist (getAis s))@@ -162,6 +183,8 @@                         . Lens.over appInterpState AIS.futHistoryPos -- Go forward in time.                         $ appState             B.put appState'++        -- Scrolling back through the logs.         B.VtyEvent (V.EvKey V.KPageDown _) ->             B.vScrollPage (B.viewportScroll LiveInterpreterViewport) B.Down         B.VtyEvent (V.EvKey V.KPageUp _) -> do@@ -203,6 +226,59 @@     replaceCommandBufferWithHist s@AppState{_appInterpState} = replaceCommandBuffer cmd s       where         cmd = T.unlines . getCommandAtHist (AIS.historyPos _appInterpState) $ s++appendToLogs+    :: [T.Text]+    -- ^ Logs between commands.+    -> T.Text+    -- ^ The command sent to produce the logs.+    -> AppState n+    -- ^ State to update.+    -> AppState n+    -- ^ Updated state.+appendToLogs logs promptEntry state = state{interpLogs = take interpreterLogLimit combinedLogs}+  where+    combinedLogs = reverse logs <> (formattedWithPrompt : interpLogs state)+    formattedWithPrompt = getInterpreterPrompt (appConfig state) <> promptEntry+    -- TODO: Should be configurable?+    interpreterLogLimit = 1000++-- | Reflow entries of text into columns.+reflowText+    :: Int+    -- ^ Num columns+    -> Int+    -- ^ Column width+    -> [T.Text]+    -- ^ Text entries to reflow+    -> [T.Text]+    -- ^ Reflowed lines.+reflowText numCols colWidth = go+  where+    go :: [T.Text] -> [T.Text]+    go [] = []+    go entries' = makeLine toMakeLine : go rest+      where+        (toMakeLine, rest) = splitAt numCols entries'+    maxTextLen = colWidth - 1+    makeLine xs = T.concat (T.justifyLeft colWidth ' ' . shortenText maxTextLen <$> xs)++shortenText :: Int -> T.Text -> T.Text+shortenText maxLen text+    | len <= maxLen = text+    | otherwise = T.take (maxLen - 1) text <> "…"+  where+    len = T.length text++-- | Return the shared prefix among all the input Texts.+commonPrefixes :: [T.Text] -> T.Text+commonPrefixes [] = ""+commonPrefixes (t : ts) = foldl' folder t ts+  where+    folder :: T.Text -> T.Text -> T.Text+    folder acc t' = case T.commonPrefixes acc t' of+        Just (p, _, _) -> p+        _ -> ""  -- | Replace the command buffer with the given strings of Text. replaceCommandBuffer

@@ -45,6 +45,9 @@     , trace     , history +      -- * Tab completion+    , tabComplete+       -- * Misc     , isExecuting     , BreakpointArg (..)@@ -65,6 +68,7 @@  import Ghcitui.Ghcid.LogConfig (LogLevel (..), LogOutput (..)) import qualified Ghcitui.Ghcid.ParseContext as ParseContext+import qualified Ghcitui.Ghcid.ParseTabCompletions as ParseTabCompletions import Ghcitui.Ghcid.StartupConfig (StartupConfig) import qualified Ghcitui.Ghcid.StartupConfig as StartupConfig import qualified Ghcitui.Loc as Loc@@ -73,7 +77,7 @@ import qualified Ghcitui.Util as Util  data InterpState a = InterpState-    { _ghci :: Ghcid.Ghci+    { _ghci :: !Ghcid.Ghci     -- ^ GHCiD handle.     , func :: !(Maybe T.Text)     -- ^ Current pause position function name.@@ -81,11 +85,11 @@     -- ^ Current pause position.     , moduleFileMap :: !Loc.ModuleFileMap     -- ^ Mapping between modules and their filepaths.-    , stack :: [T.Text]+    , stack :: ![T.Text]     -- ^ Program stack (only available during tracing).-    , breakpoints :: [(Int, Loc.ModuleLoc)]+    , breakpoints :: ![(Int, Loc.ModuleLoc)]     -- ^ Currently set breakpoint locations.-    , bindings :: Either DaemonError [NameBinding.NameBinding T.Text]+    , bindings :: !(Either DaemonError [NameBinding.NameBinding T.Text])     -- ^ Current context value bindings.     , status :: !(Either T.Text a)     -- ^ IDK? I had an idea here at one point.@@ -108,7 +112,7 @@                         srcRngFmt =                             [i|{sourceRange=(#{startLine},#{startCol})-(#{endLine},#{endCol})}|]                      in [i|{func=#{func'}, filepath=#{filepath'}, #{srcRngFmt}}|]-                _ -> "<unknown pause location>" :: String+                Nothing -> "<unknown pause location>" :: String          in msg  {- | Create an empty/starting interpreter state.@@ -183,7 +187,7 @@ -- | Shut down the GHCi Daemon. quit :: InterpState a -> IO (InterpState a) quit state = do-    Ghcid.quit (state._ghci)+    Ghcid.quit state._ghci     pure state  -- | Update the interpreter state. Wrapper around other updaters.@@ -318,6 +322,31 @@ load :: (Monoid a) => FilePath -> InterpState a -> DaemonIO (InterpState a) load filepath = execMuted (T.pack $ ":load " <> filepath) +{- | Return tab completions for a given prefix.+     Analog to @:complete repl "<prefix>"@+     See https://downloads.haskell.org/ghc/latest/docs/users_guide/ghci.html#ghci-cmd-:complete+-}+tabComplete+    :: (Monoid a)+    => T.Text+    -- ^ Text (prefix) to return autocompletions of. Does not need to be escaped.+    -> InterpState a+    -- ^ Interpreter state to use.+    -> DaemonIO (InterpState a, (T.Text, [T.Text]))+    -- ^ Resulting state, the prefix, and autocompletions.+tabComplete providedPrefix state = do+    -- Tab completion expects input to be 'show'n in quotes.+    -- There's probably a better way of doing this!+    let escapedPrefix = Util.showT providedPrefix+    let cmd = ":complete repl " <> escapedPrefix+    (newState, outputLines) <- execCleaned cmd state+    (prefix, completions) <- case ParseTabCompletions.parseCompletionsWithHeader outputLines of+        Right c -> pure c+        Left (ParseTabCompletions.ParseError er) -> throwE (GenericError er)+    pure (newState, (prefix, completions))++-- -------------------------------------------------------------------------------------------------+ {- | Execute an arbitrary command, as if it was directly written in GHCi.      It is unlikely you want to call this directly, and instead want to call      one of the wrapped functions or 'execMuted' or 'execCleaned'.@@ -353,12 +382,16 @@   where     cleaner (s, ls) = (s, T.lines (ParseContext.cleanResponse ls)) +-- ------------------------------------------------------------------------------------------------+-- Breakpoint handling+-- ------------------------------------------------------------------------------------------------+ -- | Location info passed to breakpoint functions. data BreakpointArg     = -- | Location in the current file.       LocalLine !Int     | -- | Location in a module.-      ModLoc Loc.ModuleLoc+      ModLoc !Loc.ModuleLoc     deriving (Show, Eq, Ord)  -- | Toggle a breakpoint (disable/enable) at a given location.@@ -382,7 +415,9 @@             ModLoc ml -> handleModLoc ml      invalidLoc :: Loc.ModuleLoc -> Either DaemonError a-    invalidLoc ml = Left $ BreakpointError [i|Cannot locate breakpoint position '#{ml}' in module without source|]+    invalidLoc ml =+        Left $+            BreakpointError [i|Cannot locate breakpoint position '#{ml}' in module without source|]  -- | Set a breakpoint at a given line. setBreakpointLine :: (Monoid a) => BreakpointArg -> InterpState a -> DaemonIO (InterpState a)@@ -516,11 +551,11 @@ -- Misc  data DaemonError-    = GenericError T.Text-    | UpdateBindingError T.Text-    | UpdateBreakListError T.Text-    | BreakpointError T.Text-    | UpdateContextError T.Text+    = GenericError !T.Text+    | UpdateBindingError !T.Text+    | UpdateBreakListError !T.Text+    | BreakpointError !T.Text+    | UpdateContextError !T.Text     deriving (Eq, Show)  {- | An IO operation that can fail into a DaemonError.

@@ -4,4 +4,4 @@ newtype LogLevel = LogLevel Int deriving (Eq, Ord, Show)  -- | Determines where the daemon logs are written.-data LogOutput = LogOutputStdOut | LogOutputStdErr | LogOutputFile FilePath deriving (Show)+data LogOutput = LogOutputStdOut | LogOutputStdErr | LogOutputFile !FilePath deriving (Show)

@@ -27,14 +27,13 @@ import Text.Regex.TDFA (MatchResult (..), (=~~)) import qualified Text.Regex.TDFA as Regex +import Ghcitui.Ghcid.ParseError (ParseError (..)) -- Re-export. import qualified Ghcitui.Loc as Loc import Ghcitui.NameBinding import Ghcitui.Util  ghcidPrompt :: T.Text ghcidPrompt = "#~GHCID-START~#"--newtype ParseError = ParseError T.Text deriving (Show, Eq)  -- | Output record datatype for 'parseContext'. data ParseContextOut = ParseContextOut

@@ -0,0 +1,6 @@+module Ghcitui.Ghcid.ParseError (ParseError (..)) where++import qualified Data.Text as T++-- | Type to describe parsing errors.+newtype ParseError = ParseError T.Text deriving (Show, Eq)

@@ -0,0 +1,51 @@+{-# LANGUAGE QuasiQuotes #-}++module Ghcitui.Ghcid.ParseTabCompletions (ParseError (..), parseCompletionsWithHeader) where++import Control.Error (readMay)+import Data.Array ((!))+import Data.String.Interpolate (i)+import qualified Data.Text as T+import Text.Regex.TDFA (MatchResult (..), (=~~))++import Ghcitui.Ghcid.ParseError (ParseError (..)) -- Re-export.++{- | Parse a completion result which begins with a header.++    Example input:+    [ "4 4 \"hello \""+    , "\"world\""+    , "\"wyvern\""+    , "\"withers\""+    , "\"wonderbolts\""]++    See https://downloads.haskell.org/ghc/latest/docs/users_guide/ghci.html#ghci-cmd-:complete+-}+parseCompletionsWithHeader+    :: [T.Text]+    -- ^ Full :complete output to parse.+    -> Either ParseError (T.Text, [T.Text])+    -- ^ Failure message (Left) or Completion possibilities (Right)+parseCompletionsWithHeader (headerLine : rest) = do+    sharedPrefix <- eSharedPrefix+    completions <- parseCompletions rest+    pure (sharedPrefix, completions)+  where+    eSharedPrefix = case (headerLine =~~ reg :: Maybe (MatchResult T.Text)) of+        Just match -> Right (mrSubs match ! 1)+        Nothing -> Left $ ParseError [i|Failed to parse ':complete' header line: '#{headerLine}'|]+    reg = ".* \"(.*)\"$" :: T.Text+parseCompletionsWithHeader _ = Left $ ParseError "Failed to parse completions with no header line"++parseCompletions+    :: [T.Text]+    -- ^ Completion lines.+    -> Either ParseError [T.Text]+    -- ^ Completion possibilities.+parseCompletions = mapM mapper+  where+    mapper x =+        maybe+            (Left $ ParseError [i|Failed to parse ':completion' entry '#{x}'|])+            (Right . T.pack)+            (readMay . T.unpack $ x)

@@ -27,10 +27,10 @@     , getModuleOfPath     ) where +import Control.Error (headMay) import Data.Map.Strict as Map import Data.Maybe (isNothing) import qualified Data.Text as T-import Control.Error (headMay)  -- ------------------------------------------------------------------------------------------------