CrystalSplitter/ghcitui
1
1
Fork 0
mirror of https://github.com/CrystalSplitter/ghcitui.git synced 2024-11-22 06:32:37 +03:00
Code Issues Packages Projects Releases Wiki Activity

Some more early development

Browse Source
This commit is contained in:
CrystalSplitter 2023-06-06 22:19:12 -07:00
parent 39af025aa7
commit 871f284e82
13 changed files with 345 additions and 162 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
CHANGELOG.md Normal file
View File

@ -0,0 +1,5 @@
# Revision history for ghcitui
## 0.1.0.0 -- YYYY-mm-dd
* First version. Released on an unsuspecting world.

67
CONTRIBUTING.md Normal file
View File

@ -0,0 +1,67 @@
# Contributing
We're open to contributions! You can help by filing issues and making
pull requsets.
## Style
This project is auto-formatted currently by Fourmolu, with settings specified in
[fourmolu.yaml](./fourmolu.yaml). This is subject to change.
This project roughly tries to follow the
[Kowainik Style guide](https://kowainik.github.io/posts/2019-02-06-style-guide).
Though there are some notable diverges, some of which are listed below.
### Divergences
- Try to limit lines to 100 characters, but no _hard_ limit.
- Let the auto-formatter handle spacing/alignment.
## Code of Conduct
> _This is a slightly simplified version of the Contributor Covenant Code of Conduct (see_
> _Attribution)_
We as contributors promise to make this repository a
welcoming and inclusive space for everyone, regardless of age, body, visible
or invisible disability, ethnicity, sex or sex characteristics, gender
identity, gender expression, level of experience, education, socio-economic
status, nationality, race, caste, colour, religion, sexual identity, and sexual
orientation.
We as a contributor are expected to:
- Show empathy and kindness to others
- Be respectful of differing opinions and experiences,
- Give and gracefully accep feedback
- Respect artist wishes at all times (particularly in regards to distribution terms and conditions)
- Focusing on what is best not just for us as individuals, but for the overall community
Examples of unacceptable behavior include:
- The use of sexualized language or imagery, and sexual attention or advances of any kind
- Trolling, insulting or derogatory comments, and personal or political attacks
- Public or private harassment
- Publishing others’ private information, such as a physical address or email address,
without their explicit permission
- Other conduct which could reasonably be considered inappropriate in a professional setting
## Enforcement
If it's determined by the project leaders that a member of the community has violated the
above expectations for a contributor, then these leaders may impose an indefinite ban on that
member of the community.
Project leaders have the right and responsibility to review, edit, or deny any contributions which
violate or are not aligned with this Code of Conduct.
## Scope
This code of conduct applies to all contributors and potential contributors to
this project, as well as individuals acting as
representatives of this project or the community.
## Attribution
This code of conduct was partially adapted from the
[Contributor Covenant version 2.1](https://www.contributor-covenant.org/version/2/1/code_of_conduct.html).

26
LICENSE Normal file
View File

@ -0,0 +1,26 @@
Copyright 2023 Jordan 'Crystal' R AW
Redistribution and use in source and binary forms, with or without modification,
are permitted provided that the following conditions are met:
1. Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation and/or
other materials provided with the distribution.
3. Neither the name of the copyright holder nor the names of its contributors
may be used to endorse or promote products derived from this software without
specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

5
README.md Normal file
View File

@ -0,0 +1,5 @@
# GHCiTUI: Interactive terminal interface for the Glasgow Haskell Compiler
This is a current work in progress of a front-end terminal interface for
`ghci`. It provides a source viewer, keybindings, an interactive
interpreter, and a local context viewer.

154
app/BrickUI.hs
View File

@ -1,5 +1,4 @@
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
module BrickUI
@ -18,24 +17,30 @@ import Data.Text (Text, append, pack)
import qualified Data.Text
import qualified Data.Text.IO
import qualified Graphics.Vty as V
import Safe
import Safe (atMay)
import qualified Daemon
data AppName = GHCiTUI | CodeViewport deriving (Eq, Show, Ord)
data AppName = GHCiTUI | CodeViewport | LiveInterpreter deriving (Eq, Show, Ord)
-- | Application state wrapper
data AppState = AppState
{ interpState :: Daemon.InterpState ()
, sourceMap :: Map.Map FilePath Text
-- ^ Mapping between source filepaths and their contents.
, appStateConfig :: AppStateConfig
-- ^ Program launch configuration
, splashContents :: Maybe Text
}
-- | Update the source map given any app state changes.
updateSourceMap :: AppState -> IO AppState
updateSourceMap s =
case s.interpState.filepath of
case s.interpState.pauseLoc.filepath of
Nothing -> pure s
(Just filepath) -> updateSourceMapWithFilepath s filepath
-- | Update the source map with a given filepath.
updateSourceMapWithFilepath :: AppState -> FilePath -> IO AppState
updateSourceMapWithFilepath s filepath
| Map.member filepath s.sourceMap = pure s
@ -46,71 +51,117 @@ updateSourceMapWithFilepath s filepath
appDraw :: AppState -> [B.Widget AppName]
appDraw s =
[ B.borderWithLabel
(B.txt ("Source: " `append` maybe "?" pack (s.interpState.filepath)))
( B.withVScrollBars
B.OnRight
( B.viewport
CodeViewport
B.Vertical
( B.padRight B.Max (makeCodeViewportBoxes s)
[ ( B.borderWithLabel
(B.txt ("Source: " `append` maybe "?" pack (s.interpState.pauseLoc.filepath)))
( B.withVScrollBars
B.OnRight
( B.viewport
CodeViewport
B.Vertical
( B.padRight B.Max (makeCodeViewport s)
)
)
)
-- TODO: Make this an editor viewport.
<=> B.borderWithLabel
(B.txt "Interpreter")
(B.padRight B.Max (B.txt " >>> "))
)
-- TODO: Make this an expandable viewport, maybe?
<+> B.borderWithLabel
(B.txt "Info")
( B.padBottom
B.Max
( B.padLeft
(B.Pad 20)
(B.txt " ") -- Important that there's a space here for padding.
)
)
)
<=> B.borderWithLabel
(B.txt "Interpreter")
(B.padRight B.Max (B.txt ">>> "))
]
prefixLine :: Int -> B.Widget n -> (Int, B.Widget n) -> B.Widget n
prefixLine digitWidth prefix (idx, lineWidget) =
B.withAttr
(B.attrName "line-numbers")
(B.txt (formatDigits digitWidth idx))
<+> prefix
<+> lineWidget
data GutterInfo = GutterInfo
{ isStoppedHere :: !Bool
, isBreakpoint :: !Bool
, gutterLineNumber :: !Int
, gutterDigitWidth :: !Int
}
makeCodeViewportBoxes :: AppState -> B.Widget AppName
makeCodeViewportBoxes s =
case (s.interpState.filepath >>= (s.sourceMap Map.!?) :: Maybe Text) of
Nothing -> B.txt "No source file loaded"
-- | Prepend gutter information on each line in the primary viewport.
prependGutter :: GutterInfo -> B.Widget n -> B.Widget n
prependGutter gi line = makeGutter gi <+> line
-- | Prepend gutter information on each line in the primary viewport.
makeGutter :: GutterInfo -> B.Widget n
makeGutter GutterInfo{..} = lineNoWidget <+> emptyW <+> breakColumn <+> stopColumn <+> emptyW
where
emptyW = B.txt " "
lineNoWidget =
B.withAttr
(B.attrName "line-numbers")
(B.txt (formatDigits gutterDigitWidth gutterLineNumber))
breakColumn
| isBreakpoint =
B.withAttr
(B.attrName "breakpoint-marker")
(B.txt "@")
| otherwise = emptyW
stopColumn
| isStoppedHere = B.withAttr (B.attrName "stop-line") (B.txt ">")
| otherwise = emptyW
-- | Make the primary viewport widget.
makeCodeViewport :: AppState -> B.Widget AppName
makeCodeViewport s =
case (s.interpState.pauseLoc.filepath >>= (s.sourceMap Map.!?) :: Maybe Text) of
Nothing ->
B.padTop (B.Pad 3) $
B.hCenter $
B.withAttr (B.attrName "styled") $
maybe (B.txt "No source file loaded") B.txt s.splashContents
Just sourceData ->
let
splitSourceData = Data.Text.lines sourceData
prefixLine' = prefixLine (getNumDigits (length splitSourceData))
originalLookupLineNo = fromMaybe (-1) s.interpState.lineno - 1
gutterInfoForLine lineno =
GutterInfo
{ isStoppedHere = Just lineno == s.interpState.pauseLoc.lineno
, isBreakpoint = lineno `elem` Daemon.getBpInCurFile s.interpState
, gutterLineNumber = lineno
, gutterDigitWidth = getNumDigits $ length splitSourceData
}
prefixLineDefault' (lineno, w) =
prependGutter
(gutterInfoForLine lineno)
w
originalLookupLineNo = fromMaybe (-1) s.interpState.pauseLoc.lineno - 1
-- Original Line of Interest
originalloi =
Data.Text.lines sourceData `atMay` originalLookupLineNo
theLineWidget :: Maybe (B.Widget AppName)
theLineWidget =
( \x ->
let lineWidget = makeLineWidget x s.interpState.colrange
in prefixLine' (B.withAttr (B.attrName "stop-line") $ B.txt " > ") (originalLookupLineNo + 1, lineWidget)
)
<$> originalloi
stoppedLineW :: Text -> B.Widget AppName
stoppedLineW lineTxt =
let lineWidget = makeStoppedLineWidget lineTxt s.interpState.pauseLoc.colrange
in prependGutter (gutterInfoForLine (originalLookupLineNo + 1)) lineWidget
-- Surrounding lines in the viewport
beforeLines =
case s.interpState.lineno of
case s.interpState.pauseLoc.lineno of
Nothing -> mempty
Just lineno ->
prefixLine' (B.txt " ")
prefixLineDefault'
<$> zip
[1 ..]
(B.txt <$> take (max 0 (lineno - 1)) splitSourceData)
afterLines =
case s.interpState.lineno of
case s.interpState.pauseLoc.lineno of
Nothing -> B.txt <$> Data.Text.lines sourceData
Just lineno ->
prefixLine' (B.txt " ")
prefixLineDefault'
<$> zip
[originalLookupLineNo + 2 ..]
(B.txt <$> drop lineno splitSourceData)
composedTogether =
case theLineWidget of
case stoppedLineW <$> originalloi of
Nothing -> B.vBox afterLines
Just w ->
B.vBox beforeLines
@ -119,12 +170,13 @@ makeCodeViewportBoxes s =
in
composedTogether
makeLineWidget :: Text -> (Maybe Int, Maybe Int) -> B.Widget AppName
makeLineWidget lineData (Nothing, _) =
-- | Make the Stopped Line widget (the line where we paused execution)
makeStoppedLineWidget :: Text -> (Maybe Int, Maybe Int) -> B.Widget AppName
makeStoppedLineWidget lineData (Nothing, _) =
B.withAttr (B.attrName "stop-line") (B.txt lineData)
makeLineWidget lineData (Just startCol, Nothing) =
makeLineWidget lineData (Just startCol, Just (startCol + 1))
makeLineWidget lineData (Just startCol, Just endCol) =
makeStoppedLineWidget lineData (Just startCol, Nothing) =
makeStoppedLineWidget lineData (Just startCol, Just (startCol + 1))
makeStoppedLineWidget lineData (Just startCol, Just endCol) =
let (lineDataBefore, partial) = Data.Text.splitAt (startCol - 1) lineData
(lineDataRange, lineDataAfter) = Data.Text.splitAt (endCol - startCol + 1) partial
in B.withAttr
@ -186,6 +238,7 @@ handleEvent ev =
pure ()
_ -> pure ()
-- | Brick main program.
brickApp :: B.App AppState e AppName
brickApp =
B.App
@ -200,28 +253,33 @@ brickApp =
[ (B.attrName "stop-line", B.fg V.red)
, (B.attrName "line-numbers", B.fg V.cyan)
, (B.attrName "underline", V.currentAttr `V.withStyle` V.underline)
, (B.attrName "styled", B.fg V.magenta)
]
}
type Command = String
data AppStateConfig = AppStateConfig
newtype AppStateConfig = AppStateConfig
{ startupSplashPath :: FilePath
}
-- TODO: This should not be hardcoded for debugging.
makeInitialState :: AppStateConfig -> Command -> IO AppState
makeInitialState config cmd = do
interpState <-
Daemon.startup cmd "."
>>= flip Daemon.load "app/Main.hs"
>>= flip Daemon.stepInto "fibty 10"
splashContents <- Data.Text.IO.readFile config.startupSplashPath
pure $
AppState
{ interpState
, sourceMap = mempty
, appStateConfig = config
, splashContents = Just splashContents
}
-- | Start the Brick UI
launchBrick :: IO ()
launchBrick = do
let commandType = "cabal" :: Command
@ -229,5 +287,5 @@ launchBrick = do
"cabal" -> "cabal v2-repl ghcitui"
_ -> error "Not a supported command type"
initialState <- makeInitialState (AppStateConfig "assets/splash.txt") cmd
finalState <- B.defaultMain brickApp initialState
_ <- B.defaultMain brickApp initialState
pure ()

21
app/Main.hs
View File

@ -1,20 +1,9 @@
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedRecordDot #-}
module Main where
import Control.Monad (unless)
import Data.IORef (readIORef)
import qualified Data.Text.IO as TextIO
import System.IO as SIO
import BrickUI (launchBrick)
import qualified Daemon as D
import Tui (getSurroundingSrc, loadFileSrc)
main :: IO ()
main = launchBrick
{-
Old code for reference.
launch :: IO ()
launch = do
@ -45,6 +34,7 @@ launch = do
loop state
D.quit state
pure ()
-}
fibty :: Int -> Int
fibty 1 = 0
@ -52,4 +42,7 @@ fibty 2 = 1
fibty n =
let left = fibty (n - 1)
right = fibty (n - 2)
in left + right
in left + right
main :: IO ()
main = launchBrick

24
assets/splash.txt
View File

@ -1,22 +1,10 @@
______ __ __ ______ __
/\ ___\ /\ \_\ \ /\ ___\ /\_\
\#\ \__ \ \#\ __ \ \#\ \____ \#\ \
\#\_____\ \#\_\#\_\ \#\_____\ \#\_\
\/#####/ \/#/\/#/ \/#####/ \/#/
______ __ __ __
/\__ _\ /\ \/\ \ /\ \
\/_/\ \/ \#\ \_\ \ \#\ \
\#\_\ \#\_____\ \#\_\
\/#/ \/#####/ \/#/
______ __ __ ______ __
/\ ___\ /\ \_\ \ /\ ___\ /\_\
___\#\ \__ \_\#\ __ \_\#\ \_____\#\ \___
\ \#\_____\ \#\_\#\_\ \#\_____\ \#\_\ \
\ \/#####/ \/#/\/#/ \/#####/ \/#/ \
___\ \ \__ \_\ \ __ \_\ \ \_____\ \ \___
\ \ \_____\ \ \_\ \_\ \ \_____\ \ \_\ \
\ \/_____/ \/_/\/_/ \/_____/ \/_/ \
\ ______ __ __ __ \
\ /\__ _\ /\ \/\ \ /\ \ \
\________\/_/\ \/_\#\ \_\ \_\#\ \________\
\#\_\ \#\_____\ \#\_\
\/#/ \/#####/ \/#/
\________\/_/\ \/_\ \ \_\ \_\ \ \________\
\ \_\ \ \_____\ \ \_\
\/_/ \/_____/ \/_/

10
assets/splash_alt.txt Normal file
View File

@ -0,0 +1,10 @@
______ __ __ ______ __
/\ ___\ /\ \_\ \ /\ ___\ /\_\
\#\ \__ \ \#\ __ \ \#\ \____ \#\ \
\#\_____\ \#\_\#\_\ \#\_____\ \#\_\
\/#####/ \/#/\/#/ \/#####/ \/#/
______ __ __ __
/\__ _\ /\ \/\ \ /\ \
\/_/\ \/ \#\ \_\ \ \#\ \
\#\_\ \#\_____\ \#\_\
\/#/ \/#####/ \/#/

91
ghcitui.cabal
View File

@ -1,57 +1,70 @@
cabal-version: 2.4
name: ghcitui
version: 0.1.0.0
-- A short (one-line) description of the package.
-- synopsis:
synopsis: A Terminal User Interface (TUI) for GHCi
-- A longer description of the package.
-- description:
-- A URL where users can report bugs.
-- bug-reports:
-- The license under which the package is released.
-- license:
author: CrystalSplitter
license: BSD-3-Clause
author: Jordan 'CrystalSplitter' R AW
maintainer: gamewhizzit@gmail.com
-- A copyright notice.
-- copyright:
-- category:
extra-source-files: CHANGELOG.md
, LICENSE
executable ghcitui
main-is: Main.hs
-- Modules included in this executable, other than Main.
-- other-modules:
-- LANGUAGE extensions used by modules in this package.
-- other-extensions:
build-depends: base ^>= 4.17
, containers ^>= 0.6.7
, brick
, text
, ghcituilib
, vty
, safe
hs-source-dirs: app
other-modules: BrickUI
ghc-options: -Wall -threaded -rtsopts
default-language: Haskell2010
main-is: Main.hs
build-depends: base ^>= 4.17
, containers ^>= 0.6.7
, brick
, text
, ghcituilib
, vty
, safe
hs-source-dirs: app
other-modules: BrickUI
ghc-options: -rtsopts
-threaded
-Wall
-Wcompat
-Wincomplete-record-updates
-Wpartial-fields
-Wredundant-constraints
default-language: Haskell2010
default-extensions: OverloadedRecordDot
DuplicateRecordFields
OverloadedStrings
RecordWildCards
library ghcituilib
hs-source-dirs: lib
build-depends: base ^>= 4.17
, ghcid ^>= 0.8.8
, containers ^>= 0.6.7
, text
, regex-tdfa ^>= 1.3.2.1
, regex-base ^>= 0.94.0.2
, safe ^>= 0.3.19
, string-interpolate ^>= 0.3.2.1
exposed-modules: Daemon, Tui
other-modules: ParseContext, StringUtil
ghc-options: -Wall
default-language: Haskell2010
hs-source-dirs: lib
build-depends: base ^>= 4.17
, ghcid ^>= 0.8.8
, containers ^>= 0.6.7
, text
, regex-tdfa ^>= 1.3.2.1
, regex-base ^>= 0.94.0.2
, safe ^>= 0.3.19
, string-interpolate ^>= 0.3.2.1
exposed-modules: Daemon
, Tui
other-modules: ParseContext
, StringUtil
ghc-options: -rtsopts
-threaded
-Wall
-Wcompat
-Wincomplete-record-updates
-Wpartial-fields
-Wredundant-constraints
default-language: Haskell2010
default-extensions: OverloadedRecordDot
DuplicateRecordFields
OverloadedStrings
RecordWildCards

78
lib/Daemon.hs
View File

@ -1,17 +1,15 @@
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE QuasiQuotes #-}
module Daemon
( CodeLine (..)
( ModuleLoc (..)
, startup
, exec
, step
, stepInto
, setBreakpointLine
, getBpInCurFile
, getBpInFile
, quit
, InterpState (..)
, emptyInterpreterState
@ -24,35 +22,35 @@ import qualified Data.Text as Text
import qualified Language.Haskell.Ghcid as Ghcid
import qualified ParseContext as PC (ParseContextOut (..), linesToText, parseContext)
import Data.Maybe (catMaybes)
data InterpState a = InterpState
{ _ghci :: Ghcid.Ghci
-- ^ GHCID handle
, func :: Maybe Text.Text
, filepath :: Maybe FilePath
, lineno :: Maybe Int
, colrange :: (Maybe Int, Maybe Int)
-- ^ Current pause position function name.
, pauseLoc :: ModuleLoc
-- ^ Current pause position.
, stack :: [String]
, breakpoints :: [CodeLine]
-- ^ Program stack (only available during tracing)
, breakpoints :: [ModuleLoc]
-- ^ Currently set breakpoint locations.
, status :: Either Text.Text a
-- ^ IDK? I had an idea here at one point.
}
instance Show (InterpState a) where
show :: InterpState a -> String
show s =
let func' = show s.func
filepath' = show s.filepath
lineno' = show s.lineno
colrange' = show s.colrange
in [i|{func="#{func'}", filepath="#{filepath'}", lineno="#{lineno'}, colrange="#{colrange'}"}|]
ModuleLoc filepath' lineno' colrange' = s.pauseLoc
in [i|{func="#{func'}", filepath="#{filepath'}", lineno="#{lineno'}", colrange="#{colrange'}"}|]
emptyInterpreterState :: (Monoid a) => Ghcid.Ghci -> InterpState a
emptyInterpreterState ghci =
InterpState
{ _ghci = ghci
, func = Nothing
, filepath = Nothing
, lineno = Nothing
, colrange = (Nothing, Nothing)
, pauseLoc = ModuleLoc Nothing Nothing (Nothing, Nothing)
, stack = []
, breakpoints = []
, status = Right mempty
@ -60,7 +58,7 @@ emptyInterpreterState ghci =
startup :: String -> FilePath -> IO (InterpState ())
startup cmd pwd = do
(ghci, loadingMsgs) <- Ghcid.startGhci cmd (Just pwd) (\_ _ -> pure ())
(ghci, _) <- Ghcid.startGhci cmd (Just pwd) (\_ _ -> pure ())
pure $ emptyInterpreterState ghci
quit :: InterpState a -> IO (InterpState a)
@ -79,42 +77,55 @@ updateState state@InterpState{_ghci} = do
pure
state
{ func = out.func
, filepath = out.filepath
, lineno = out.lineno
, colrange = out.colrange
, pauseLoc = ModuleLoc out.filepath out.lineno out.colrange
}
step :: (Monoid a) => InterpState a -> IO (InterpState a)
step state = execMuted state ":step"
stepInto :: (Monoid a) => InterpState a -> String -> IO (InterpState a)
-- | Analogue to ":step <func>".
stepInto
:: (Monoid a)
=> InterpState a
-> String
-- ^ Function name to jump to
-> IO (InterpState a)
-- ^ New interpreter state
stepInto state func = execMuted state (":step " ++ func)
-- | Analogue to ":continue".
continue :: (Monoid a) => InterpState a -> IO (InterpState a)
continue state = execMuted state ":continue"
-- | Analogue to ":load <filepath>"
load :: (Monoid a) => InterpState a -> FilePath -> IO (InterpState a)
load state filepath = execMuted state (":l " ++ filepath)
-- | Execute an arbitrary command, as if it was directly written in GHCi.
exec :: (Monoid a) => InterpState a -> String -> IO (InterpState a, [String])
exec state@InterpState{_ghci} cmd = do
msgs <- Ghcid.exec _ghci cmd
newState <- updateState state
pure (newState, msgs)
-- | @exec@, but throw out any messages.
execMuted :: (Monoid a) => InterpState a -> String -> IO (InterpState a)
execMuted state cmd = do
(newState, _) <- exec state cmd
pure newState
data CodeLine
= LocalLine Int
| ModuleLine
{ mod' :: Maybe String
, lineno :: Int
, colno :: Maybe Int
}
type ColumnRange = (Maybe Int, Maybe Int)
data ModuleLoc = ModuleLoc
{ filepath :: Maybe FilePath
, lineno :: Maybe Int
, colrange :: ColumnRange
}
data CodeLine
= LocalLine !Int
| ModuleLine (Maybe String) !Int (Maybe Int)
-- | Set a breakpoint at a given line.
setBreakpointLine :: (Monoid a) => InterpState a -> CodeLine -> IO (InterpState a)
setBreakpointLine state loc = do
(newState, _) <- exec state command
@ -131,3 +142,10 @@ setBreakpointLine state loc = do
show pos
ModuleLine Nothing pos (Just colno) ->
show pos ++ show colno
getBpInCurFile :: InterpState a -> [Int]
getBpInCurFile InterpState{pauseLoc = ModuleLoc{filepath = Nothing }} = []
getBpInCurFile s@InterpState{pauseLoc = ModuleLoc{filepath = Just fp }} = getBpInFile s fp
getBpInFile :: InterpState a -> FilePath -> [Int]
getBpInFile s fp = catMaybes [loc.lineno | loc<-s.breakpoints, loc.filepath == Just fp]

10
lib/ParseContext.hs
View File

@ -1,9 +1,7 @@
{-# LANGUAGE OverloadedStrings #-}
module ParseContext (ParseContextOut (..), linesToText, parseContext) where
import Data.Functor ((<&>))
import Data.Maybe (fromJust, isJust)
import Data.Maybe (isJust)
import Data.Text (Text, dropWhileEnd, pack, stripStart, unpack)
import Safe
import Text.Regex.TDFA ((=~~))
@ -11,14 +9,13 @@ import Text.Regex.TDFA ((=~~))
import StringUtil
import Text.Read (readMaybe)
import Debug.Trace
ghcidPrompt :: Text
ghcidPrompt = "#~GHCID-START~#"
linesToText :: [String] -> Text
linesToText = pack . unlines
-- | Output record datatype for @parseContext@.
data ParseContextOut = ParseContextOut
{ func :: Maybe Text
, filepath :: Maybe FilePath
@ -27,6 +24,7 @@ data ParseContextOut = ParseContextOut
}
deriving (Show)
-- | Parse the output from ":show context" for the interpreter state.
parseContext :: Text -> ParseContextOut
parseContext contextText =
let splits = splitBy ghcidPrompt contextText
@ -59,4 +57,4 @@ parseContext contextText =
>>= (\x -> splitBy "-" x `atMay` idx)
>>= readMaybe . unpack
in (getCol 0, getCol 1)
in ParseContextOut myFunc myFile myLineno myColRange
in ParseContextOut myFunc myFile myLineno myColRange

6
lib/StringUtil.hs
View File

@ -1,12 +1,10 @@
{-# LANGUAGE OverloadedStrings #-}
module StringUtil (splitBy) where
import Data.Text (Text, breakOn, drop, length, pack)
import Data.Text (Text, breakOn, drop, length)
import Prelude hiding (drop, length)
splitBy :: Text -> Text -> [Text]
splitBy delim source =
case breakOn delim source of
(l, "") -> [l]
(l, r) -> l : splitBy delim (drop (length delim) r)
(l, r) -> l : splitBy delim (drop (length delim) r)

10
lib/Tui.hs
View File

@ -2,14 +2,18 @@
module Tui (loadFileSrc, getSurroundingSrc) where
{-
This file probably either doesn't need to exist, or should be merged with
BrickUI.hs
-}
import qualified Data.IORef as IORef
import Data.Text (Text, append, lines)
import Data.Text.IO (readFile)
import Safe
import Prelude hiding (lines, readFile)
import Debug.Trace
loadFileSrc :: FilePath -> IO (IORef.IORef Text)
loadFileSrc fp = do
txt <- readFile fp