The interpreter commit

app/AppState.hs

@@ -0,0 +1,139 @@
+{-# LANGUAGE NamedFieldPuns #-}
+
+module AppState (
+    ActiveWindow(..)
+    , AppConfig(..)
+    , AppState(..)
+    , getSourceContents
+    , updateSourceMap
+    , liveEditorLens
+    , resetSelectedLine
+    , makeInitialState
+    , AppStateConfig(..)
+    , toggleActiveLineInterpreter
+    , toggleBreakpointLine
+    ) where
+
+import qualified Brick.Widgets.Edit as BE
+import qualified Data.Map.Strict as Map
+import Data.Maybe (fromMaybe)
+import Data.Text (Text)
+import qualified Data.Text.IO
+import qualified Lens.Micro as Lens
+
+import AppTopLevel (AppName (..), Command)
+import qualified Daemon
+import qualified Loc
+import Daemon (toggleBreakpointLine)
+
+data ActiveWindow = ActiveCodeViewport | ActiveLiveInterpreter | ActiveInfoWindow
+    deriving (Show, Eq, Ord)
+
+newtype AppConfig = AppConfig
+    { interpreterPrompt :: Text
+    -- ^ Prompt to show for the live interpreter.
+    } deriving (Eq, Show)
+
+-- | Application state wrapper
+data AppState n = AppState
+    { interpState :: Daemon.InterpState ()
+    , liveEditor :: BE.Editor Text n
+    , interpLogs :: [Text]
+    , appConfig :: AppConfig
+    -- ^ The interpreter handle.
+    , activeWindow :: ActiveWindow
+    -- ^ Currently active interpreter.
+    , selectedFile :: Maybe FilePath
+    -- ^ Filepath to the current code viewport contents, if set.
+    , selectedLine :: Int
+    -- ^ Currently selected line number. Resets back to 1.
+    , sourceMap :: Map.Map FilePath Text
+    -- ^ Mapping between source filepaths and their contents.
+    , appStateConfig :: AppStateConfig
+    -- ^ Program launch configuration.
+    , displayDebugConsoleLogs :: Bool
+    -- ^ Whether to display debug Console logs.
+    , debugConsoleLogs :: [Text]
+    -- ^ Place for debug output to go.
+    , splashContents :: !(Maybe Text)
+    -- ^ Splash to show on start up.
+    }
+
+-- | Lens wrapper for zooming with handleEditorEvent.
+liveEditorLens :: Lens.Lens' (AppState n) (BE.Editor Text n)
+liveEditorLens = Lens.lens liveEditor (\s newEditor -> s{liveEditor = newEditor})
+
+toggleActiveLineInterpreter :: AppState n -> AppState n
+toggleActiveLineInterpreter s@AppState{activeWindow} =
+    s{activeWindow = toggleLogic activeWindow}
+  where
+    toggleLogic ActiveLiveInterpreter = ActiveCodeViewport
+    toggleLogic _ = ActiveLiveInterpreter
+
+-- | Reset the code viewport selected line.
+resetSelectedLine :: AppState n -> AppState n
+resetSelectedLine s@AppState{interpState} = s{selectedFile, selectedLine}
+  where
+    selectedLine = fromMaybe 1 interpState.pauseLoc.linenoF
+    selectedFile = interpState.pauseLoc.filepath
+
+-- | Update the source map given any app state changes.
+updateSourceMap :: AppState n -> IO (AppState n)
+updateSourceMap s =
+    case s.interpState.pauseLoc.filepath of
+        Nothing -> pure s
+        (Just filepath) -> updateSourceMapWithFilepath s filepath
+
+-- | Update the source map with a given filepath.
+updateSourceMapWithFilepath :: AppState n -> FilePath -> IO (AppState n)
+updateSourceMapWithFilepath s filepath
+    | Map.member filepath s.sourceMap = pure s
+    | otherwise = do
+        contents <- Data.Text.IO.readFile filepath
+        let newSourceMap = Map.insert filepath contents s.sourceMap
+        pure $ s{sourceMap = newSourceMap}
+
+-- | Return the potential contents of the current paused file location.
+getSourceContents :: AppState n -> Maybe Text
+getSourceContents s = s.selectedFile >>= (s.sourceMap Map.!?)
+
+-- | Configuration options read in at start-up.
+newtype AppStateConfig = AppStateConfig
+    { startupSplashPath :: FilePath
+    }
+
+-- | Create the initial live interpreter widget object.
+initInterpWidget
+    :: n
+    -- ^ Editor name (must be a unique identifier).
+    -> Maybe Int
+    -- ^ Line height of the editor. Nothing for unlimited.
+    -> BE.Editor Text n
+initInterpWidget name height = BE.editorText name height ""
+
+-- TODO: This should not be hardcoded for debugging.
+makeInitialState :: AppStateConfig -> Command -> IO (AppState AppName)
+makeInitialState config cmd = do
+    interpState_ <-
+        Daemon.startup cmd "."
+            >>= flip Daemon.load "app/Main.hs"
+            >>= flip Daemon.stepInto "fibty 10"
+    interpState <- Daemon.setBreakpointLine interpState_ (Daemon.LocalLine 41)
+    splashContents <- Data.Text.IO.readFile config.startupSplashPath
+    pure $
+        AppState
+            { interpState
+            , selectedLine = 1
+            , selectedFile = Nothing
+            , sourceMap = mempty
+            , appStateConfig = config
+            , appConfig = AppConfig {
+                interpreterPrompt = "ghci> "
+                }
+            , activeWindow = ActiveCodeViewport
+            , liveEditor = initInterpWidget LiveInterpreter (Just 1)
+            , interpLogs = []
+            , displayDebugConsoleLogs = False
+            , debugConsoleLogs = mempty
+            , splashContents = Just splashContents
+            }

app/AppTopLevel.hs

@@ -0,0 +1,5 @@
+module AppTopLevel (AppName(..), Command) where
+
+data AppName = GHCiTUI | CodeViewport | LiveInterpreter deriving (Eq, Show, Ord)
+
+type Command = String

app/BrickUI.hs

@@ -10,98 +10,126 @@ import qualified Brick as B
 import qualified Brick.Widgets.Border as B
 import qualified Brick.Widgets.Center as B
 import Brick.Widgets.Core ((<+>), (<=>))
+import qualified Brick.Widgets.Edit as BE
 import Control.Monad.IO.Class (MonadIO (..))
+import Data.List (find)
 import qualified Data.Map.Strict as Map
 import Data.Maybe (fromMaybe)
-import Data.Text (Text, append, pack)
+import Data.Text (Text, append, pack, unpack)
 import qualified Data.Text
-import qualified Data.Text.IO
+import qualified Data.Text.Zipper as Zipper
 import qualified Graphics.Vty as V
 import Safe (atMay)
 
+import AppState
+    ( ActiveWindow (..)
+    , AppConfig (..)
+    , AppState (..)
+    , AppStateConfig (..)
+    , getSourceContents
+    , liveEditorLens
+    , makeInitialState
+    , resetSelectedLine
+    , toggleActiveLineInterpreter
+    , updateSourceMap
+    )
+import AppTopLevel (AppName (..), Command)
 import qualified Daemon
 import Debug.Trace (trace)
 import qualified Loc
 
-data AppName = GHCiTUI | CodeViewport | LiveInterpreter deriving (Eq, Show, Ord)
+-- | Alias for 'AppState AppName' convenience.
+type AppS = AppState AppName
 
--- | Application state wrapper
-data AppState = AppState
-    { interpState :: Daemon.InterpState ()
-    , selectedFile :: Maybe FilePath
-    , selectedLine :: Int
-    , sourceMap :: Map.Map FilePath Text
-    -- ^ Mapping between source filepaths and their contents.
-    , appStateConfig :: AppStateConfig
-    -- ^ Program launch configuration
-    , splashContents :: Maybe Text
-    }
-
-resetSelectedLine :: AppState -> AppState
-resetSelectedLine s@AppState{interpState} = s{selectedFile, selectedLine}
-  where
-    selectedLine = fromMaybe 1 interpState.pauseLoc.linenoF
-    selectedFile = interpState.pauseLoc.filepath
-
--- | Update the source map given any app state changes.
-updateSourceMap :: AppState -> IO AppState
-updateSourceMap s =
-    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
-    | otherwise = do
-        contents <- Data.Text.IO.readFile filepath
-        let newSourceMap = Map.insert filepath contents s.sourceMap
-        pure $ s{sourceMap = newSourceMap}
-
-appDraw :: AppState -> [B.Widget AppName]
+appDraw :: AppS -> [B.Widget AppName]
 appDraw 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)
+    let
+        sourceLabel =
+            markLabel
+                (s.activeWindow == ActiveCodeViewport)
+                ("Source: " `append` maybe "?" pack (s.interpState.pauseLoc.filepath))
+        interpreterLabel =
+            markLabel (s.activeWindow == ActiveLiveInterpreter) "Interpreter"
+        viewportBox =
+            B.borderWithLabel sourceLabel
+                . B.withVScrollBars B.OnRight
+                . B.viewport CodeViewport B.Vertical
+                . B.padRight B.Max
+                $ codeViewportDraw s
+
+        interpreterBox =
+            B.borderWithLabel
+                interpreterLabel
+                $ let enableCursor = True
+                      displayLimit = 5
+                      displayF t = B.vBox $ B.txt <$> t
+                      previousOutput =
+                        B.vLimit displayLimit
+                        . B.padTop B.Max
+                        . B.txt
+                        . Data.Text.unlines
+                        . reverse
+                        . take displayLimit
+                        $ if null s.interpLogs
+                            then [" "]
+                            else s.interpLogs
+                      promptLine =
+                        B.txt s.appConfig.interpreterPrompt
+                            <+> BE.renderEditor displayF enableCursor s.liveEditor
+                   in previousOutput <=> promptLine
+        infoBox =
+            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.
                     )
                 )
-            )
-            -- 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.
-                )
-            )
-    ]
+        debugBox =
+            if s.displayDebugConsoleLogs
+                then
+                    let logDisplay =
+                            if null s.debugConsoleLogs then [" "] else s.debugConsoleLogs
+                     in B.borderWithLabel (B.txt "Debug") $
+                            B.withVScrollBars B.OnRight $
+                                B.padRight B.Max $
+                                    B.txt $
+                                        Data.Text.unlines $
+                                            reverse logDisplay
+                else B.emptyWidget
+     in
+        [ (viewportBox <=> interpreterBox <=> debugBox)
+            -- TODO: Make this an expandable viewport, maybe?
+            <+> infoBox
+        ]
 
+-- | Mark the label if the first arg is True.
+markLabel :: Bool -> Text -> B.Widget a
+markLabel False labelTxt = B.txt labelTxt
+markLabel True labelTxt =
+    B.withAttr (B.attrName "highlight") (B.txt ("#>" `append` labelTxt `append` "<#"))
+
+-- | Information used to compute the gutter status of each line.
 data GutterInfo = GutterInfo
     { isStoppedHere :: !Bool
+    -- ^ Is the interpreter stopped/paused here?
     , isBreakpoint :: !Bool
+    -- ^ Is there a breakpoint here?
     , isSelected :: !Bool
+    -- ^ Is this line currently selected by the user?
     , gutterLineNumber :: !Int
+    -- ^ What line number is this?
     , gutterDigitWidth :: !Int
+    -- ^ How many columns is the gutter line number?
     }
 
 -- | 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.
+-- | Create the gutter section for a given line (formed from GutterInfo).
 makeGutter :: GutterInfo -> B.Widget n
 makeGutter GutterInfo{..} =
     lineNoWidget <+> spaceW <+> stopColumn <+> breakColumn <+> spaceW
@@ -119,25 +147,22 @@ makeGutter GutterInfo{..} =
         | isStoppedHere = B.withAttr (B.attrName "stop-line") (B.txt "!")
         | otherwise = spaceW
 
--- | Return the potential contents of the current paused file location.
-getSourceContents :: AppState -> Maybe Text
-getSourceContents s = s.selectedFile >>= (s.sourceMap Map.!?)
-
 -- | Make the primary viewport widget.
-makeCodeViewport :: AppState -> B.Widget AppName
-makeCodeViewport s =
+codeViewportDraw :: AppS -> B.Widget AppName
+codeViewportDraw s =
     let sourceDataMaybe = getSourceContents s
+        noSourceWidget =
+            B.padTop (B.Pad 3) $
+                B.hCenter $
+                    B.withAttr (B.attrName "styled") $
+                        maybe (B.txt "No source file loaded") B.txt s.splashContents
      in case sourceDataMaybe 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 -> makeCodeViewport' s sourceData
+            Nothing -> noSourceWidget
+            Just sourceData -> codeViewportDraw' s sourceData
 
 -- | Viewport when we have source contents.
-makeCodeViewport' :: AppState -> Text -> B.Widget AppName
-makeCodeViewport' s sourceData = composedTogether
+codeViewportDraw' :: AppS -> Text -> B.Widget AppName
+codeViewportDraw' s sourceData = composedTogether
   where
     splitSourceData = Data.Text.lines sourceData
     breakpoints = Daemon.getBpInCurModule s.interpState
@@ -162,9 +187,12 @@ makeCodeViewport' s sourceData = composedTogether
 
     selectedLineW :: Text -> B.Widget AppName
     selectedLineW lineTxt =
-        let lineWidget = B.txt $ Data.Text.replace " " " " lineTxt
+        let transform = id -- Potentialy useful for highlighting spaces?
+            lineWidget = B.txt $ transform lineTxt
          in prefixLineDefault' (s.selectedLine, lineWidget)
 
+    -- Select which line widget we want to draw based on both the interpreter
+    -- state and the app state.
     composedTogetherHelper :: (Int, Text) -> B.Widget AppName
     composedTogetherHelper (lineno, lineTxt)
         | Just lineno == s.interpState.pauseLoc.linenoF = stoppedLineW lineTxt
@@ -218,14 +246,59 @@ formatDigits spacing num = pack (replicate left ' ') `append` pack (show num)
   where
     left = spacing - getNumDigits num
 
-selectedModuleLoc :: AppState -> Maybe Loc.ModuleLoc
+selectedModuleLoc :: AppState n -> Maybe Loc.ModuleLoc
 selectedModuleLoc s =
     Loc.toModuleLoc
         s.interpState.moduleFileMap
         (Loc.FileLoc s.selectedFile (Just s.selectedLine) (Nothing, Nothing))
 
-handleEvent :: B.BrickEvent AppName e -> B.EventM AppName AppState ()
-handleEvent ev =
+-- | Handle any Brick event and update the state.
+handleEvent :: B.BrickEvent AppName e -> B.EventM AppName AppS ()
+handleEvent ev = do
+    appState <- B.get
+    case appState.activeWindow of
+        ActiveCodeViewport -> handleViewportEvent ev
+        ActiveLiveInterpreter -> handleInterpreterEvent ev
+        _ -> pure ()
+
+-- | Handle events when the interpreter (live GHCi) is selected.
+handleInterpreterEvent :: B.BrickEvent AppName e -> B.EventM AppName AppS ()
+handleInterpreterEvent ev =
+    case ev of
+        B.VtyEvent (V.EvKey V.KEnter []) -> do
+            appState <- B.get
+            let AppState{liveEditor, interpState, debugConsoleLogs, interpLogs} = appState
+            let cmd = Data.Text.strip . Data.Text.unlines . BE.getEditContents $ liveEditor
+            (newInterpState, output) <-
+                liftIO $
+                    Daemon.execCleaned interpState (unpack cmd)
+            let newEditor = BE.applyEdit (Zipper.killToEOF . Zipper.gotoBOF) liveEditor
+            -- TODO: Should be configurable?
+            let interpreterLogLimit = 1000
+            let formattedWithPrompt = appState.appConfig.interpreterPrompt `append` cmd
+            let combinedLogs = (pack <$> reverse output) ++ formattedWithPrompt : interpLogs
+            B.put
+                appState
+                    { debugConsoleLogs = "Handled Enter" : debugConsoleLogs
+                    , interpState = newInterpState
+                    , liveEditor = newEditor
+                    , interpLogs =
+                        take interpreterLogLimit combinedLogs
+                    }
+        B.VtyEvent (V.EvKey (V.KChar 'x') [V.MCtrl]) ->
+            -- Toggle out of the interpreter.
+            leaveInterpreter
+        B.VtyEvent (V.EvKey V.KEsc _) ->
+            -- Also toggle out of the interpreter.
+            leaveInterpreter
+        ev' -> do
+            -- Actually handle text input commands.
+            B.zoom liveEditorLens $ BE.handleEditorEvent ev'
+  where
+    leaveInterpreter = B.put . toggleActiveLineInterpreter =<< B.get
+
+handleViewportEvent :: B.BrickEvent AppName e -> B.EventM AppName (AppState n) ()
+handleViewportEvent ev =
     case ev of
         B.VtyEvent (V.EvKey key ms)
             | key == V.KChar 'q' -> do
@@ -242,12 +315,7 @@ handleEvent ev =
                 B.put newState
             | key == V.KChar 'b' -> do
                 appState <- B.get
-                let mlM = selectedModuleLoc appState
-                let runner interpState ml =
-                        Daemon.toggleBreakpointLine
-                            interpState
-                            (Daemon.ModLoc ml)
-                case mlM of
+                case selectedModuleLoc appState of
                     Nothing ->
                         liftIO $
                             fail
@@ -257,7 +325,11 @@ handleEvent ev =
                                     ++ show appState.selectedLine
                                 )
                     Just ml -> do
-                        interpState <- liftIO $ runner appState.interpState ml
+                        interpState <-
+                            liftIO $
+                                Daemon.toggleBreakpointLine
+                                    appState.interpState
+                                    (Daemon.ModLoc ml)
                         B.put appState{interpState}
 
             -- j and k are the vim navigation keybindings.
@@ -268,17 +340,15 @@ handleEvent ev =
             | key == V.KPageDown -> do
                 let scroller = B.viewportScroll CodeViewport
                 B.vScrollPage scroller B.Down
-                pure ()
             | key == V.KPageUp -> do
                 let scroller = B.viewportScroll CodeViewport
                 B.vScrollPage scroller B.Up
-                pure ()
-            | key == V.KChar 'x' && ms == [V.MCtrl] -> do
-                -- TODO: Handle live interpreter
-                pure ()
+            | key == V.KChar 'x' && ms == [V.MCtrl] ->
+                B.put . toggleActiveLineInterpreter =<< B.get
+        -- TODO: Mouse support here?
         _ -> pure ()
   where
-    moveSelectedLine :: Int -> B.EventM a AppState ()
+    moveSelectedLine :: Int -> B.EventM a (AppState n) ()
     moveSelectedLine movAmnt = do
         appState <- B.get
         let lineCount = maybe 1 (length . Data.Text.lines) (getSourceContents appState)
@@ -289,21 +359,37 @@ handleEvent ev =
 
     runDaemon
         :: (MonadIO m)
-        => AppState
+        => AppState n
         -> (Daemon.InterpState () -> IO (Daemon.InterpState ()))
-        -> m AppState
+        -> m (AppState n)
     runDaemon appState f =
         liftIO $ do
             interp <- f appState.interpState
             newState <- updateSourceMap appState{interpState = interp}
             pure $ resetSelectedLine newState
 
+handleCursorPosition
+    :: AppS
+    -- ^ State of the app.
+    -> [B.CursorLocation AppName]
+    -- ^ Potential Locs
+    -> Maybe (B.CursorLocation AppName)
+    -- ^ The chosen cursor location if any.
+handleCursorPosition s ls =
+    if s.activeWindow == ActiveLiveInterpreter
+        then -- If we're in the interpreter window, show the cursor.
+
+            let widgetName = LiveInterpreter
+             in B.showCursorNamed widgetName ls
+        else -- No cursor
+            Nothing
+
 -- | Brick main program.
-brickApp :: B.App AppState e AppName
+brickApp :: B.App AppS e AppName
 brickApp =
     B.App
         { B.appDraw = appDraw
-        , B.appChooseCursor = B.neverShowCursor
+        , B.appChooseCursor = handleCursorPosition
         , B.appHandleEvent = handleEvent
         , B.appStartEvent = pure ()
         , B.appAttrMap =
@@ -322,31 +408,6 @@ brickApp =
                     ]
         }
 
-type Command = String
-
-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"
-    interpState <- Daemon.setBreakpointLine interpState_ (Daemon.LocalLine 41)
-    splashContents <- Data.Text.IO.readFile config.startupSplashPath
-    pure $
-        AppState
-            { interpState
-            , selectedLine = 1
-            , selectedFile = Nothing
-            , sourceMap = mempty
-            , appStateConfig = config
-            , splashContents = Just splashContents
-            }
-
 -- | Start the Brick UI
 launchBrick :: IO ()
 launchBrick = do
@@ -356,4 +417,4 @@ launchBrick = do
             _ -> error "Not a supported command type"
     initialState <- makeInitialState (AppStateConfig "assets/splash.txt") cmd
     _ <- B.defaultMain brickApp initialState
-    pure ()
+    pure ()

fswatch_build.sh

@@ -1,2 +1,8 @@
 #!/bin/sh
-fswatch -n 64 -ro -l1 -m poll_monitor app/ lib/ | xargs -I{} cabal build
+
+if ! which fswatch >/dev/null; then
+    printf "%s\n" "'fswatch' is needed to run this script"
+    exit 1
+fi
+
+fswatch -n 64 -ro -l1 -m poll_monitor app/ lib/ *.cabal | xargs -I{} cabal build

ghcitui.cabal

@@ -26,8 +26,12 @@ executable ghcitui
                         , ghcituilib
                         , vty
                         , safe
+                        , microlens ^>= 0.4.13.1
+                        , text-zipper ^>= 0.13
     hs-source-dirs:     app
     other-modules:      BrickUI
+                        , AppState
+                        , AppTopLevel
     ghc-options:        -rtsopts
                         -threaded
                         -Wall
@@ -40,7 +44,6 @@ executable ghcitui
                         DuplicateRecordFields
                         OverloadedStrings
                         RecordWildCards
-                        
 
 library ghcituilib
     hs-source-dirs:    lib
@@ -56,8 +59,8 @@ library ghcituilib
     exposed-modules:   Daemon
                        , Tui
                        , Loc
-    other-modules:     ParseContext
                        , StringUtil
+    other-modules:     ParseContext
     ghc-options:       -rtsopts
                        -threaded
                        -Wall

lib/Daemon.hs

@@ -7,6 +7,8 @@ module Daemon
     , deleteBreakpointLine
     , emptyInterpreterState
     , exec
+    , execCleaned
+    , execMuted
     , getBpInCurModule
     , getBpInFile
     , load
@@ -22,13 +24,11 @@ module Daemon
 import Control.Monad (when)
 import Control.Monad.IO.Class (MonadIO (..))
 import qualified Data.Bifunctor as Bifunctor
-import Data.List (intercalate)
 import qualified Data.Map.Strict as Map
-import Data.Maybe (catMaybes, mapMaybe, fromMaybe)
+import Data.Maybe (catMaybes, fromMaybe, mapMaybe)
 import Data.String.Interpolate (i)
 import qualified Data.Text as Text
 import qualified Data.Text.IO as Text
-import Debug.Trace (trace)
 import qualified Language.Haskell.Ghcid as Ghcid
 
 import qualified Loc
@@ -37,6 +37,8 @@ import Safe
 
 newtype LogLevel = LogLevel Int
 
+data LogOutput = LogOutputStdOut | LogOutputStdErr | LogOutputFile FilePath
+
 data InterpState a = InterpState
     { _ghci :: Ghcid.Ghci
     -- ^ GHCID handle
@@ -53,6 +55,9 @@ data InterpState a = InterpState
     , status :: Either Text.Text a
     -- ^ IDK? I had an idea here at one point.
     , logLevel :: LogLevel
+    -- ^ How much should we log?
+    , logOutput :: LogOutput
+    -- ^ Where should we log to?
     }
 
 instance Show (InterpState a) where
@@ -71,7 +76,8 @@ emptyInterpreterState ghci =
         , stack = []
         , breakpoints = mempty
         , status = Right mempty
-        , logLevel = LogLevel 0
+        , logLevel = LogLevel 3
+        , logOutput = LogOutputFile "/tmp/ghcitui.log"
         }
 
 -- | Start up the GHCI Daemon
@@ -99,12 +105,14 @@ updateState state_1@InterpState{_ghci} = do
 
 updateContext :: (Monoid a) => InterpState a -> IO (InterpState a)
 updateContext state@InterpState{_ghci} = do
+    logDebug state "|updateContext| CMD: :show context\n"
     msgs <- Ghcid.exec _ghci ":show context"
     let feedback = ParseContext.cleanResponse msgs
     logDebug
         state
-        ( "|updateContext| CMD: :show context\n|updateContext| OUT:\n"
+        ( "|updateContext| OUT:\n"
             `Text.append` ParseContext.linesToText msgs
+            `Text.append` "\n"
         )
     if Text.null feedback
         then pure (emptyInterpreterState _ghci) -- We exited everything.
@@ -147,13 +155,13 @@ 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
+    logDebug state ("|exec| CMD: " `Text.append` Text.pack cmd)
     msgs <- Ghcid.exec _ghci cmd
     logDebug
         state
-        ( "|exec| CMD: "
-            `Text.append` Text.pack cmd
-            `Text.append` "\n|exec| OUT:\n"
-            `Text.append` Text.pack (intercalate "\n" msgs)
+        ( "|exec| OUT:\n"
+            `Text.append` ParseContext.linesToText msgs
+            `Text.append` "\n"
         )
     newState <- updateState state
     pure (newState, msgs)
@@ -164,6 +172,15 @@ execMuted state cmd = do
     (newState, _) <- exec state cmd
     pure newState
 
+-- | @exec@, but clean the message from prompt.
+execCleaned :: (Monoid a) => InterpState a -> String -> IO (InterpState a, [String])
+execCleaned state cmd = do
+    res <- cleaner <$> exec state cmd
+    logDebug state ( "|cleaned|:\n" `Text.append` (Text.pack . unlines . snd $ res))
+    pure res
+  where
+    cleaner (s, ls) = (s, Text.unpack <$> (Text.lines . ParseContext.cleanResponse) ls)
+
 -- | Location info passed to *BreakpointLine functions.
 data BreakpointArg
     = -- | Location in the current file.
@@ -195,7 +212,7 @@ toggleBreakpointLine state loc
 
 -- | Set a breakpoint at a given line.
 setBreakpointLine :: (Monoid a) => InterpState a -> BreakpointArg -> IO (InterpState a)
-setBreakpointLine state loc =  execMuted state command
+setBreakpointLine state loc = execMuted state command
   where
     command =
         ":break " ++ case loc of
@@ -204,8 +221,9 @@ setBreakpointLine state loc =  execMuted state command
                 let mod' = Text.unpack $ fromMaybe "" modM
                     pos = maybe "" show posM
                     colno = maybe "" show colnoM
-                in if pos == "" then error "Cannot set breakpoint at unknown line number" else
-                    mod' ++ " " ++ pos ++ " " ++ colno
+                 in if pos == ""
+                        then error "Cannot set breakpoint at unknown line number"
+                        else mod' ++ " " ++ pos ++ " " ++ colno
 
 -- | Delete a breakpoint at a given line.
 deleteBreakpointLine :: (Monoid a) => InterpState a -> BreakpointArg -> IO (InterpState a)
@@ -226,12 +244,12 @@ deleteBreakpointLine state loc =
                     | (idx, otherML) <- state.breakpoints
                     , otherML.modName == modName && otherML.linenoM == linenoM
                     ]
-
      in case idxMaybe of
             Just num -> execMuted state (":delete " ++ show num)
             Nothing -> do
-                putStrLn
-                    ( "No breakpoint at "
+                logDebug
+                    state
+                    ( Text.pack $ "No breakpoint at "
                         ++ show loc
                         ++ "; breakpoints are found at "
                         ++ show state.breakpoints
@@ -240,10 +258,11 @@ deleteBreakpointLine state loc =
 
 updateBreakList :: InterpState a -> IO (InterpState a)
 updateBreakList state@InterpState{_ghci} = do
+    logDebug state "|updateBreakList| CMD: :show breaks\n"
     msgs <- Ghcid.exec _ghci ":show breaks"
     logDebug
         state
-        ( "|updateBreakList| CMD: :show breaks\n|updateBreakList| OUT:\n"
+        ( "|updateBreakList| OUT:\n"
             `Text.append` ParseContext.linesToText msgs
         )
     let response = ParseContext.cleanResponse msgs
@@ -269,17 +288,26 @@ getBpInFile s fp = catMaybes [loc.linenoF | loc <- breakpointlocs, loc.filepath
 -- | Log a message at the Debug level.
 logDebug :: (MonadIO m) => InterpState a -> Text.Text -> m ()
 logDebug s msg =
-    liftIO $
+    liftIO $ do
         when (num >= 3) $
-            logHelper "[DEBUG]: " msg
+            logHelper output "[DEBUG]: " msg
   where
     LogLevel num = s.logLevel
+    output = logOutput s
 
-logHelper :: (MonadIO m) => Text.Text -> Text.Text -> m ()
-logHelper prefix msg =
-    liftIO $
-        Text.putStrLn
-            ( Text.intercalate
-                "\n"
-                [prefix `Text.append` line | line <- Text.lines msg]
-            )
+logHelper
+    :: (MonadIO m)
+    => LogOutput
+    -- ^ Where to log?
+    -> Text.Text
+    -- ^ prefix
+    -> Text.Text
+    -- ^ Message
+    -> m ()
+logHelper outputLoc prefix msg = do
+    liftIO $ case outputLoc of
+        LogOutputFile path -> Text.appendFile path fmtMsg
+        LogOutputStdOut -> Text.putStrLn fmtMsg
+        _ -> error "Cannot log to that output configuration."
+  where
+    fmtMsg = Text.unlines [prefix `Text.append` line | line <- Text.lines msg]

lib/Loc.hs

@@ -35,7 +35,7 @@ instance Semigroup ModuleFileMap where
     ModuleFileMap a <> ModuleFileMap b = ModuleFileMap (a <> b)
 
 instance Monoid ModuleFileMap where
-    mempty = ModuleFileMap []
+    mempty = ModuleFileMap mempty
 
 -- | Convert a module to a FilePath
 getPathOfModule :: ModuleFileMap -> Text -> Maybe FilePath
@@ -53,4 +53,4 @@ toModuleLoc mfm fl = go <$> fl.filepath
 toFileLoc :: ModuleFileMap -> ModuleLoc -> Maybe FileLoc
 toFileLoc mfm ml = go <$> ml.modName
   where
-    go = (\x -> FileLoc x ml.linenoM ml.colrangeM) . getPathOfModule mfm
+    go = (\x -> FileLoc x ml.linenoM ml.colrangeM) . getPathOfModule mfm

lib/ParseContext.hs

@@ -129,8 +129,8 @@ parseShowBreaks t
             enabled = case mr.mrSubs ! 7 of
                 "enabled" -> Right True
                 "disabled" -> Right False
-                x -> Left ("Breakpoint neither enabled nor disabled: " ++ unpack x)
-            in Right (idx, Loc.ModuleLoc module_ lineno' (colStart, colEnd))
+                x -> Left ("Breakpoint neither enabled nor disabled: " `append` x)
+            in enabled >> Right (idx, Loc.ModuleLoc module_ lineno' (colStart, colEnd))
 
 
 parseShowModules :: Text -> Either Text [(Text, FilePath)]
@@ -160,4 +160,4 @@ include what we want fairly consistently.
 Additionally, pack the lines into a single Text block.
 -}
 cleanResponse :: [String] -> Text
-cleanResponse msgs = lastDef "" (splitBy ghcidPrompt (linesToText msgs))
+cleanResponse msgs = lastDef "" (splitBy ghcidPrompt (linesToText msgs))

lib/StringUtil.hs

@@ -1,10 +1,46 @@
 module StringUtil (splitBy) where
 
-import Data.Text (Text, breakOn, drop, length)
-import Prelude hiding (drop, length)
+import Data.Text (Text, breakOn, drop, length, unlines, unsnoc, length)
+import Prelude hiding (drop, length, unlines)
 
-splitBy :: Text -> Text -> [Text]
+-- | Split text based on a delimiter.
+splitBy
+    :: Text
+    -- ^ Delimeter.
+    -> Text
+    -- ^ Text to split on.
+    -> [Text]
 splitBy delim source =
     case breakOn delim source of
         (l, "") -> [l]
         (l, r) -> l : splitBy delim (drop (length delim) r)
+
+-- | Split text based on a predicate.
+-- splitByPred
+--     :: (Text -> Bool)
+--     -- ^ Predicate
+--     -> Text
+--     -- ^ Text to split on.
+--     -> [Text]
+-- splitByPred _ "" = []
+-- splitByPred pr toSplit = : splitByPred (restOf
+--   where
+--     restOf x = maybe mempty snd (uncons x)
+
+-- | Cleans prompt data from the GHCID output.
+cleanPrompt
+    :: Text
+    -- ^ Prompt text to remove.
+    -> [Text]
+    -- ^ Input lines to clean.
+    -> [Text]
+    -- ^ Cleaned output
+cleanPrompt prompt ls =
+    let sp = splitBy prompt (unlines ls)
+        fileRangeOf t =
+            maybe (0,0) (\(_, lastChar) ->
+                if lastChar == ']'
+                    then (0, length t - 1)
+                    else (0, 0)
+            ) (unsnoc t)
+     in sp