mirror of
https://github.com/CrystalSplitter/ghcitui.git
synced 2024-09-11 10:55:29 +03:00
Initial commit
This commit is contained in:
commit
cde9f0a7e8
35
app/BrickUI.hs
Normal file
35
app/BrickUI.hs
Normal file
@ -0,0 +1,35 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module BrickUI (launchBrick) where
|
||||
|
||||
import qualified Control.Monad (void)
|
||||
|
||||
import qualified Brick.Main as BM
|
||||
import qualified Brick.Widgets.Core as BC
|
||||
import qualified Brick.Types as BT
|
||||
import qualified Brick.AttrMap as BA
|
||||
import qualified Graphics.Vty as V
|
||||
|
||||
import Brick.Widgets.Center (center)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text
|
||||
|
||||
data AppName = GHCiTUI deriving (Eq, Show, Ord)
|
||||
|
||||
splash :: Text
|
||||
splash = Data.Text.unlines [
|
||||
""
|
||||
]
|
||||
|
||||
theApp :: BM.App Text e AppName
|
||||
theApp = BM.App { BM.appDraw = \s -> [center $ BC.txt s]
|
||||
, BM.appChooseCursor = BM.neverShowCursor
|
||||
, BM.appHandleEvent = const BM.halt
|
||||
, BM.appStartEvent = pure ()
|
||||
, BM.appAttrMap = const $ BA.attrMap V.defAttr []
|
||||
}
|
||||
|
||||
launchBrick :: IO ()
|
||||
launchBrick = do
|
||||
let initialState = "Welcome to GHCiTUI!"
|
||||
finalState <- BM.defaultMain theApp initialState
|
||||
pure ()
|
60
app/Main.hs
Normal file
60
app/Main.hs
Normal file
@ -0,0 +1,60 @@
|
||||
{-# 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
|
||||
|
||||
launch :: IO ()
|
||||
launch = do
|
||||
state <- D.startup "cabal repl" "."
|
||||
(state, _) <- D.exec state ":l app/Main.hs"
|
||||
fileRef <- loadFileSrc "app/Main.hs"
|
||||
let surroundingSrc windowSize D.InterpState{D.lineno} =
|
||||
do
|
||||
src <- readIORef fileRef
|
||||
case lineno of
|
||||
Nothing -> pure []
|
||||
Just l -> pure $ getSurroundingSrc src windowSize l
|
||||
state <- D.stepInto state "fibty 10"
|
||||
let loop s = do
|
||||
print s
|
||||
newWindow <- surroundingSrc 5 s
|
||||
newS <- D.step state
|
||||
mapM_ TextIO.putStrLn newWindow
|
||||
putStr "%% "
|
||||
SIO.hFlush SIO.stdout
|
||||
stdinLine <- getLine
|
||||
if stdinLine == "q"
|
||||
then pure ()
|
||||
else do
|
||||
(newS, msgs) <- D.exec state stdinLine
|
||||
mapM_ (putStrLn . ("OUT: " ++)) msgs
|
||||
loop newS
|
||||
loop state
|
||||
D.quit state
|
||||
pure ()
|
||||
|
||||
fibty :: Int -> Int
|
||||
fibty 1 = 0
|
||||
fibty 2 = 1
|
||||
fibty n =
|
||||
let left = fibty (n - 1)
|
||||
right = fibty (n - 2)
|
||||
in left + right
|
||||
|
||||
{-
|
||||
--> fib 5
|
||||
Stopped in Main.fib, app/Main.hs:22:9-33
|
||||
-}
|
22
assets/splash.txt
Normal file
22
assets/splash.txt
Normal file
@ -0,0 +1,22 @@
|
||||
______ __ __ ______ __
|
||||
/\ ___\ /\ \_\ \ /\ ___\ /\_\
|
||||
\#\ \__ \ \#\ __ \ \#\ \____ \#\ \
|
||||
\#\_____\ \#\_\#\_\ \#\_____\ \#\_\
|
||||
\/#####/ \/#/\/#/ \/#####/ \/#/
|
||||
______ __ __ __
|
||||
/\__ _\ /\ \/\ \ /\ \
|
||||
\/_/\ \/ \#\ \_\ \ \#\ \
|
||||
\#\_\ \#\_____\ \#\_\
|
||||
\/#/ \/#####/ \/#/
|
||||
|
||||
______ __ __ ______ __
|
||||
/\ ___\ /\ \_\ \ /\ ___\ /\_\
|
||||
___\#\ \__ \_\#\ __ \_\#\ \_____\#\ \___
|
||||
\ \#\_____\ \#\_\#\_\ \#\_____\ \#\_\ \
|
||||
\ \/#####/ \/#/\/#/ \/#####/ \/#/ \
|
||||
\ ______ __ __ __ \
|
||||
\ /\__ _\ /\ \/\ \ /\ \ \
|
||||
\________\/_/\ \/_\#\ \_\ \_\#\ \________\
|
||||
\#\_\ \#\_____\ \#\_\
|
||||
\/#/ \/#####/ \/#/
|
||||
|
56
ghcitui.cabal
Normal file
56
ghcitui.cabal
Normal file
@ -0,0 +1,56 @@
|
||||
cabal-version: 2.4
|
||||
name: ghcitui
|
||||
version: 0.1.0.0
|
||||
|
||||
-- A short (one-line) description of the package.
|
||||
-- synopsis:
|
||||
|
||||
-- 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
|
||||
maintainer: gamewhizzit@gmail.com
|
||||
|
||||
-- A copyright notice.
|
||||
-- copyright:
|
||||
-- category:
|
||||
extra-source-files: CHANGELOG.md
|
||||
|
||||
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
|
||||
, brick
|
||||
, text
|
||||
, ghcitui
|
||||
, vty
|
||||
hs-source-dirs: app
|
||||
other-modules: BrickUI
|
||||
ghc-options: -threaded -rtsopts
|
||||
default-language: Haskell2010
|
||||
|
||||
library
|
||||
hs-source-dirs: lib
|
||||
build-depends: base ^>= 4.17
|
||||
, ghcid ^>= 0.8.8
|
||||
, containers ^>= 0.6
|
||||
, 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
|
130
lib/Daemon.hs
Normal file
130
lib/Daemon.hs
Normal file
@ -0,0 +1,130 @@
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE InstanceSigs #-}
|
||||
{-# LANGUAGE OverloadedRecordDot #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE RecordPuns #-}
|
||||
|
||||
module Daemon
|
||||
( CodeLine (..)
|
||||
, startup
|
||||
, exec
|
||||
, step
|
||||
, stepInto
|
||||
, setBreakpointLine
|
||||
, quit
|
||||
, InterpState (..)
|
||||
, continue
|
||||
) where
|
||||
|
||||
import Data.Maybe (catMaybes, isJust)
|
||||
import Data.String.Interpolate (i)
|
||||
import qualified Data.Text as Text
|
||||
import Debug.Trace
|
||||
import qualified Language.Haskell.Ghcid as Ghcid
|
||||
|
||||
import qualified ParseContext as PC (ParseContextOut (..), linesToText, parseContext)
|
||||
|
||||
data InterpState a = InterpState
|
||||
{ _ghci :: Ghcid.Ghci
|
||||
, func :: Maybe Text.Text
|
||||
, filepath :: Maybe FilePath
|
||||
, lineno :: Maybe Int
|
||||
, colrange :: (Maybe Int, Maybe Int)
|
||||
, stack :: [String]
|
||||
, breakpoints :: [CodeLine]
|
||||
, status :: Either Text.Text a
|
||||
}
|
||||
|
||||
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'}"}|]
|
||||
|
||||
emptyInterpreterState :: (Monoid a) => Ghcid.Ghci -> InterpState a
|
||||
emptyInterpreterState ghci =
|
||||
InterpState
|
||||
{ _ghci = ghci
|
||||
, func = Nothing
|
||||
, filepath = Nothing
|
||||
, lineno = Nothing
|
||||
, colrange = (Nothing, Nothing)
|
||||
, stack = []
|
||||
, breakpoints = []
|
||||
, status = Right mempty
|
||||
}
|
||||
|
||||
startup :: String -> FilePath -> IO (InterpState ())
|
||||
startup cmd pwd = do
|
||||
(ghci, loadingMsgs) <- Ghcid.startGhci cmd (Just pwd) (\_ _ -> pure ())
|
||||
pure $ emptyInterpreterState ghci
|
||||
|
||||
quit :: InterpState a -> IO (InterpState a)
|
||||
quit state = do
|
||||
Ghcid.quit (state._ghci)
|
||||
pure state
|
||||
|
||||
updateState :: (Monoid a) => InterpState a -> IO (InterpState a)
|
||||
updateState state@InterpState{_ghci} = do
|
||||
contextLines <- Ghcid.exec _ghci ":show context"
|
||||
if null contextLines
|
||||
then do
|
||||
pure (emptyInterpreterState _ghci) -- We exited everything.
|
||||
else do
|
||||
let out = PC.parseContext (PC.linesToText contextLines)
|
||||
pure
|
||||
state
|
||||
{ func = out.func
|
||||
, filepath = out.filepath
|
||||
, lineno = out.lineno
|
||||
, colrange = out.colrange
|
||||
}
|
||||
|
||||
step :: (Monoid a) => InterpState a -> IO (InterpState a)
|
||||
step state = execMuted state ":step"
|
||||
|
||||
stepInto :: (Monoid a) => InterpState a -> String -> IO (InterpState a)
|
||||
stepInto state func = execMuted state (":step " ++ func)
|
||||
|
||||
continue :: (Monoid a) => InterpState a -> IO (InterpState a)
|
||||
continue state = execMuted state ":continue"
|
||||
|
||||
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)
|
||||
|
||||
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
|
||||
}
|
||||
|
||||
setBreakpointLine :: (Monoid a) => InterpState a -> CodeLine -> IO (InterpState a)
|
||||
setBreakpointLine state loc = do
|
||||
(newState, _) <- exec state command
|
||||
pure newState
|
||||
where
|
||||
command =
|
||||
":break " ++ case loc of
|
||||
LocalLine pos -> show pos
|
||||
ModuleLine (Just mod') pos (Just colno) ->
|
||||
show mod' ++ show pos ++ show colno
|
||||
ModuleLine (Just mod') pos Nothing ->
|
||||
show mod' ++ show pos
|
||||
ModuleLine Nothing pos Nothing ->
|
||||
show pos
|
||||
ModuleLine Nothing pos (Just colno) ->
|
||||
show pos ++ show colno
|
62
lib/ParseContext.hs
Normal file
62
lib/ParseContext.hs
Normal file
@ -0,0 +1,62 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module ParseContext (ParseContextOut (..), linesToText, parseContext) where
|
||||
|
||||
import Data.Functor ((<&>))
|
||||
import Data.Maybe (fromJust, isJust)
|
||||
import Data.Text (Text, dropWhileEnd, pack, stripStart, unpack)
|
||||
import Safe
|
||||
import Text.Regex.TDFA ((=~~))
|
||||
|
||||
import StringUtil
|
||||
import Text.Read (readMaybe)
|
||||
|
||||
import Debug.Trace
|
||||
|
||||
ghcidPrompt :: Text
|
||||
ghcidPrompt = "#~GHCID-START~#"
|
||||
|
||||
linesToText :: [String] -> Text
|
||||
linesToText = pack . unlines
|
||||
|
||||
data ParseContextOut = ParseContextOut
|
||||
{ func :: Maybe Text
|
||||
, filepath :: Maybe FilePath
|
||||
, lineno :: Maybe Int
|
||||
, colrange :: (Maybe Int, Maybe Int)
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
parseContext :: Text -> ParseContextOut
|
||||
parseContext contextText =
|
||||
let splits = splitBy ghcidPrompt contextText
|
||||
stopReg :: Text -> [Text]
|
||||
stopReg s = s =~~ ("[ \t^]Stopped in ([[:alnum:]_.]+),.*" :: Text)
|
||||
infoLine :: Maybe Text
|
||||
infoLine =
|
||||
stripStart
|
||||
<$> foldr
|
||||
(\next acc -> if isJust next then next else acc)
|
||||
Nothing
|
||||
(headMay . stopReg <$> splits)
|
||||
myFunc :: Maybe Text
|
||||
myFunc = infoLine >>= (\x -> splitBy " " x `atMay` 2) <&> dropWhileEnd (`elem` [',', ' '])
|
||||
myFile :: Maybe FilePath
|
||||
myFile =
|
||||
infoLine
|
||||
>>= headMay . splitBy ":"
|
||||
>>= (\x -> splitBy ", " x `atMay` 1)
|
||||
<&> unpack
|
||||
myLineno :: Maybe Int
|
||||
myLineno = infoLine >>= (\x -> splitBy ":" x `atMay` 1) <&> read . unpack
|
||||
myColRange :: (Maybe Int, Maybe Int)
|
||||
myColRange =
|
||||
let colField = infoLine >>= (\x -> splitBy ":" x `atMay` 2)
|
||||
-- | Parse the column field entries out.
|
||||
getCol :: Int -> Maybe Int
|
||||
getCol idx =
|
||||
colField
|
||||
>>= (\x -> splitBy "-" x `atMay` idx)
|
||||
>>= readMaybe . unpack
|
||||
in trace (unpack $ fromJust infoLine) (getCol 0, getCol 1)
|
||||
in ParseContextOut myFunc myFile myLineno myColRange
|
12
lib/StringUtil.hs
Normal file
12
lib/StringUtil.hs
Normal file
@ -0,0 +1,12 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module StringUtil (splitBy) where
|
||||
|
||||
import Data.Text (Text, breakOn, drop, length, pack)
|
||||
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)
|
37
lib/Tui.hs
Normal file
37
lib/Tui.hs
Normal file
@ -0,0 +1,37 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Tui (loadFileSrc, getSurroundingSrc) where
|
||||
|
||||
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
|
||||
IORef.newIORef txt
|
||||
|
||||
getSurroundingSrc
|
||||
:: Text
|
||||
-- ^ Source code as single Text
|
||||
-> Int
|
||||
-- ^ Window y size.
|
||||
-> Int
|
||||
-- ^ Cursor location
|
||||
-> [Text]
|
||||
-- ^ Window lines
|
||||
getSurroundingSrc fileContents ySize location =
|
||||
let
|
||||
addMarker :: Int -> [Text] -> [Text]
|
||||
addMarker loc = zipWith (\idx val -> if idx == loc then "| > " `append` val else "| " `append` val) [0 ..]
|
||||
loc1 = location - 1
|
||||
splitLines = lines fileContents
|
||||
lineCount = length splitLines
|
||||
beforeLineCount = max 0 (loc1 - (ySize `div` 2))
|
||||
afterLineCount = min (lineCount - loc1) ySize
|
||||
in
|
||||
(take afterLineCount . drop beforeLineCount . addMarker loc1) splitLines
|
Loading…
Reference in New Issue
Block a user