Module box + more

app/AppConfig.hs

@@ -2,14 +2,14 @@
 
 module AppConfig where
 
-import Data.Maybe
-import Data.Text (Text)
+import Data.Maybe (fromMaybe)
+import qualified Data.Text as T
 import System.Environment (lookupEnv)
 
 userConfigDir :: IO FilePath
 userConfigDir = fromMaybe (error errorMsg) <$> result
   where
-    innerLift accA xA = do
+    chooseNonEmpty accA xA = do
         a <- accA
         if a == mempty
             then xA
@@ -17,7 +17,7 @@ userConfigDir = fromMaybe (error errorMsg) <$> result
     errorMsg = "Cannot set config location. Neither XDG_CONFIG_HOME nor HOME values were set."
     result =
         foldr
-            innerLift
+            chooseNonEmpty
             mempty
             [lookupEnv "XDG_CONFIG_HOME", fmap (fmap (<> "/.config")) (lookupEnv "HOME")]
 
@@ -25,13 +25,15 @@ defaultSplashPath :: IO FilePath
 defaultSplashPath = fmap (<> "/ghcitui/assets/splash") userConfigDir
 
 data AppConfig = AppConfig
-    { getInterpreterPrompt :: !Text
+    { getInterpreterPrompt :: !T.Text
     -- ^ Prompt to show for the live interpreter.
     , getDebugConsoleOnStart :: !Bool
     -- ^ Display the debug console on start up.
     , getStartupSplashPath :: !(Maybe FilePath)
-    , getCmd :: !Text
-    , getStartupCommands :: ![Text]
+    , getCmd :: !T.Text
+    -- ^ Command to run to initialise the interpreter.
+    , getStartupCommands :: ![T.Text]
+    -- ^ Commands to run in ghci during start up.
     }
 
 defaultConfig :: AppConfig
@@ -40,7 +42,7 @@ defaultConfig =
         { getInterpreterPrompt = "ghci> "
         , getDebugConsoleOnStart = False
         , getStartupSplashPath = Nothing
-        , getCmd = "cabal v2-repl"
+        , getCmd = "cabal v2-repl --repl-options='-fno-it'"
         , getStartupCommands = mempty
         }
 

app/AppInterpState.hs

@@ -1,18 +1,18 @@
-module AppInterpState (
-    AppInterpState (..),
-    commandBuffer,
-    emptyAppInterpState,
-    futHistoryPos,
-    history,
-    isScanningHist,
-    liveEditor,
-    pastHistoryPos,
-    pushHistory,
-    viewLock,
-) where
+module AppInterpState
+    ( AppInterpState (_liveEditor, _viewLock, _commandBuffer, historyPos)
+    , commandBuffer
+    , emptyAppInterpState
+    , futHistoryPos
+    , history
+    , isScanningHist
+    , liveEditor
+    , pastHistoryPos
+    , pushHistory
+    , viewLock
+    ) where
 
 import qualified Brick.Widgets.Edit as BE
-import Data.Text (Text)
+import qualified Data.Text as T
 import Lens.Micro as Lens
 
 data AppInterpState s n = AppInterpState
@@ -25,18 +25,19 @@ data AppInterpState s n = AppInterpState
 
 -- | Lens accessor for the editor.
 liveEditor :: Lens.Lens' (AppInterpState s n) (BE.Editor s n)
-liveEditor = Lens.lens _liveEditor (\ais le -> ais { _liveEditor = le })
+liveEditor = Lens.lens _liveEditor (\ais le -> ais{_liveEditor = le})
 
+-- | Lens for the view lock setting
 viewLock :: Lens.Lens' (AppInterpState s n) Bool
-viewLock = Lens.lens _viewLock (\ais x -> ais { _viewLock = x })
+viewLock = Lens.lens _viewLock (\ais x -> ais{_viewLock = x})
 
 commandBuffer :: Lens.Lens' (AppInterpState s n) [s]
-commandBuffer = Lens.lens _commandBuffer (\ais x -> ais { _commandBuffer = x })
+commandBuffer = Lens.lens _commandBuffer (\ais x -> ais{_commandBuffer = x})
 
 history :: AppInterpState s n -> [[s]]
 history = _history
 
-emptyAppInterpState :: n -> AppInterpState Text n
+emptyAppInterpState :: n -> AppInterpState T.Text n
 emptyAppInterpState name =
     AppInterpState
         { _liveEditor = initInterpWidget name (Just 1)
@@ -46,6 +47,9 @@ emptyAppInterpState name =
         , historyPos = 0
         }
 
+resetHistoryPos :: AppInterpState s n -> AppInterpState s n
+resetHistoryPos s = s{historyPos = 0}
+
 -- | Move interpreter history back.
 pastHistoryPos :: AppInterpState s n -> AppInterpState s n
 pastHistoryPos s@AppInterpState{..} =
@@ -61,9 +65,9 @@ isScanningHist AppInterpState{..} = historyPos /= 0
 futHistoryPos :: AppInterpState s n -> AppInterpState s n
 futHistoryPos s@AppInterpState{..} = s{historyPos = max 0 $ pred historyPos}
 
--- | Push a new value on to the history stack.
+-- | Push a new value on to the history stack and reset the position.
 pushHistory :: [s] -> AppInterpState s n -> AppInterpState s n
-pushHistory cmdLines s = s {_history = cmdLines : history s}
+pushHistory cmdLines s = resetHistoryPos $ s{_history = cmdLines : history s}
 
 -- | Create the initial live interpreter widget object.
 initInterpWidget
@@ -71,5 +75,5 @@ initInterpWidget
     -- ^ Editor name (must be a unique identifier).
     -> Maybe Int
     -- ^ Line height of the editor. Nothing for unlimited.
-    -> BE.Editor Text n
+    -> BE.Editor T.Text n
 initInterpWidget name height = BE.editorText name height mempty

app/AppState.hs

@@ -4,39 +4,41 @@ module AppState
     ( ActiveWindow (..)
     , AppConfig (..)
     , AppState (..)
+    , appInterpState
     , getSourceContents
-    , updateSourceMap
-    , resetSelectedLine
+    , getSourceLineCount
+    , listAvailableSources
+    , liveEditor'
     , makeInitialState
+    , resetSelectedLine
     , toggleActiveLineInterpreter
     , toggleBreakpointLine
-    , appInterpState
-    , liveEditor'
+    , updateSourceMap
     , writeDebugLog
-    , WindowSizes
     ) where
 
-import AppConfig (AppConfig (..), resolveStartupSplashPath)
-import qualified AppInterpState as AIS
 import qualified Brick.Widgets.Edit as BE
-import Control.Exception (SomeException, catch, try, IOException)
+import Control.Error (fromMaybe, lastMay)
+import Control.Exception (IOException, SomeException, catch, try)
 import qualified Data.Map.Strict as Map
-import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
 import qualified Lens.Micro as Lens
 
+import AppConfig (AppConfig (..), resolveStartupSplashPath)
+import qualified AppInterpState as AIS
 import AppTopLevel (AppName (..))
 import Ghcid.Daemon (toggleBreakpointLine)
 import qualified Ghcid.Daemon as Daemon
-import qualified Loc 
+import qualified Loc
 
 data ActiveWindow = ActiveCodeViewport | ActiveLiveInterpreter | ActiveInfoWindow
     deriving (Show, Eq, Ord)
 
--- | Size information of the current GHCiDTUI main boxes.
+{- | Size information of the current GHCiDTUI main boxes.
 type WindowSizes = [(ActiveWindow, (Maybe Int, Maybe Int))]
+-}
 
 -- | Application state wrapper
 data AppState n = AppState
@@ -44,38 +46,47 @@ data AppState n = AppState
     -- ^ The interpreter handle.
     , getCurrentWorkingDir :: !FilePath
     -- ^ The current working directory.
-    , _appInterpState :: AIS.AppInterpState Text n
+    , _appInterpState :: AIS.AppInterpState T.Text n
     -- ^ The live interpreter state (separate from the interpreter
     -- and the app state itself.
     , interpLogs :: ![Text]
     , appConfig :: !AppConfig
     -- ^ Program launch configuration.
-    , activeWindow :: ActiveWindow
+    , activeWindow :: !ActiveWindow
     -- ^ Currently active window.
-    , selectedFile :: Maybe FilePath
+    , selectedFile :: !(Maybe FilePath)
     -- ^ Filepath to the current code viewport contents, if set.
-    , selectedLine :: Int
+    , selectedLine :: !Int
     -- ^ Currently selected line number. Resets back to 1.
-    , sourceMap :: Map.Map FilePath Text
+    , sourceMap :: Map.Map FilePath T.Text
     -- ^ Mapping between source filepaths and their contents.
-    , displayDebugConsoleLogs :: Bool
+    , displayDebugConsoleLogs :: !Bool
     -- ^ Whether to display debug Console logs.
     , debugConsoleLogs :: [Text]
     -- ^ Place for debug output to go.
-    , splashContents :: !(Maybe Text)
+    , splashContents :: !(Maybe T.Text)
     -- ^ Splash to show on start up.
     }
 
+newtype AppStateA m a = AppStateA {runAppStateA :: m a}
+
+instance (Functor m) => Functor (AppStateA m) where
+    fmap f appStateA = AppStateA (f <$> runAppStateA appStateA)
+
+instance (Applicative m) => Applicative (AppStateA m) where
+    pure appState = AppStateA (pure appState)
+    (<*>) = undefined
+
 -- | Lens for the App's interpreter box.
-appInterpState :: Lens.Lens' (AppState n) (AIS.AppInterpState Text n)
+appInterpState :: Lens.Lens' (AppState n) (AIS.AppInterpState T.Text n)
 appInterpState = Lens.lens _appInterpState (\x ais -> x{_appInterpState = ais})
 
 -- | Lens wrapper for zooming with handleEditorEvent.
-liveEditor' :: Lens.Lens' (AppState n) (BE.Editor Text n)
+liveEditor' :: Lens.Lens' (AppState n) (BE.Editor T.Text n)
 liveEditor' = appInterpState . AIS.liveEditor
 
 -- | Write a debug log entry.
-writeDebugLog :: Text -> AppState n -> AppState n
+writeDebugLog :: T.Text -> AppState n -> AppState n
 writeDebugLog lg s = s{debugConsoleLogs = lg : debugConsoleLogs s}
 
 toggleActiveLineInterpreter :: AppState n -> AppState n
@@ -85,20 +96,27 @@ toggleActiveLineInterpreter s@AppState{activeWindow} =
     toggleLogic ActiveLiveInterpreter = ActiveCodeViewport
     toggleLogic _ = ActiveLiveInterpreter
 
--- | Reset the code viewport selected line.
+-- | Reset the code viewport selected line to the pause location.
 resetSelectedLine :: AppState n -> AppState n
-resetSelectedLine s@AppState{interpState} = s{selectedFile, selectedLine}
+resetSelectedLine s@AppState{interpState} =
+    s{selectedFile = ourSelectedFile, selectedLine = ourSelectedLine}
   where
-    selectedLine :: Int
-    selectedLine = fromMaybe 1 (Loc.startLine . Loc.fSourceRange =<< interpState.pauseLoc)
-    selectedFile = Loc.filepath <$> interpState.pauseLoc
+    ourSelectedLine :: Int
+    ourSelectedLine =
+        fromMaybe
+            (selectedLine s)
+            (Loc.startLine . Loc.fSourceRange =<< interpState.pauseLoc)
+    ourSelectedFile = maybe (selectedFile s) (Just . Loc.filepath) interpState.pauseLoc
 
 -- | Update the source map given any app state changes.
 updateSourceMap :: AppState n -> IO (AppState n)
-updateSourceMap s =
-    case s.interpState.pauseLoc of
+updateSourceMap s = do
+    s' <- case selectedFile s of
+        Just sf -> updateSourceMapWithFilepath s sf
         Nothing -> pure s
-        (Just (Loc.FileLoc{filepath})) -> updateSourceMapWithFilepath s filepath
+    case s'.interpState.pauseLoc of
+        Nothing -> pure s'
+        (Just (Loc.FileLoc{filepath})) -> updateSourceMapWithFilepath s' filepath
 
 -- | Update the source map with a given filepath.
 updateSourceMapWithFilepath :: AppState n -> FilePath -> IO (AppState n)
@@ -114,15 +132,24 @@ updateSourceMapWithFilepath s filepath
                 let newSourceMap = Map.insert filepath contents s.sourceMap
                 pure s{sourceMap = newSourceMap}
 
+listAvailableSources :: AppState n -> [(T.Text, FilePath)]
+listAvailableSources = Loc.moduleFileMapAssocs . Daemon.moduleFileMap . interpState
+
 -- | Return the potential contents of the current paused file location.
-getSourceContents :: AppState n -> Maybe Text
+getSourceContents :: AppState n -> Maybe T.Text
 getSourceContents s = s.selectedFile >>= (s.sourceMap Map.!?)
 
+{- | Return the number of lines in the current source viewer.
+     Returns Nothing if there's no currently viewed source.
+-}
+getSourceLineCount :: AppState n -> Maybe Int
+getSourceLineCount s = length . T.lines <$> getSourceContents s
+
 -- | Initialise the state from the config.
 makeInitialState
     :: AppConfig
     -- ^ Start up config.
-    -> Text
+    -> T.Text
     -- ^ Daemon command prefix.
     -> FilePath
     -- ^ Workding directory.
@@ -136,18 +163,27 @@ makeInitialState appConfig target cwd = do
             (Just <$> (T.readFile =<< resolveStartupSplashPath appConfig))
             -- The splash is never critical.
             -- Just put nothing there if we can't find it.
-            (const (pure Nothing) :: SomeException -> IO (Maybe Text))
-    pure
+            (const (pure Nothing) :: SomeException -> IO (Maybe T.Text))
+    let selectedFile =
+            case Loc.moduleFileMapAssocs (Daemon.moduleFileMap interpState) of
+                -- If we just have one file, select that.
+                [(_, filepath)] -> Just filepath
+                -- If we have no module/file mappings, nothing must be selected.
+                [] -> Nothing
+                -- If we don't have a selected file, but we have a module loaded,
+                -- select the last one.
+                xs -> fmap snd (lastMay xs)
+    updateSourceMap
         AppState
             { interpState
             , getCurrentWorkingDir = cwd'
             , _appInterpState = AIS.emptyAppInterpState LiveInterpreter
-            , activeWindow = ActiveCodeViewport
+            , activeWindow = ActiveLiveInterpreter
             , appConfig
             , debugConsoleLogs = mempty
             , displayDebugConsoleLogs = getDebugConsoleOnStart appConfig
             , interpLogs = mempty
-            , selectedFile = Nothing
+            , selectedFile
             , selectedLine = 1
             , sourceMap = mempty
             , splashContents

app/BrickUI.hs

@@ -11,14 +11,12 @@ 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.Error.Util (note)
-import Control.Monad.IO.Class (MonadIO (..))
+import Control.Error (headMay)
 import Data.Maybe (fromMaybe)
 import qualified Data.Text as T
-import qualified Data.Text.Zipper as Zipper
 import qualified Graphics.Vty as V
-import Lens.Micro as Lens
-import Safe (atDef, headMay, lastDef)
+import Lens.Micro ((&), (<&>), (^.))
+import qualified Text.Wrap as Wrap
 
 import qualified AppConfig
 import qualified AppInterpState as AIS
@@ -29,16 +27,12 @@ import AppState
     , getSourceContents
     , liveEditor'
     , makeInitialState
-    , resetSelectedLine
-    , toggleActiveLineInterpreter
-    , updateSourceMap
-    , writeDebugLog
     )
 import AppTopLevel (AppName (..))
+import qualified Events
 import qualified Ghcid.Daemon as Daemon
 import qualified Loc
 import qualified NameBinding
-import Util (showT)
 import qualified Util
 
 -- | Alias for 'AppState AppName' convenience.
@@ -48,16 +42,13 @@ appDraw :: AppS -> [B.Widget AppName]
 appDraw s =
     [ (viewportBox <=> interpreterBox <=> debugBox)
         -- TODO: Make this an expandable viewport, maybe?
-        <+> infoBox
+        <+> infoBox s
     ]
   where
     sourceLabel =
         markLabel
             (s.activeWindow == ActiveCodeViewport)
-            ( "Source: "
-                <> case s.interpState.pauseLoc of
-                    Nothing -> "?"
-                    Just loc -> T.pack (Loc.filepath loc)
+            ( "Source: " <> maybe "?" T.pack s.selectedFile
             )
     interpreterLabel =
         markLabel
@@ -67,6 +58,7 @@ appDraw s =
                 else "Interpreter (Scrolling)"
             )
 
+    viewportBox :: B.Widget AppName
     viewportBox =
         B.borderWithLabel sourceLabel
             . appendLastCommand
@@ -80,6 +72,7 @@ appDraw s =
                 Just h -> B.padBottom B.Max (w <=> B.hBorder <=> B.txt h)
                 _ -> w
 
+    interpreterBox :: B.Widget AppName
     interpreterBox =
         B.borderWithLabel interpreterLabel
             . B.vLimit (displayLimit + 1) -- Plus one for the current line.
@@ -89,45 +82,69 @@ appDraw s =
       where
         enableCursor = True
         displayLimit = 10
-        displayF t = B.vBox $ B.txt <$> t
         previousOutput =
-            if not (null s.interpLogs)
-                then
+            if null s.interpLogs
+                then B.emptyWidget
+                else
                     B.txt
                         . T.unlines
                         . reverse
                         $ s.interpLogs
-                else B.emptyWidget
+        promptLine :: B.Widget AppName
         promptLine =
             B.txt s.appConfig.getInterpreterPrompt
                 <+> BE.renderEditor displayF enableCursor (s ^. liveEditor')
+          where
+            displayF :: [T.Text] -> B.Widget AppName
+            displayF t = B.vBox $ B.txt <$> t
         lockToBottomOnViewLock w =
             if s ^. appInterpState . AIS.viewLock
                 then B.visible w
                 else w
 
-    infoBox =
-        B.borderWithLabel (B.txt "Info")
-            . B.hLimit 30
-            . B.padBottom B.Max
-            . B.padRight B.Max
-            $ case NameBinding.renderNamesTxt s.interpState.bindings of
-                [] -> B.txt " " -- Can't be an empty widget due to padding?
-                bs -> B.vBox (B.txt <$> bs)
-
     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 $
-                                    T.unlines $
-                                        reverse logDisplay
+                 in B.borderWithLabel (B.txt "Debug")
+                        . B.withVScrollBars B.OnRight
+                        . B.padRight B.Max
+                        . B.txt
+                        . T.unlines
+                        . reverse
+                        $ logDisplay
             else B.emptyWidget
 
+infoBox :: AppS -> B.Widget AppName
+infoBox appState =
+    B.borderWithLabel (B.txt "Info")
+        . B.hLimit 30
+        . B.padRight B.Max
+        . B.padBottom B.Max
+        $ bindingBox <=> B.hBorderWithLabel (B.txt "Modules") <=> moduleBox
+  where
+    wrapSettings =
+        Wrap.defaultWrapSettings
+            { Wrap.preserveIndentation = True
+            , Wrap.breakLongWords = True
+            , Wrap.fillStrategy = Wrap.FillIndent 2
+            }
+    intState = interpState appState
+    bindingBox :: B.Widget AppName
+    bindingBox = case NameBinding.renderNamesTxt <$> Daemon.bindings intState of
+        Left _ -> B.txt "<Error displaying bindings>"
+        Right [] -> B.txt " " -- Can't be an empty widget due to padding?
+        Right bs -> B.vBox (B.txtWrapWith wrapSettings <$> bs)
+    moduleBox :: B.Widget AppName
+    moduleBox =
+        if null mfmAssocs
+            then B.txt "<No module mappings>"
+            else foldr1 (<=>) (mkModEntryWidget <$> mfmAssocs)
+      where
+        mfmAssocs = Loc.moduleFileMapAssocs (Daemon.moduleFileMap intState)
+        mkModEntryWidget (modName, fp) = B.txt (modName <> " > " <> T.pack fp)
+
 -- | Mark the label if the first arg is True.
 markLabel :: Bool -> T.Text -> B.Widget a
 markLabel False labelTxt = B.txt (labelTxt <> " [Ctrl+x]")
@@ -164,7 +181,7 @@ makeGutter GutterInfo{..} =
     breakColumn
         | isSelected && isBreakpoint = B.withAttr (B.attrName "selected-marker") (B.txt "@")
         | isSelected = B.withAttr (B.attrName "selected-marker") (B.txt ">")
-        | isBreakpoint = B.withAttr (B.attrName "breakpoint-marker") (B.txt "b")
+        | isBreakpoint = B.withAttr (B.attrName "breakpoint-marker") (B.txt "*")
         | otherwise = spaceW
     stopColumn
         | isStoppedHere = B.withAttr (B.attrName "stop-line") (B.txt "!")
@@ -174,9 +191,9 @@ makeGutter GutterInfo{..} =
 codeViewportDraw :: AppS -> B.Widget AppName
 codeViewportDraw s =
     case (currentlyRunning, sourceDataMaybe) of
+        (_, Just sourceData) -> codeViewportDraw' s sourceData
         (False, _) -> notRunningWidget
         (_, Nothing) -> noSourceWidget
-        (_, Just sourceData) -> codeViewportDraw' s sourceData
   where
     currentlyRunning = Daemon.isExecuting (interpState s)
     sourceDataMaybe = getSourceContents s
@@ -209,7 +226,7 @@ codeViewportDraw' s sourceData = composedTogether
         _loadedWindowSize = error "loadedWindowSize not implemented"
         withLineNums = zip [startLineno ..]
 
-    breakpoints = Daemon.getBpInCurModule s.interpState
+    breakpoints = maybe [] (Daemon.getBpInFile (interpState s)) (selectedFile s)
     gutterInfoForLine lineno =
         GutterInfo
             { isStoppedHere =
@@ -272,17 +289,14 @@ codeViewportDraw' s sourceData = composedTogether
         lineWidgetCached = B.cached (CodeViewportLine lineno) lineWidget
 
     composedTogether :: B.Widget AppName
-    composedTogether =
-        B.vBox
-            ( (\(num, t) -> wrapSelectedLine num $ composedTogetherHelper (num, t))
-                <$> windowedSplitSourceData
-            )
+    composedTogether = B.vBox (createWidget <$> windowedSplitSourceData)
       where
         wrapSelectedLine lineno w =
             if lineno == s.selectedLine
                 then -- Add highlighting, then mark it as visible in the viewport.
                     B.visible $ B.modifyDefAttr (`V.withStyle` V.bold) w
                 else w
+        createWidget (num, lineTxt) = wrapSelectedLine num (composedTogetherHelper (num, lineTxt))
 
 -- | Make the Stopped Line widget (the line where we paused execution)
 makeStoppedLineWidget :: T.Text -> Loc.ColumnRange -> B.Widget AppName
@@ -301,288 +315,6 @@ makeStoppedLineWidget lineData (Just startCol, Just endCol) =
     (lineDataBefore, partial) = T.splitAt (startCol - 1) lineData
     (lineDataRange, lineDataAfter) = T.splitAt (endCol - startCol + 1) partial
 
--- -------------------------------------------------------------------------------------------------
--- Event Handling
--- -------------------------------------------------------------------------------------------------
-
--- | 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 ()
-
--- -------------------------------------------------------------------------------------------------
--- Interpreter Event Handling
--- -------------------------------------------------------------------------------------------------
-
--- | 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 cmd = T.strip (T.unlines (editorContents appState))
-
-            -- Actually run the command.
-            (newAppState1, output) <- runDaemon2 (`Daemon.execCleaned` cmd) appState
-
-            let newEditor =
-                    BE.applyEdit
-                        (Zipper.killToEOF . Zipper.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
-                            }
-            let appStateFinalIO = updateSourceMap (Lens.set liveEditor' newEditor newAppState2)
-            B.put =<< liftIO appStateFinalIO
-        B.VtyEvent (V.EvKey (V.KChar '\t') []) -> do
-            -- Tab completion?
-            appState <- B.get
-            let cmd = T.strip (T.unlines (editorContents appState))
-            (newAppState1, _output) <-
-                runDaemon2
-                    (`Daemon.execCleaned` (":complete " <> cmd))
-                    appState
-            B.put newAppState1
-        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
-        B.VtyEvent (V.EvKey V.KUp _) -> do
-            let maybeStoreBuffer s =
-                    if not (AIS.isScanningHist (getAis s))
-                        then storeCommandBuffer s
-                        else s
-            let wDebug s =
-                    writeDebugLog
-                        ( "Handled Up; historyPos is "
-                            <> (showT . AIS.historyPos . getAis $ s)
-                        )
-                        s
-            appState <- B.get
-            let appState' =
-                    wDebug
-                        . replaceCommandBufferWithHist -- Display the history.
-                        . Lens.over appInterpState AIS.pastHistoryPos -- Go back in time.
-                        . maybeStoreBuffer -- Store the buffer if we're not scanning already.
-                        $ appState
-            B.put appState'
-        B.VtyEvent (V.EvKey V.KDown _) -> do
-            let wDebug s =
-                    writeDebugLog
-                        ( "Handled Down; historyPos is "
-                            <> (showT . AIS.historyPos . getAis $ s)
-                        )
-                        s
-            appState <- B.get
-            let appState' =
-                    wDebug
-                        . replaceCommandBufferWithHist -- Display the history.
-                        . Lens.over appInterpState AIS.futHistoryPos -- Go forward in time.
-                        $ appState
-            B.put appState'
-        B.VtyEvent (V.EvKey V.KPageDown _) ->
-            B.vScrollPage (B.viewportScroll LiveInterpreterViewport) B.Down
-        B.VtyEvent (V.EvKey V.KPageUp _) -> do
-            B.vScrollPage (B.viewportScroll LiveInterpreterViewport) B.Up
-            appState <- B.get
-            B.put (Lens.set (appInterpState . AIS.viewLock) False appState)
-        ev' -> do
-            appState <- B.get
-            B.put (Lens.set (appInterpState . AIS.viewLock) True appState)
-            -- Actually handle text input commands.
-            B.zoom liveEditor' $ BE.handleEditorEvent ev'
-  where
-    editorContents appState = BE.getEditContents $ appState ^. liveEditor'
-    storeCommandBuffer appState =
-        Lens.set (appInterpState . AIS.commandBuffer) (editorContents appState) appState
-    getAis s = s ^. appInterpState
-    getCommandAtHist :: Int -> AppS -> [T.Text]
-    getCommandAtHist i s
-        | i <= 0 = s ^. appInterpState . AIS.commandBuffer
-        | otherwise = atDef (lastDef [] hist) hist (i - 1)
-      where
-        hist = s ^. appInterpState . Lens.to AIS.history
-
-    leaveInterpreter = B.put . toggleActiveLineInterpreter =<< B.get
-
-    replaceCommandBufferWithHist :: AppS -> AppS
-    replaceCommandBufferWithHist s@AppState{_appInterpState} = replaceCommandBuffer cmd s
-      where
-        cmd = T.unlines . getCommandAtHist (AIS.historyPos _appInterpState) $ s
-
--- | Replace the command buffer with the given strings of Text.
-replaceCommandBuffer
-    :: T.Text
-    -- ^ Text to replace with.
-    -> AppS
-    -- ^ State to modify.
-    -> AppS
-    -- ^ New state.
-replaceCommandBuffer replacement s = Lens.set liveEditor' newEditor s
-  where
-    zipp :: Zipper.TextZipper T.Text -> Zipper.TextZipper T.Text
-    zipp = Zipper.killToEOF . Zipper.insertMany replacement . Zipper.gotoBOF
-    newEditor = BE.applyEdit zipp (s ^. liveEditor')
-
--- -------------------------------------------------------------------------------------------------
--- Viewport Event Handling
--- -------------------------------------------------------------------------------------------------
-
-handleViewportEvent :: B.BrickEvent AppName e -> B.EventM AppName AppS ()
-handleViewportEvent ev =
-    case ev of
-        B.VtyEvent (V.EvKey key ms)
-            | key == V.KChar 'q' -> do
-                appState <- B.get
-                _ <- liftIO $ Daemon.quit appState.interpState
-                B.halt
-            | key == V.KChar 's' -> do
-                appState <- B.get
-                newState <- Daemon.step `runDaemon` appState
-                invalidateLineCache
-                B.put newState
-            | key == V.KChar 'c' -> do
-                appState <- B.get
-                newState <- Daemon.continue `runDaemon` appState
-                invalidateLineCache
-                B.put newState
-            | key == V.KChar 'b' -> do
-                appState <- B.get
-                insertViewportBreakpoint appState
-            -- j and k are the vim navigation keybindings.
-            | key `elem` [V.KDown, V.KChar 'j'] -> do
-                moveSelectedLine 1
-            | key `elem` [V.KUp, V.KChar 'k'] -> do
-                moveSelectedLine (-1)
-            | key == V.KPageDown -> do
-                let scroller = B.viewportScroll CodeViewport
-                B.vScrollPage scroller B.Down
-            | key == V.KPageUp -> do
-                let scroller = B.viewportScroll CodeViewport
-                B.vScrollPage scroller B.Up
-            | key == V.KChar 'x' && ms == [V.MCtrl] ->
-                B.put . toggleActiveLineInterpreter =<< B.get
-        -- TODO: Mouse support here?
-        _ -> pure ()
-  where
-    moveSelectedLine :: Int -> B.EventM AppName (AppState n) ()
-    moveSelectedLine movAmnt = do
-        appState <- B.get
-        let lineCount = maybe 1 (length . T.lines) (getSourceContents appState)
-        let oldLineno = selectedLine appState
-        let newLineno = B.clamp 1 lineCount (oldLineno + movAmnt)
-        let newState = appState{selectedLine = newLineno}
-        -- These two lines need to be re-rendered.
-        B.invalidateCacheEntry (CodeViewportLine oldLineno)
-        B.invalidateCacheEntry (CodeViewportLine newLineno)
-        B.put newState
-
-insertViewportBreakpoint :: AppS -> B.EventM AppName AppS ()
-insertViewportBreakpoint appState =
-    case selectedModuleLoc appState of
-        Left err -> do
-            let selectedFileMsg = fromMaybe "<unknown>" appState.selectedFile
-            let errMsg =
-                    "Cannot find module of line: "
-                        <> selectedFileMsg
-                        <> ":"
-                        <> show appState.selectedLine
-                        <> ": "
-                        <> T.unpack err
-            liftIO $ fail errMsg
-        Right ml -> do
-            interpState <-
-                liftIO $
-                    Daemon.toggleBreakpointLine
-                        appState.interpState
-                        (Daemon.ModLoc ml)
-            -- We may need to be smarter about this,
-            -- because there's a chance that the module loc 'ml'
-            -- doesn't actually refer to this viewed file?
-            case Loc.singleify (Loc.sourceRange ml) of
-                Just (lineno, _colrange) ->
-                    B.invalidateCacheEntry (CodeViewportLine lineno)
-                _ ->
-                    -- If we don't know, just invalidate everything.
-                    invalidateLineCache
-            B.put appState{interpState}
-
--- TODO: Invalidate only the lines instead of the entire application.
-invalidateLineCache :: (Ord n) => B.EventM n (state n) ()
-invalidateLineCache = B.invalidateCache
-
-runDaemon
-    :: (MonadIO m)
-    => (Daemon.InterpState () -> IO (Daemon.InterpState ()))
-    -> AppState n
-    -> m (AppState n)
-runDaemon f appState =
-    liftIO $ do
-        interp <- f appState.interpState
-        newState <- updateSourceMap appState{interpState = interp}
-        pure (resetSelectedLine newState)
-
-runDaemon2
-    :: (MonadIO m)
-    => (Daemon.InterpState () -> IO (Daemon.InterpState (), a))
-    -> AppState n
-    -> m (AppState n, a)
-runDaemon2 f appState =
-    liftIO $ do
-        (interp, x) <- f appState.interpState
-        newState <- updateSourceMap appState{interpState = interp}
-        pure (resetSelectedLine newState, x)
-
-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.
-            B.showCursorNamed widgetName ls
-        else -- No cursor
-            Nothing
-  where
-    widgetName = LiveInterpreter
-
--- | Get Location that's currently selected.
-selectedModuleLoc :: AppState n -> Either T.Text Loc.ModuleLoc
-selectedModuleLoc s = eModuleLoc =<< fl
-  where
-    sourceRange = Loc.srFromLineNo (selectedLine s)
-    fl = case s.selectedFile of
-        Nothing -> Left "No selected file to get module of"
-        Just x -> Right (Loc.FileLoc x sourceRange)
-    eModuleLoc x =
-        let moduleFileMap = Daemon.moduleFileMap (interpState s)
-            res = Loc.toModuleLoc moduleFileMap x
-            errMsg =
-                "No matching module found for '"
-                    <> showT x
-                    <> "' because moduleFileMap was '"
-                    <> showT moduleFileMap
-                    <> "'"
-         in note errMsg res
-
 -- -------------------------------------------------------------------------------------------------
 -- Brick Main
 -- -------------------------------------------------------------------------------------------------
@@ -592,8 +324,8 @@ brickApp :: B.App AppS e AppName
 brickApp =
     B.App
         { B.appDraw = appDraw
-        , B.appChooseCursor = handleCursorPosition
-        , B.appHandleEvent = handleEvent
+        , B.appChooseCursor = Events.handleCursorPosition
+        , B.appHandleEvent = Events.handleEvent
         , B.appStartEvent = pure ()
         , B.appAttrMap =
             const $

app/Events.hs

@@ -0,0 +1,330 @@
+{-# LANGUAGE NamedFieldPuns #-}
+
+module Events (handleEvent, handleCursorPosition) where
+
+import qualified Brick.Main as B
+import qualified Brick.Types as B
+import qualified Brick.Util as B
+import qualified Brick.Widgets.Edit as BE
+import Control.Error (atDef, fromMaybe, lastDef, note)
+import Control.Monad.IO.Class (MonadIO (..))
+import qualified Data.Text as T
+import qualified Data.Text.Zipper as T
+import qualified Graphics.Vty as V
+import Lens.Micro ((^.))
+import qualified Lens.Micro as Lens
+
+import qualified AppInterpState as AIS
+import AppState
+import AppTopLevel
+    ( AppName (..)
+    )
+import qualified Ghcid.Daemon as Daemon
+import qualified Loc
+import Util (showT)
+
+-- | Handle any Brick event and update the state.
+handleEvent :: B.BrickEvent AppName e -> B.EventM AppName (AppState AppName) ()
+handleEvent ev = do
+    appState <- B.get
+    case appState.activeWindow of
+        ActiveCodeViewport -> handleViewportEvent ev
+        ActiveLiveInterpreter -> handleInterpreterEvent ev
+        _ -> pure ()
+
+-- -------------------------------------------------------------------------------------------------
+-- Interpreter Event Handling
+-- -------------------------------------------------------------------------------------------------
+
+-- | Handle events when the interpreter (live GHCi) is selected.
+handleInterpreterEvent :: B.BrickEvent AppName e -> B.EventM AppName (AppState AppName) ()
+handleInterpreterEvent ev =
+    case ev of
+        B.VtyEvent (V.EvKey V.KEnter []) -> do
+            appState <- B.get
+            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
+                            }
+            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?
+            appState <- B.get
+            let cmd = T.strip (T.unlines (editorContents appState))
+            (newAppState1, _output) <-
+                runDaemon2
+                    (`Daemon.execCleaned` (":complete " <> cmd))
+                    appState
+            B.put newAppState1
+        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
+        B.VtyEvent (V.EvKey V.KUp _) -> do
+            let maybeStoreBuffer s =
+                    if not (AIS.isScanningHist (getAis s))
+                        then storeCommandBuffer s
+                        else s
+            let wDebug s =
+                    writeDebugLog
+                        ( "Handled Up; historyPos is "
+                            <> (showT . AIS.historyPos . getAis $ s)
+                        )
+                        s
+            appState <- B.get
+            let appState' =
+                    wDebug
+                        . replaceCommandBufferWithHist -- Display the history.
+                        . Lens.over appInterpState AIS.pastHistoryPos -- Go back in time.
+                        . maybeStoreBuffer -- Store the buffer if we're not scanning already.
+                        $ appState
+            B.put appState'
+        B.VtyEvent (V.EvKey V.KDown _) -> do
+            appState <- B.get
+            let wDebug s =
+                    writeDebugLog
+                        ( "Handled Down; historyPos is "
+                            <> (showT . AIS.historyPos . getAis $ s)
+                        )
+                        s
+            let appState' =
+                    wDebug
+                        . replaceCommandBufferWithHist -- Display the history.
+                        . Lens.over appInterpState AIS.futHistoryPos -- Go forward in time.
+                        $ appState
+            B.put appState'
+        B.VtyEvent (V.EvKey V.KPageDown _) ->
+            B.vScrollPage (B.viewportScroll LiveInterpreterViewport) B.Down
+        B.VtyEvent (V.EvKey V.KPageUp _) -> do
+            B.vScrollPage (B.viewportScroll LiveInterpreterViewport) B.Up
+            appState <- B.get
+            B.put (Lens.set (appInterpState . AIS.viewLock) False appState)
+        ev' -> do
+            appState <- B.get
+            B.put (Lens.set (appInterpState . AIS.viewLock) True appState)
+            -- Actually handle text input commands.
+            B.zoom liveEditor' $ BE.handleEditorEvent ev'
+  where
+    editorContents appState = BE.getEditContents $ appState ^. liveEditor'
+    storeCommandBuffer appState =
+        Lens.set (appInterpState . AIS.commandBuffer) (editorContents appState) appState
+    getAis s = s ^. appInterpState
+    getCommandAtHist :: Int -> AppState n -> [T.Text]
+    getCommandAtHist i s
+        | i <= 0 = s ^. appInterpState . AIS.commandBuffer
+        | otherwise = atDef (lastDef [] hist) hist (i - 1)
+      where
+        hist = s ^. appInterpState . Lens.to AIS.history
+
+    leaveInterpreter = B.put . toggleActiveLineInterpreter =<< B.get
+
+    replaceCommandBufferWithHist :: AppState n -> AppState n
+    replaceCommandBufferWithHist s@AppState{_appInterpState} = replaceCommandBuffer cmd s
+      where
+        cmd = T.unlines . getCommandAtHist (AIS.historyPos _appInterpState) $ s
+
+-- | Replace the command buffer with the given strings of Text.
+replaceCommandBuffer
+    :: T.Text
+    -- ^ Text to replace with.
+    -> AppState n
+    -- ^ State to modify.
+    -> AppState n
+    -- ^ New state.
+replaceCommandBuffer replacement s = Lens.set liveEditor' newEditor s
+  where
+    zipp :: T.TextZipper T.Text -> T.TextZipper T.Text
+    zipp = T.killToEOF . T.insertMany replacement . T.gotoBOF
+    newEditor = BE.applyEdit zipp (s ^. liveEditor')
+
+-- -------------------------------------------------------------------------------------------------
+-- Viewport Event Handling
+-- -------------------------------------------------------------------------------------------------
+
+-- TODO: Handle mouse events?
+handleViewportEvent :: B.BrickEvent AppName e -> B.EventM AppName (AppState AppName) ()
+handleViewportEvent (B.VtyEvent (V.EvKey key ms))
+    | key == V.KChar 'q' = do
+        appState <- B.get
+        _ <- liftIO $ Daemon.quit appState.interpState
+        B.halt
+    | key == V.KChar 's' = do
+        appState <- B.get
+        newState <- Daemon.step `runDaemon` appState
+        invalidateLineCache
+        B.put newState
+    | key == V.KChar 'c' = do
+        appState <- B.get
+        newState <- Daemon.continue `runDaemon` appState
+        invalidateLineCache
+        B.put newState
+    | key == V.KChar 'b' = do
+        appState <- B.get
+        insertViewportBreakpoint appState
+    -- j and k are the vim navigation keybindings.
+    | key `elem` [V.KDown, V.KChar 'j'] = do
+        moveSelectedLineBy 1
+    | key `elem` [V.KUp, V.KChar 'k'] = do
+        moveSelectedLineBy (-1)
+    | key == V.KPageDown = do
+        appState <- B.get
+        mViewport <- B.lookupViewport CodeViewport
+        let oldSelectedLine = selectedLine appState
+        let getViewportBot viewport = B._vpTop viewport + snd (B._vpSize viewport)
+        let newSelectedLine = case mViewport of
+                -- Need the + 1 due to one-indexing.
+                Just viewport ->
+                    let lineCount = fromMaybe 1 (getSourceLineCount appState)
+                     in B.clamp 1 lineCount (getViewportBot viewport + 1)
+                Nothing -> oldSelectedLine
+        invalidateCachedLine oldSelectedLine
+        invalidateCachedLine newSelectedLine
+        B.put appState{selectedLine = newSelectedLine}
+        let scroller = B.viewportScroll CodeViewport
+        B.vScrollPage scroller B.Down
+    | key == V.KPageUp = do
+        appState <- B.get
+        mViewport <- B.lookupViewport CodeViewport
+        let oldSelectedLine = selectedLine appState
+        let newSelectedLine = case mViewport of
+                Just viewport ->
+                    let lineCount = fromMaybe 1 (getSourceLineCount appState)
+                     in B.clamp 1 lineCount (B._vpTop viewport)
+                Nothing -> oldSelectedLine
+        invalidateCachedLine oldSelectedLine
+        invalidateCachedLine newSelectedLine
+        B.put appState{selectedLine = newSelectedLine}
+        let scroller = B.viewportScroll CodeViewport
+        B.vScrollPage scroller B.Up
+    | key == V.KChar 'x' && ms == [V.MCtrl] =
+        B.put . toggleActiveLineInterpreter =<< B.get
+handleViewportEvent _ = pure ()
+
+moveSelectedLineBy :: Int -> B.EventM AppName (AppState n) ()
+moveSelectedLineBy movAmnt = do
+    appState <- B.get
+    let lineCount = fromMaybe 1 (getSourceLineCount appState)
+    let oldLineno = selectedLine appState
+    let newLineno = B.clamp 1 lineCount (oldLineno + movAmnt)
+    let newState = appState{selectedLine = newLineno}
+    -- These two lines need to be re-rendered.
+    invalidateCachedLine oldLineno
+    invalidateCachedLine newLineno
+    B.put newState
+
+invalidateCachedLine :: Int -> B.EventM AppName s ()
+invalidateCachedLine lineno = B.invalidateCacheEntry (CodeViewportLine lineno)
+
+insertViewportBreakpoint :: AppState AppName -> B.EventM AppName (AppState AppName) ()
+insertViewportBreakpoint appState =
+    case selectedModuleLoc appState of
+        Left err -> do
+            let selectedFileMsg = fromMaybe "<unknown>" appState.selectedFile
+            let errMsg =
+                    "Cannot find module of line: "
+                        <> selectedFileMsg
+                        <> ":"
+                        <> show appState.selectedLine
+                        <> ": "
+                        <> T.unpack err
+            liftIO $ fail errMsg
+        Right ml -> do
+            interpState <-
+                liftIO $
+                    Daemon.toggleBreakpointLine
+                        appState.interpState
+                        (Daemon.ModLoc ml)
+            -- We may need to be smarter about this,
+            -- because there's a chance that the module loc 'ml'
+            -- doesn't actually refer to this viewed file?
+            case Loc.singleify (Loc.sourceRange ml) of
+                Just (lineno, _colrange) ->
+                    invalidateCachedLine lineno
+                _ ->
+                    -- If we don't know, just invalidate everything.
+                    invalidateLineCache
+            B.put appState{interpState}
+
+-- TODO: Invalidate only the lines instead of the entire application.
+invalidateLineCache :: (Ord n) => B.EventM n (state n) ()
+invalidateLineCache = B.invalidateCache
+
+runDaemon
+    :: (MonadIO m)
+    => (Daemon.InterpState () -> IO (Daemon.InterpState ()))
+    -> AppState n
+    -> m (AppState n)
+runDaemon f appState =
+    liftIO $ do
+        interp <- f appState.interpState
+        newState <- updateSourceMap appState{interpState = interp}
+        pure (resetSelectedLine newState)
+
+runDaemon2
+    :: (MonadIO m)
+    => (Daemon.InterpState () -> IO (Daemon.InterpState (), a))
+    -> AppState n
+    -> m (AppState n, a)
+runDaemon2 f appState =
+    liftIO $ do
+        (interp, x) <- f appState.interpState
+        newState <- updateSourceMap appState{interpState = interp}
+        pure (resetSelectedLine newState, x)
+
+handleCursorPosition
+    :: AppState AppName
+    -- ^ 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.
+            B.showCursorNamed widgetName ls
+        else -- No cursor
+            Nothing
+  where
+    widgetName = LiveInterpreter
+
+-- | Get Location that's currently selected.
+selectedModuleLoc :: AppState n -> Either T.Text Loc.ModuleLoc
+selectedModuleLoc s = eModuleLoc =<< fl
+  where
+    sourceRange = Loc.srFromLineNo (selectedLine s)
+    fl = case s.selectedFile of
+        Nothing -> Left "No selected file to get module of"
+        Just x -> Right (Loc.FileLoc x sourceRange)
+    eModuleLoc x =
+        let moduleFileMap = Daemon.moduleFileMap (interpState s)
+            res = Loc.toModuleLoc moduleFileMap x
+            errMsg =
+                "No matching module found for '"
+                    <> showT x
+                    <> "' because moduleFileMap was '"
+                    <> showT moduleFileMap
+                    <> "'"
+         in note errMsg res

app/Main.hs

@@ -1,9 +1,10 @@
 module Main where
 
-import BrickUI (launchBrick)
 import qualified Data.Text as T
 import qualified Options.Applicative as Opt
+
 import qualified AppConfig
+import BrickUI (launchBrick)
 
 {-
 Old code for reference.
@@ -39,7 +40,6 @@ launch = do
     pure ()
 -}
 
-
 -- | Holds passed in command line options.
 data CmdOptions = CmdOptions
     { debugConsole :: !Bool
@@ -48,7 +48,8 @@ data CmdOptions = CmdOptions
     -- ^ Launch the TUI at this work directory.
     , target :: !T.Text
     -- ^ Build target, passed as the final argument to cmd.
-    } deriving (Show, Eq)
+    }
+    deriving (Show, Eq)
 
 parseOpts :: Opt.Parser CmdOptions
 parseOpts =
@@ -74,20 +75,21 @@ parseOpts =
             )
         <*> Opt.argument Opt.str (Opt.metavar "TARGET")
 
-fibty :: Int -> Int
-fibty 1 = 0
-fibty 2 = 1
-fibty n =
-    let left = fibty (n - 1)
-        right = fibty (n - 2)
-     in left + right
-
 main :: IO ()
 main = do
     opts <- Opt.execParser parserInfo
-    let conf = AppConfig.defaultConfig { AppConfig.getDebugConsoleOnStart = debugConsole opts }
+    let defConf = AppConfig.defaultConfig
+    let conf =
+            defConf
+                { AppConfig.getDebugConsoleOnStart = debugConsole opts
+                , AppConfig.getCmd =
+                    if T.null $ cmd opts
+                        then AppConfig.getCmd defConf
+                        else cmd opts
+                }
     launchBrick conf (target opts) (workdir opts)
   where
-    parserInfo = Opt.info
-        (Opt.helper Opt.<*> parseOpts)
-        (Opt.fullDesc <> Opt.progDesc "Program Description")
+    parserInfo =
+        Opt.info
+            (Opt.helper Opt.<*> parseOpts)
+            (Opt.fullDesc <> Opt.progDesc "Program Description")

ghcitui.cabal

@@ -30,6 +30,8 @@ executable ghcitui
                         , microlens ^>= 0.4.13.1
                         , text-zipper ^>= 0.13
                         , optparse-applicative ^>= 0.18.1.0
+                        , word-wrap ^>= 0.5
+                        , transformers ^>= 0.6.1.0
     hs-source-dirs:     app
     other-modules:      BrickUI
                         , AppState
@@ -37,6 +39,7 @@ executable ghcitui
                         , Util
                         , AppInterpState
                         , AppConfig
+                        , Events
     ghc-options:        -rtsopts
                         -threaded
                         -Wall
@@ -63,6 +66,7 @@ library
                         , safe ^>= 0.3.19
                         , string-interpolate ^>= 0.3.2.1
                         , text ^>= 2.0.2
+                        , transformers ^>= 0.6.1.0
     exposed-modules:    Ghcid.Daemon
                         , Ghcid.ParseContext
                         , Loc

lib/Ghcid/Daemon.hs

@@ -1,8 +1,10 @@
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE QuasiQuotes #-}
 
 module Ghcid.Daemon
-    ( startup
+    ( DaemonError
+    , startup
     , BreakpointArg (..)
     , InterpState (..)
     , continue
@@ -22,15 +24,15 @@ module Ghcid.Daemon
     , toggleBreakpointLine
     ) where
 
+import Control.Error
 import Control.Monad (when)
 import Control.Monad.IO.Class (MonadIO (..))
+import Control.Monad.Trans.Class (lift)
 import qualified Data.Bifunctor as Bifunctor
-import Data.Maybe (catMaybes, mapMaybe)
 import Data.String.Interpolate (i)
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
 import qualified Language.Haskell.Ghcid as Ghcid
-import Safe
 
 import qualified Ghcid.ParseContext as ParseContext
 import qualified Loc
@@ -42,26 +44,31 @@ newtype LogLevel = LogLevel Int
 -- | Determines where the daemon logs are written.
 data LogOutput = LogOutputStdOut | LogOutputStdErr | LogOutputFile FilePath
 
+data DaemonError
+    = UpdateBindingError T.Text
+    | UpdateBreakListError T.Text
+    deriving (Show, Eq)
+
 data InterpState a = InterpState
     { _ghci :: Ghcid.Ghci
     -- ^ GHCiD handle.
-    , func :: Maybe T.Text
+    , func :: !(Maybe T.Text)
     -- ^ Current pause position function name.
-    , pauseLoc :: Maybe Loc.FileLoc
+    , pauseLoc :: !(Maybe Loc.FileLoc)
     -- ^ Current pause position.
-    , moduleFileMap :: Loc.ModuleFileMap
+    , moduleFileMap :: !Loc.ModuleFileMap
     -- ^ Mapping between modules and their filepaths.
     , stack :: [T.Text]
     -- ^ Program stack (only available during tracing).
     , breakpoints :: [(Int, Loc.ModuleLoc)]
     -- ^ Currently set breakpoint locations.
-    , bindings :: [NameBinding.NameBinding T.Text]
+    , bindings :: Either DaemonError [NameBinding.NameBinding T.Text]
     -- ^ Current context value bindings.
-    , status :: Either T.Text a
+    , status :: !(Either T.Text a)
     -- ^ IDK? I had an idea here at one point.
-    , logLevel :: LogLevel
+    , logLevel :: !LogLevel
     -- ^ How much should we log?
-    , logOutput :: LogOutput
+    , logOutput :: !LogOutput
     -- ^ Where should we log to?
     , execHist :: [T.Text]
     -- ^ What's the execution history?
@@ -75,7 +82,7 @@ instance Show (InterpState a) where
                     let srcRngFmt :: String
                         srcRngFmt =
                             [i|{sourceRange=(#{startLine},#{startCol})-(#{endLine},#{endCol})}|]
-                     in [i|{func="#{func'}", filepath="#{filepath'}", #{srcRngFmt}}|]
+                     in [i|{func=#{func'}, filepath=#{filepath'}, #{srcRngFmt}}|]
                 _ -> "<unknown pause location>" :: String
          in msg
 
@@ -89,7 +96,7 @@ emptyInterpreterState ghci =
         , moduleFileMap = mempty
         , stack = mempty
         , breakpoints = mempty
-        , bindings = mempty
+        , bindings = Right mempty
         , status = Right mempty
         , logLevel = LogLevel 3
         , logOutput = LogOutputFile "/tmp/ghcitui.log"
@@ -114,7 +121,7 @@ startup
     -- ^ The newly created interpreter handle.
 startup cmd pwd = do
     (ghci, _) <- Ghcid.startGhci cmd (Just pwd) (\_ _ -> pure ())
-    pure $ emptyInterpreterState ghci
+    updateState (emptyInterpreterState ghci)
 
 -- | Shutdown GHCiD.
 quit :: InterpState a -> IO (InterpState a)
@@ -124,11 +131,24 @@ quit state = do
 
 -- | Update the interpreter state. Wrapper around other updaters.
 updateState :: (Monoid a) => InterpState a -> IO (InterpState a)
-updateState state =
-    updateContext state
-        >>= updateBindings
-        >>= updateModuleFileMap
-        >>= updateBreakList
+updateState state = do
+    -- Make a wrapper so we don't fail on updating bindings.
+    -- Parsing bindings turns out to be actually impossible to solve
+    -- with the current ':show bindings' output.
+    result <-
+        runExceptT
+            ( (lift . updateContext) state
+                >>= ( \s ->
+                        updateBindings s
+                            `catchE` (\er -> pure s{bindings = Left er})
+                    )
+                >>= lift . updateModuleFileMap
+                >>= updateBreakList
+            )
+    case result of
+        Right x -> pure x
+        Left (UpdateBindingError msg) -> error (T.unpack msg)
+        Left (UpdateBreakListError msg) -> error (T.unpack msg)
 
 -- | Update the current interpreter context.
 updateContext :: (Monoid a) => InterpState a -> IO (InterpState a)
@@ -146,33 +166,17 @@ updateContext state@InterpState{_ghci} = do
         then pure (emptyInterpreterState _ghci) -- We exited everything.
         else do
             let ctx = ParseContext.parseContext feedback
-            let unwrapLog f wrapper = case f ctx of
-                    Left (ParseContext.ParseError msg) -> do
-                        logError state msg
-                        pure Nothing
-                    Right x -> pure (wrapper x)
-            mFunc <- unwrapLog ParseContext.func Just
-            filepath <- case ParseContext.filepath ctx of
-                Left (ParseContext.ParseError msg) -> do
-                    logError state msg
-                    error ("parsing filepath: " <> T.unpack msg)
-                Right x -> pure x
-            sourceRange <- case ParseContext.pcSourceRange ctx of
-                Left (ParseContext.ParseError msg) -> do
-                    logError state msg
-                    pure Loc.unknownSourceRange
-                Right x -> pure x
-            pure
-                state
-                    { func = mFunc
-                    , pauseLoc = Just $ Loc.FileLoc filepath sourceRange
-                    }
+            case ctx of
+                ParseContext.PCError er -> error [i|Failed to update context: #{er}|]
+                ParseContext.PCNoContext -> pure (emptyInterpreterState _ghci)
+                ParseContext.PCContext ParseContext.ParseContextOut{func, filepath, pcSourceRange} ->
+                    pure state{func = Just func, pauseLoc = Just $ Loc.FileLoc filepath pcSourceRange}
 
 -- | Update the current local bindings.
-updateBindings :: InterpState a -> IO (InterpState a)
+updateBindings :: InterpState a -> ExceptT DaemonError IO (InterpState a)
 updateBindings state@InterpState{_ghci} = do
     logDebug state "|updateBindings| CMD: :show bindings\n"
-    msgs <- Ghcid.exec _ghci ":show bindings"
+    msgs <- liftIO (Ghcid.exec _ghci ":show bindings")
     let feedback = ParseContext.cleanResponse (T.pack <$> msgs)
     logDebug
         state
@@ -181,15 +185,21 @@ updateBindings state@InterpState{_ghci} = do
             <> "\n"
         )
     case ParseContext.parseBindings feedback of
-        Right bindings -> pure (state{bindings})
-        Left err -> error ("Failed to update bindings:\n" <> T.unpack err)
+        Right bindings -> pure (state{bindings = pure bindings})
+        Left er -> throwE (UpdateBindingError [i|Failed to update bindings: #{er}|])
 
 -- | Update the source map given any app state changes.
 updateModuleFileMap :: InterpState a -> IO (InterpState a)
 updateModuleFileMap state@InterpState{_ghci, moduleFileMap} = do
-    modules <- Ghcid.showModules _ghci
-    logDebug state ("|updateModuleFileMap| modules: " <> showT modules)
-    let addedModuleMap = Loc.moduleFileMapFromList (Bifunctor.first T.pack <$> modules)
+    logDebug state "updateModuleFileMap|: CMD: :show modules\n"
+    msgs <- Ghcid.exec _ghci ":show modules"
+    let packedMsgs = StringUtil.linesToText msgs
+    logDebug state [i||updateModuleFileMap|: OUT: #{packedMsgs}\n|]
+    modules <- case ParseContext.parseShowModules packedMsgs of
+        Right modules -> pure modules
+        Left er -> error $ show er
+    logDebug state [i||updateModuleFileMap| modules: #{modules}|]
+    let addedModuleMap = Loc.moduleFileMapFromList modules
     let newModuleFileMap = addedModuleMap <> moduleFileMap
     pure $ state{moduleFileMap = newModuleFileMap}
 
@@ -332,23 +342,21 @@ deleteBreakpointLine state loc =
                     )
                 pure state
 
-updateBreakList :: InterpState a -> IO (InterpState a)
+updateBreakList :: InterpState a -> ExceptT DaemonError IO (InterpState a)
 updateBreakList state@InterpState{_ghci} = do
     logDebug state "|updateBreakList| CMD: :show breaks\n"
-    msgs <- Ghcid.exec _ghci ":show breaks"
+    msgs <- liftIO (Ghcid.exec _ghci ":show breaks")
     logDebug
         state
         ( "|updateBreakList| OUT:\n"
             <> StringUtil.linesToText msgs
         )
     let response = ParseContext.cleanResponse (T.pack <$> msgs)
-    pure
-        ( case ParseContext.parseShowBreaks response of
-            Right breakpoints -> state{breakpoints}
-            Left err -> error ("parsing breakpoint list: " <> T.unpack err)
-        )
+    case ParseContext.parseShowBreaks response of
+        Right breakpoints -> pure state{breakpoints}
+        Left er -> throwE (UpdateBreakListError [i|parsing breakpoint list: #{er}|])
 
--- | Return a list of breakpoint line numbers in the current file.
+-- | Return a list of breakpoint line numbers in the currently paused file.
 getBpInCurModule :: InterpState a -> [Int]
 getBpInCurModule InterpState{pauseLoc = Nothing} = []
 getBpInCurModule s@InterpState{pauseLoc = Just Loc.FileLoc{filepath = fp}} = getBpInFile s fp

lib/Ghcid/ParseContext.hs

@@ -1,13 +1,16 @@
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE QuasiQuotes #-}
 
 module Ghcid.ParseContext
     ( ParseContextOut (..)
+    , ParseContextReturn (..)
     , NameBinding (..)
     , BindingValue (..)
     , parseContext
     , parseBreakResponse
     , parseBindings
     , parseShowBreaks
+    , parseShowModules
     , cleanResponse
     , ParseError (..)
     ) where
@@ -15,10 +18,11 @@ module Ghcid.ParseContext
 import Prelude hiding (lines)
 
 import Control.Applicative ((<|>))
-import Control.Error.Util (note)
+import Control.Error
 import Data.Array ((!))
+import Data.String.Interpolate (i)
 import qualified Data.Text as T
-import Safe (atMay, headMay, lastDef, readMay, readNote)
+import Safe (readNote)
 import Text.Regex.TDFA (MatchResult (..), (=~~))
 
 import qualified Loc
@@ -35,29 +39,35 @@ showT = T.pack . show
 
 -- | Output record datatype for 'parseContext'.
 data ParseContextOut = ParseContextOut
-    { func :: !(Either ParseError T.Text)
-    , filepath :: !(Either ParseError FilePath)
-    , pcSourceRange :: !(Either ParseError Loc.SourceRange)
+    { func :: !T.Text
+    , filepath :: !FilePath
+    , pcSourceRange :: !Loc.SourceRange
     }
     deriving (Show)
 
+data ParseContextReturn = PCError ParseError | PCNoContext | PCContext ParseContextOut
+
 -- | Parse the output from ":show context" for the interpreter state.
-parseContext :: T.Text -> ParseContextOut
-parseContext contextText = case eInfoLine contextText of
-    Right (func, rest) ->
-        ParseContextOut
-            (Right func)
-            (parseFile rest)
-            (Right (parseSourceRange rest))
-    Left e -> ParseContextOut (Left e) (Left e) (Left e)
+parseContext :: T.Text -> ParseContextReturn
+parseContext contextText =
+    case eInfoLine contextText of
+        Right (func, rest) ->
+            let sourceRange = parseSourceRange rest
+             in case parseFile rest of
+                    Right f -> PCContext (ParseContextOut func f sourceRange)
+                    Left e -> PCError e
+        Left (ParseError e) ->
+            let contextTextLines = T.lines contextText
+             in if all (`elem` ["", "()"]) contextTextLines
+                    then PCNoContext
+                    else PCError (ParseError [i| parsing context: #{e}|])
 
 parseFile :: T.Text -> Either ParseError FilePath
 parseFile s
     | Just mr <- s =~~ ("^[ \t]*([^:]*):" :: T.Text) = Right (T.unpack (mrSubs mr ! 1))
-    | otherwise = Left (ParseError ("Could not parse file from: '" <> s <> "'"))
+    | otherwise = Left (ParseError [i|Could not parse file from: '#{s}'|])
 
-{- | Parse a source range structure into a SourceRange object.
--}
+-- | Parse a source range structure into a SourceRange object.
 parseSourceRange :: T.Text -> Loc.SourceRange
 parseSourceRange s
     -- Matches (12,34)-(56,78)
@@ -117,6 +127,7 @@ parseSourceRange s
     into ("Foo.Bar", "other stuff here") if the text matches.
 -}
 eInfoLine :: T.Text -> Either ParseError (T.Text, T.Text)
+eInfoLine "" = Left $ ParseError "Could not find info line in empty string"
 eInfoLine contextText =
     note
         (ParseError $ "Could not match info line: '" <> showT splits <> "'")
@@ -125,9 +136,9 @@ eInfoLine contextText =
     splits = splitBy ghcidPrompt contextText
     stopLineMR = foldr (\n acc -> acc <|> stopReg n) Nothing splits
     stopLine = (\mr -> (mrSubs mr ! 1, mrSubs mr ! 2)) <$> stopLineMR
-    -- \| Match on the "Stopped in ..." line.
+    -- Match on the "Stopped in ..." line.
     stopReg :: T.Text -> Maybe (MatchResult T.Text)
-    stopReg s = s =~~ ("^[ \t]*Stopped in ([[:alnum:]_.]+),(.*)" :: T.Text)
+    stopReg s = s =~~ ("^[ \t]*Stopped in ([[:alnum:]_.()]+),(.*)" :: T.Text)
 
 parseBreakResponse :: T.Text -> Either T.Text [Loc.ModuleLoc]
 parseBreakResponse t
@@ -172,7 +183,7 @@ parseShowBreaks t
     parseEach mr =
         let
             -- Don't need to use readMay because regex.
-            idx = readNote "failed to read index." $ T.unpack $ mr.mrSubs ! 1
+            idx = readNote "Failed to read index" $ T.unpack $ mr.mrSubs ! 1
             module_ = mr.mrSubs ! 2
             _filepath = Just $ mr.mrSubs ! 3 -- Not used currently but could be useful?
             sourceRange = parseSourceRange $ mr.mrSubs ! 4
@@ -182,40 +193,46 @@ parseShowBreaks t
                 x -> Left ("Breakpoint neither enabled nor disabled: " <> x)
          in
             case sourceRange of
-                _ | sourceRange == Loc.unknownSourceRange ->
-                    Left ("Could not parse source range for breakpoint " <> showT idx)
-                  | otherwise ->
-                    enabled >> Right ( idx, Loc.ModuleLoc module_ sourceRange )
+                _
+                    | sourceRange == Loc.unknownSourceRange ->
+                        Left ("Could not parse source range for breakpoint " <> showT idx)
+                    | otherwise ->
+                        enabled >> Right (idx, Loc.ModuleLoc module_ sourceRange)
 
 -- | Parse the output of ":show modules".
-parseShowModules :: T.Text -> Either T.Text [(T.Text, FilePath)]
+parseShowModules :: T.Text -> Either ParseError [(T.Text, FilePath)]
 parseShowModules t
     | T.null stripped = Right []
-    | Just xs <- (mapM matching . T.lines) =<< response =
+    | Just xs <- matchingLines =
         let
             parseEach :: MatchResult T.Text -> (T.Text, FilePath)
             parseEach mr = (mr.mrSubs ! 1, T.unpack $ mr.mrSubs ! 2)
          in
             Right $ parseEach <$> xs
-    | otherwise = Left ("failed to parse ':show modules': " <> stripped)
+    | otherwise = Left (ParseError [i|Failed to parse ':show modules': #{stripped}|])
   where
     stripped = T.strip t
-    response = headMay (splitBy ghcidPrompt stripped)
-    reg = "([[:alnum:]_.]+)[ \\t]+\\( *(.*),.*\\)" :: T.Text
+    matchingLines = mapMaybe matching . T.lines <$> lastMay (splitBy ghcidPrompt stripped)
+    reg = "([[:alnum:]_.]+)[ \\t]+\\( *([^,]*),.*\\)" :: T.Text
     matching :: T.Text -> Maybe (MatchResult T.Text)
     matching = (=~~ reg)
 
+-- Sometimes there's lines that are just Unit '()'. Unsure
+-- what they are meant to represent in the binding list.
+dropUnitLines :: [T.Text] -> [T.Text]
+dropUnitLines = filter (\x -> T.strip x /= "()")
+
 -- | Parse the output of ":show bindings".
 parseBindings :: T.Text -> Either T.Text [NameBinding T.Text]
 parseBindings t
     | T.null stripped = Right []
-    | Just xs <- mapM (=~~ reg) (mergeBindingLines (T.lines stripped)) =
+    | Just xs <- mapM (=~~ reg) (dropUnitLines (mergeBindingLines (T.lines stripped))) =
         let
             parseEach :: MatchResult T.Text -> NameBinding T.Text
             parseEach mr = NameBinding (mr.mrSubs ! 1) (mr.mrSubs ! 2) (Evald $ mr.mrSubs ! 3)
          in
             Right $ parseEach <$> xs
-    | otherwise = Left ("failed to parse ':show bindings':\n" <> stripped)
+    | otherwise = Left ("Failed to parse ':show bindings':\n" <> stripped)
   where
     stripped = T.strip t
 
@@ -223,11 +240,12 @@ parseBindings t
     mergeBindingLines [] = []
     mergeBindingLines [x] = [x]
     mergeBindingLines (x1 : x2 : xs) =
-        if T.elem '=' x1
-            then x1 : mergeBindingLines (x2 : xs)
-            else
-                let newLine = (T.strip x1 <> " " <> T.strip x2)
+        case T.uncons x2 of
+            Just (' ', rest) ->
+                let newLine = (T.strip x1 <> " " <> T.strip rest)
                  in mergeBindingLines (newLine : xs)
+            _ -> x1 : mergeBindingLines (x2 : xs)
+
     {- They look like...
         ghci> :show bindings
         somethingLong ::
@@ -248,4 +266,10 @@ include what we want fairly consistently.
 Additionally, pack the lines into a single T.Text block.
 -}
 cleanResponse :: [T.Text] -> T.Text
-cleanResponse msgs = lastDef "" (splitBy ghcidPrompt (T.unlines msgs))
+cleanResponse =
+    T.unlines
+        . dropUnitLines
+        . T.lines
+        . lastDef ""
+        . splitBy ghcidPrompt
+        . T.unlines

lib/Loc.hs

@@ -1,27 +1,26 @@
-{-# LANGUAGE NamedFieldPuns #-}
-
 module Loc
     ( ColumnRange
     , ModuleLoc (..)
     , FileLoc (..)
     , ModuleFileMap
     , moduleFileMapFromList
+    , moduleFileMapAssocs
     , getPathOfModule
     , getModuleOfPath
     , toModuleLoc
     , toFileLoc
-    , HasSourceRange(..)
-    , SourceRange(..)
+    , HasSourceRange (..)
+    , SourceRange (..)
     , unknownSourceRange
     , isLineInside
     , srFromLineNo
     , singleify
     ) where
 
+import Data.Map.Strict as Map
+import Data.Maybe (isNothing)
 import qualified Data.Text as T
 import Safe (headMay)
-import Data.Maybe (isNothing)
-import Data.Map.Strict as Map
 
 -- ------------------------------------------------------------------------------------------------
 
@@ -33,14 +32,17 @@ data SourceRange = SourceRange
     , startCol :: !(Maybe Int)
     , endLine :: !(Maybe Int)
     , endCol :: !(Maybe Int)
-    } deriving (Show, Eq, Ord)
+    }
+    deriving (Show, Eq, Ord)
 
+-- | A source range that represents an unknown location.
 unknownSourceRange :: SourceRange
 unknownSourceRange = SourceRange Nothing Nothing Nothing Nothing
 
 srFromLineNo :: Int -> SourceRange
-srFromLineNo lineno = unknownSourceRange { startLine = Just lineno, endLine = Just lineno }
+srFromLineNo lineno = unknownSourceRange{startLine = Just lineno, endLine = Just lineno}
 
+-- | Return whether a given line number lies within a given source range.
 isLineInside :: SourceRange -> Int -> Bool
 isLineInside SourceRange{startLine = Just sl, endLine = Just el} num = num >= sl && num <= el
 isLineInside SourceRange{startLine = Just sl, endLine = Nothing} num = num >= sl
@@ -50,13 +52,12 @@ isLineInside _ _ = False
 singleify :: SourceRange -> Maybe (Int, ColumnRange)
 singleify sr
     | isNothing sl = Nothing
-    | sl == el = do
-        lineno <- sl 
+    | sl == endLine sr = do
+        lineno <- sl
         pure (lineno, (startCol sr, endCol sr))
     | otherwise = Nothing
   where
     sl = startLine sr
-    el = endLine sr
 
 -- ------------------------------------------------------------------------------------------------
 
@@ -95,6 +96,10 @@ instance Monoid ModuleFileMap where
 moduleFileMapFromList :: [(T.Text, FilePath)] -> ModuleFileMap
 moduleFileMapFromList = ModuleFileMap . Map.fromList
 
+-- | Return mappings between a module name and a filepath.
+moduleFileMapAssocs :: ModuleFileMap -> [(T.Text, FilePath)]
+moduleFileMapAssocs (ModuleFileMap map_) = Map.assocs map_
+
 -- | Convert a module to a FilePath.
 getPathOfModule :: ModuleFileMap -> T.Text -> Maybe FilePath
 getPathOfModule (ModuleFileMap ms) mod' = Map.lookup mod' ms