{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedRecordDot #-}

module Ghcitui.Brick.AppState
    ( ActiveWindow (..)
    , AppConfig (..)
    , AppState (..)
    , WidgetSizes
    , changeInfoWidgetSize
    , getInfoWidth
    , getReplHeight
    , changeReplWidgetSize
    , getSelectedModuleInInfoPanel
    , changeSelectedModuleInInfoPanel
    , appInterpState
    , getSourceLineCount
    , selectedFile
    , setSelectedFile
    , selectedLine
    , filePathOfInfoSelectedModule
    , listAvailableSources
    , liveEditor
    , makeInitialState
    , selectPausedLine
    , sourceWindow
    , toggleActiveLineInterpreter
    , toggleBreakpointLine
    , updateSourceMap
    , writeDebugLog
    ) where

import qualified Brick as B
import qualified Brick.Widgets.Edit as BE
import Control.Error (atMay, fromMaybe)
import Control.Exception (IOException, try)
import Control.Monad.IO.Class (MonadIO (..))
import qualified Data.Map.Strict as Map
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Vector as Vec
import Lens.Micro ((^.))
import qualified Lens.Micro as Lens

import Ghcitui.Brick.AppConfig (AppConfig (..))
import qualified Ghcitui.Brick.AppConfig as AppConfig
import qualified Ghcitui.Brick.AppInterpState as AIS
import Ghcitui.Brick.AppTopLevel (AppName (..))

import qualified Ghcitui.Brick.SourceWindow as SourceWindow
import Ghcitui.Ghcid.Daemon (toggleBreakpointLine)
import qualified Ghcitui.Ghcid.Daemon as Daemon
import qualified Ghcitui.Ghcid.LogConfig as LogConfig
import qualified Ghcitui.Loc as Loc
import qualified Ghcitui.Util as Util

data ActiveWindow
    = ActiveCodeViewport
    | ActiveLiveInterpreter
    | ActiveInfoWindow
    | ActiveDialogQuit
    | ActiveDialogHelp
    deriving (Int -> ActiveWindow -> ShowS
[ActiveWindow] -> ShowS
ActiveWindow -> FilePath
(Int -> ActiveWindow -> ShowS)
-> (ActiveWindow -> FilePath)
-> ([ActiveWindow] -> ShowS)
-> Show ActiveWindow
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActiveWindow -> ShowS
showsPrec :: Int -> ActiveWindow -> ShowS
$cshow :: ActiveWindow -> FilePath
show :: ActiveWindow -> FilePath
$cshowList :: [ActiveWindow] -> ShowS
showList :: [ActiveWindow] -> ShowS
Show, ActiveWindow -> ActiveWindow -> Bool
(ActiveWindow -> ActiveWindow -> Bool)
-> (ActiveWindow -> ActiveWindow -> Bool) -> Eq ActiveWindow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActiveWindow -> ActiveWindow -> Bool
== :: ActiveWindow -> ActiveWindow -> Bool
$c/= :: ActiveWindow -> ActiveWindow -> Bool
/= :: ActiveWindow -> ActiveWindow -> Bool
Eq, Eq ActiveWindow
Eq ActiveWindow =>
(ActiveWindow -> ActiveWindow -> Ordering)
-> (ActiveWindow -> ActiveWindow -> Bool)
-> (ActiveWindow -> ActiveWindow -> Bool)
-> (ActiveWindow -> ActiveWindow -> Bool)
-> (ActiveWindow -> ActiveWindow -> Bool)
-> (ActiveWindow -> ActiveWindow -> ActiveWindow)
-> (ActiveWindow -> ActiveWindow -> ActiveWindow)
-> Ord ActiveWindow
ActiveWindow -> ActiveWindow -> Bool
ActiveWindow -> ActiveWindow -> Ordering
ActiveWindow -> ActiveWindow -> ActiveWindow
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ActiveWindow -> ActiveWindow -> Ordering
compare :: ActiveWindow -> ActiveWindow -> Ordering
$c< :: ActiveWindow -> ActiveWindow -> Bool
< :: ActiveWindow -> ActiveWindow -> Bool
$c<= :: ActiveWindow -> ActiveWindow -> Bool
<= :: ActiveWindow -> ActiveWindow -> Bool
$c> :: ActiveWindow -> ActiveWindow -> Bool
> :: ActiveWindow -> ActiveWindow -> Bool
$c>= :: ActiveWindow -> ActiveWindow -> Bool
>= :: ActiveWindow -> ActiveWindow -> Bool
$cmax :: ActiveWindow -> ActiveWindow -> ActiveWindow
max :: ActiveWindow -> ActiveWindow -> ActiveWindow
$cmin :: ActiveWindow -> ActiveWindow -> ActiveWindow
min :: ActiveWindow -> ActiveWindow -> ActiveWindow
Ord)

-- | Size information of the current GHCiTUI main boxes.
data WidgetSizes = WidgetSizes
    { WidgetSizes -> Int
_wsInfoWidth :: !Int
    , WidgetSizes -> Int
_wsReplHeight :: !Int
    }
    deriving (Int -> WidgetSizes -> ShowS
[WidgetSizes] -> ShowS
WidgetSizes -> FilePath
(Int -> WidgetSizes -> ShowS)
-> (WidgetSizes -> FilePath)
-> ([WidgetSizes] -> ShowS)
-> Show WidgetSizes
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WidgetSizes -> ShowS
showsPrec :: Int -> WidgetSizes -> ShowS
$cshow :: WidgetSizes -> FilePath
show :: WidgetSizes -> FilePath
$cshowList :: [WidgetSizes] -> ShowS
showList :: [WidgetSizes] -> ShowS
Show)

{- | Application state wrapper.

Contains information about the UI and configuration. It also holds a
handle to the actual interpreter under the hood, but on the high level
it should not hold anything internal to GHCi or GHCiD.

Prefer to create this with 'makeInitialState'.
-}
data AppState n = AppState
    { forall n. AppState n -> InterpState ()
interpState :: Daemon.InterpState ()
    -- ^ The interpreter handle.
    , forall n. AppState n -> FilePath
getCurrentWorkingDir :: !FilePath
    -- ^ The current working directory.
    , forall n. AppState n -> AppInterpState Text n
_appInterpState :: AIS.AppInterpState T.Text n
    -- ^ The live interpreter state (separate from the interpreter
    -- and the app state itself.
    , forall n. AppState n -> [Text]
interpLogs :: ![Text]
    , forall n. AppState n -> AppConfig
appConfig :: !AppConfig
    -- ^ Program launch configuration.
    , forall n. AppState n -> ActiveWindow
activeWindow :: !ActiveWindow
    -- ^ Currently active window.
    , forall n. AppState n -> Maybe FilePath
_selectedFile :: !(Maybe FilePath)
    -- ^ Filepath to the current code viewport contents, if set.
    , forall n. AppState n -> SourceWindow n Text
_sourceWindow :: !(SourceWindow.SourceWindow n T.Text)
    , forall n. AppState n -> Int
_infoPanelSelectedModule :: !Int
    -- ^ Currently selected module in the info sidebar, zero indexed.
    , forall n. AppState n -> Map FilePath Text
sourceMap :: Map.Map FilePath T.Text
    -- ^ Mapping between source filepaths and their contents.
    , forall n. AppState n -> WidgetSizes
_currentWidgetSizes :: WidgetSizes
    -- ^ Current window/box/panel sizes (since it can change). Do not edit
    -- directly.
    , forall n. AppState n -> Bool
displayDebugConsoleLogs :: !Bool
    -- ^ Whether to display debug Console logs.
    , forall n. AppState n -> [Text]
debugConsoleLogs :: [Text]
    -- ^ Place for debug output to go.
    , forall n. AppState n -> Maybe Text
splashContents :: !(Maybe T.Text)
    -- ^ Splash to show on start up.
    }
    deriving (Int -> AppState n -> ShowS
[AppState n] -> ShowS
AppState n -> FilePath
(Int -> AppState n -> ShowS)
-> (AppState n -> FilePath)
-> ([AppState n] -> ShowS)
-> Show (AppState n)
forall n. Show n => Int -> AppState n -> ShowS
forall n. Show n => [AppState n] -> ShowS
forall n. Show n => AppState n -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall n. Show n => Int -> AppState n -> ShowS
showsPrec :: Int -> AppState n -> ShowS
$cshow :: forall n. Show n => AppState n -> FilePath
show :: AppState n -> FilePath
$cshowList :: forall n. Show n => [AppState n] -> ShowS
showList :: [AppState n] -> ShowS
Show)

newtype AppStateM m a = AppStateM {forall (m :: * -> *) a. AppStateM m a -> m a
runAppStateM :: m a}

instance (Functor m) => Functor (AppStateM m) where
    fmap :: forall a b. (a -> b) -> AppStateM m a -> AppStateM m b
fmap a -> b
f AppStateM m a
appStateA = m b -> AppStateM m b
forall (m :: * -> *) a. m a -> AppStateM m a
AppStateM (a -> b
f (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AppStateM m a -> m a
forall (m :: * -> *) a. AppStateM m a -> m a
runAppStateM AppStateM m a
appStateA)

instance (Applicative m) => Applicative (AppStateM m) where
    pure :: forall a. a -> AppStateM m a
pure a
appState = m a -> AppStateM m a
forall (m :: * -> *) a. m a -> AppStateM m a
AppStateM (a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
appState)
    AppStateM m (a -> b)
appl <*> :: forall a b. AppStateM m (a -> b) -> AppStateM m a -> AppStateM m b
<*> AppStateM m a
tgt = m b -> AppStateM m b
forall (m :: * -> *) a. m a -> AppStateM m a
AppStateM (m (a -> b)
appl m (a -> b) -> m a -> m b
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m a
tgt)

instance (Monad m) => Monad (AppStateM m) where
    return :: forall a. a -> AppStateM m a
return = a -> AppStateM m a
forall a. a -> AppStateM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    AppStateM m a
valM >>= :: forall a b. AppStateM m a -> (a -> AppStateM m b) -> AppStateM m b
>>= a -> AppStateM m b
f2 = m b -> AppStateM m b
forall (m :: * -> *) a. m a -> AppStateM m a
AppStateM (m a
valM m a -> (a -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= AppStateM m b -> m b
forall (m :: * -> *) a. AppStateM m a -> m a
runAppStateM (AppStateM m b -> m b) -> (a -> AppStateM m b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> AppStateM m b
f2)

instance (MonadIO m) => MonadIO (AppStateM m) where
    liftIO :: forall a. IO a -> AppStateM m a
liftIO = m a -> AppStateM m a
forall (m :: * -> *) a. m a -> AppStateM m a
AppStateM (m a -> AppStateM m a) -> (IO a -> m a) -> IO a -> AppStateM m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

-- | Lens for the App's interpreter box.
appInterpState :: Lens.Lens' (AppState n) (AIS.AppInterpState T.Text n)
appInterpState :: forall n (f :: * -> *).
Functor f =>
(AppInterpState Text n -> f (AppInterpState Text n))
-> AppState n -> f (AppState n)
appInterpState = (AppState n -> AppInterpState Text n)
-> (AppState n -> AppInterpState Text n -> AppState n)
-> Lens
     (AppState n)
     (AppState n)
     (AppInterpState Text n)
     (AppInterpState Text n)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens AppState n -> AppInterpState Text n
forall n. AppState n -> AppInterpState Text n
_appInterpState (\AppState n
x AppInterpState Text n
ais -> AppState n
x{_appInterpState = ais})

-- | Lens wrapper for zooming with handleEditorEvent.
liveEditor :: Lens.Lens' (AppState n) (BE.Editor T.Text n)
liveEditor :: forall n (f :: * -> *).
Functor f =>
(Editor Text n -> f (Editor Text n))
-> AppState n -> f (AppState n)
liveEditor = (AppInterpState Text n -> f (AppInterpState Text n))
-> AppState n -> f (AppState n)
forall n (f :: * -> *).
Functor f =>
(AppInterpState Text n -> f (AppInterpState Text n))
-> AppState n -> f (AppState n)
appInterpState ((AppInterpState Text n -> f (AppInterpState Text n))
 -> AppState n -> f (AppState n))
-> ((Editor Text n -> f (Editor Text n))
    -> AppInterpState Text n -> f (AppInterpState Text n))
-> (Editor Text n -> f (Editor Text n))
-> AppState n
-> f (AppState n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Editor Text n -> f (Editor Text n))
-> AppInterpState Text n -> f (AppInterpState Text n)
forall s n (f :: * -> *).
Functor f =>
(Editor s n -> f (Editor s n))
-> AppInterpState s n -> f (AppInterpState s n)
AIS.liveEditor

currentWidgetSizes :: Lens.Lens' (AppState n) WidgetSizes
currentWidgetSizes :: forall n (f :: * -> *).
Functor f =>
(WidgetSizes -> f WidgetSizes) -> AppState n -> f (AppState n)
currentWidgetSizes = (AppState n -> WidgetSizes)
-> (AppState n -> WidgetSizes -> AppState n)
-> Lens (AppState n) (AppState n) WidgetSizes WidgetSizes
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens AppState n -> WidgetSizes
forall n. AppState n -> WidgetSizes
_currentWidgetSizes (\AppState n
x WidgetSizes
cws -> AppState n
x{_currentWidgetSizes = cws})

wsInfoWidth :: Lens.Lens' WidgetSizes Int
wsInfoWidth :: Lens' WidgetSizes Int
wsInfoWidth = (WidgetSizes -> Int)
-> (WidgetSizes -> Int -> WidgetSizes) -> Lens' WidgetSizes Int
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens WidgetSizes -> Int
_wsInfoWidth (\WidgetSizes
x Int
ipw -> WidgetSizes
x{_wsInfoWidth = ipw})

wsReplHeight :: Lens.Lens' WidgetSizes Int
wsReplHeight :: Lens' WidgetSizes Int
wsReplHeight = (WidgetSizes -> Int)
-> (WidgetSizes -> Int -> WidgetSizes) -> Lens' WidgetSizes Int
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens WidgetSizes -> Int
_wsReplHeight (\WidgetSizes
x Int
rh -> WidgetSizes
x{_wsReplHeight = rh})

sourceWindow :: Lens.Lens' (AppState n) (SourceWindow.SourceWindow n T.Text)
sourceWindow :: forall n (f :: * -> *).
Functor f =>
(SourceWindow n Text -> f (SourceWindow n Text))
-> AppState n -> f (AppState n)
sourceWindow = (AppState n -> SourceWindow n Text)
-> (AppState n -> SourceWindow n Text -> AppState n)
-> Lens
     (AppState n)
     (AppState n)
     (SourceWindow n Text)
     (SourceWindow n Text)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens AppState n -> SourceWindow n Text
forall n. AppState n -> SourceWindow n Text
_sourceWindow (\AppState n
x SourceWindow n Text
srcW -> AppState n
x{_sourceWindow = srcW})

selectedFile :: AppState n -> Maybe FilePath
selectedFile :: forall n. AppState n -> Maybe FilePath
selectedFile = AppState n -> Maybe FilePath
forall n. AppState n -> Maybe FilePath
_selectedFile

setSelectedFile :: (MonadIO m) => Maybe FilePath -> AppState n -> m (AppState n)
setSelectedFile :: forall (m :: * -> *) n.
MonadIO m =>
Maybe FilePath -> AppState n -> m (AppState n)
setSelectedFile Maybe FilePath
mayFP AppState n
appState =
    if Maybe FilePath
mayFP Maybe FilePath -> Maybe FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== AppState n -> Maybe FilePath
forall n. AppState n -> Maybe FilePath
_selectedFile AppState n
appState
        then -- If we're selecting the same file again, do nothing.
            AppState n -> m (AppState n)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AppState n
appState
        else do
            -- Update the source map with the new file, and replace the window contents.
            AppState n
updatedAppState <- IO (AppState n) -> m (AppState n)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (AppState n) -> m (AppState n))
-> IO (AppState n) -> m (AppState n)
forall a b. (a -> b) -> a -> b
$ AppState n -> IO (AppState n)
forall n. AppState n -> IO (AppState n)
updateSourceMap AppState n
appState{_selectedFile = mayFP}
            let contents :: Maybe Text
contents = Maybe FilePath
mayFP Maybe FilePath -> (FilePath -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AppState n -> Map FilePath Text
forall n. AppState n -> Map FilePath Text
sourceMap AppState n
updatedAppState Map FilePath Text -> FilePath -> Maybe Text
forall k a. Ord k => Map k a -> k -> Maybe a
Map.!?)
            let elements :: Vector Text
elements = Vector Text -> (Text -> Vector Text) -> Maybe Text -> Vector Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Vector Text
forall a. Vector a
Vec.empty ([Text] -> Vector Text
forall a. [a] -> Vector a
Vec.fromList ([Text] -> Vector Text) -> (Text -> [Text]) -> Text -> Vector Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines) Maybe Text
contents
            let newSrcW :: SourceWindow n Text
newSrcW = Vector Text -> SourceWindow n Text -> SourceWindow n Text
forall (f :: * -> *) e n.
Foldable f =>
f e -> SourceWindow n e -> SourceWindow n e
SourceWindow.srcWindowReplace Vector Text
elements (AppState n
appState AppState n
-> Getting (SourceWindow n Text) (AppState n) (SourceWindow n Text)
-> SourceWindow n Text
forall s a. s -> Getting a s a -> a
^. Getting (SourceWindow n Text) (AppState n) (SourceWindow n Text)
forall n (f :: * -> *).
Functor f =>
(SourceWindow n Text -> f (SourceWindow n Text))
-> AppState n -> f (AppState n)
sourceWindow)
            AppState n -> m (AppState n)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AppState n
updatedAppState{_sourceWindow = newSrcW}

-- -------------------------------------------------------------------------------------------------
-- State Line Details
-- -------------------------------------------------------------------------------------------------

-- | Currently selected line number. One-indexed. If no line is selected, returns 1.
selectedLine :: AppState n -> Int
selectedLine :: forall n. AppState n -> Int
selectedLine AppState n
s = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 (AppState n
s AppState n
-> Getting (Maybe Int) (AppState n) (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^. (SourceWindow n Text -> Const (Maybe Int) (SourceWindow n Text))
-> AppState n -> Const (Maybe Int) (AppState n)
forall n (f :: * -> *).
Functor f =>
(SourceWindow n Text -> f (SourceWindow n Text))
-> AppState n -> f (AppState n)
sourceWindow ((SourceWindow n Text -> Const (Maybe Int) (SourceWindow n Text))
 -> AppState n -> Const (Maybe Int) (AppState n))
-> ((Maybe Int -> Const (Maybe Int) (Maybe Int))
    -> SourceWindow n Text -> Const (Maybe Int) (SourceWindow n Text))
-> Getting (Maybe Int) (AppState n) (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Int -> Const (Maybe Int) (Maybe Int))
-> SourceWindow n Text -> Const (Maybe Int) (SourceWindow n Text)
forall name elem (f :: * -> *).
Functor f =>
(Maybe Int -> f (Maybe Int))
-> SourceWindow name elem -> f (SourceWindow name elem)
SourceWindow.srcSelectedLineL)

-- | Reset the code viewport selected line to the pause location.
selectPausedLine :: (Ord n) => AppState n -> B.EventM n m (AppState n)
selectPausedLine :: forall n m. Ord n => AppState n -> EventM n m (AppState n)
selectPausedLine s :: AppState n
s@AppState{InterpState ()
$sel:interpState:AppState :: forall n. AppState n -> InterpState ()
interpState :: InterpState ()
interpState} = do
    AppState n
s' <- Maybe FilePath -> AppState n -> EventM n m (AppState n)
forall (m :: * -> *) n.
MonadIO m =>
Maybe FilePath -> AppState n -> m (AppState n)
setSelectedFile Maybe FilePath
ourSelectedFile AppState n
s
    let ourSelectedLine :: Int
        ourSelectedLine :: Int
ourSelectedLine =
            Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe
                (AppState n -> Int
forall n. AppState n -> Int
selectedLine AppState n
s')
                (SourceRange -> Maybe Int
Loc.startLine (SourceRange -> Maybe Int)
-> (FileLoc -> SourceRange) -> FileLoc -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileLoc -> SourceRange
Loc.fSourceRange (FileLoc -> Maybe Int) -> Maybe FileLoc -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< InterpState ()
interpState.pauseLoc)
    SourceWindow n Text
newSrcW <- Int -> SourceWindow n Text -> EventM n m (SourceWindow n Text)
forall n e m.
Ord n =>
Int -> SourceWindow n e -> EventM n m (SourceWindow n e)
SourceWindow.setSelectionTo Int
ourSelectedLine (AppState n
s' AppState n
-> Getting (SourceWindow n Text) (AppState n) (SourceWindow n Text)
-> SourceWindow n Text
forall s a. s -> Getting a s a -> a
^. Getting (SourceWindow n Text) (AppState n) (SourceWindow n Text)
forall n (f :: * -> *).
Functor f =>
(SourceWindow n Text -> f (SourceWindow n Text))
-> AppState n -> f (AppState n)
sourceWindow)
    AppState n -> EventM n m (AppState n)
forall a. a -> EventM n m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (AppState n -> EventM n m (AppState n))
-> (AppState n -> AppState n)
-> AppState n
-> EventM n m (AppState n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( \AppState n
s'' ->
                Text -> AppState n -> AppState n
forall n. Text -> AppState n -> AppState n
writeDebugLog
                    ( Text
"replacing source window. new line: "
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe Int -> Text
forall a. Show a => a -> Text
Util.showT (AppState n
s'' AppState n
-> Getting (Maybe Int) (AppState n) (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^. (SourceWindow n Text -> Const (Maybe Int) (SourceWindow n Text))
-> AppState n -> Const (Maybe Int) (AppState n)
forall n (f :: * -> *).
Functor f =>
(SourceWindow n Text -> f (SourceWindow n Text))
-> AppState n -> f (AppState n)
sourceWindow ((SourceWindow n Text -> Const (Maybe Int) (SourceWindow n Text))
 -> AppState n -> Const (Maybe Int) (AppState n))
-> ((Maybe Int -> Const (Maybe Int) (Maybe Int))
    -> SourceWindow n Text -> Const (Maybe Int) (SourceWindow n Text))
-> Getting (Maybe Int) (AppState n) (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Int -> Const (Maybe Int) (Maybe Int))
-> SourceWindow n Text -> Const (Maybe Int) (SourceWindow n Text)
forall name elem (f :: * -> *).
Functor f =>
(Maybe Int -> f (Maybe Int))
-> SourceWindow name elem -> f (SourceWindow name elem)
SourceWindow.srcSelectedLineL)
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" should be "
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
Util.showT Int
ourSelectedLine
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", window start "
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
Util.showT (AppState n
s'' AppState n -> Getting Int (AppState n) Int -> Int
forall s a. s -> Getting a s a -> a
^. (SourceWindow n Text -> Const Int (SourceWindow n Text))
-> AppState n -> Const Int (AppState n)
forall n (f :: * -> *).
Functor f =>
(SourceWindow n Text -> f (SourceWindow n Text))
-> AppState n -> f (AppState n)
sourceWindow ((SourceWindow n Text -> Const Int (SourceWindow n Text))
 -> AppState n -> Const Int (AppState n))
-> ((Int -> Const Int Int)
    -> SourceWindow n Text -> Const Int (SourceWindow n Text))
-> Getting Int (AppState n) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int)
-> SourceWindow n Text -> Const Int (SourceWindow n Text)
forall name elem (f :: * -> *).
Functor f =>
(Int -> f Int)
-> SourceWindow name elem -> f (SourceWindow name elem)
SourceWindow.srcWindowStartL)
                    )
                    AppState n
s''
          )
        (AppState n -> AppState n)
-> (AppState n -> AppState n) -> AppState n -> AppState n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter
  (AppState n)
  (AppState n)
  (SourceWindow n Text)
  (SourceWindow n Text)
-> SourceWindow n Text -> AppState n -> AppState n
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.set ASetter
  (AppState n)
  (AppState n)
  (SourceWindow n Text)
  (SourceWindow n Text)
forall n (f :: * -> *).
Functor f =>
(SourceWindow n Text -> f (SourceWindow n Text))
-> AppState n -> f (AppState n)
sourceWindow SourceWindow n Text
newSrcW
        (AppState n -> EventM n m (AppState n))
-> AppState n -> EventM n m (AppState n)
forall a b. (a -> b) -> a -> b
$ AppState n
s'
  where
    ourSelectedFile :: Maybe FilePath
ourSelectedFile = Maybe FilePath
-> (FileLoc -> Maybe FilePath) -> Maybe FileLoc -> Maybe FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (AppState n -> Maybe FilePath
forall n. AppState n -> Maybe FilePath
selectedFile AppState n
s) (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath)
-> (FileLoc -> FilePath) -> FileLoc -> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileLoc -> FilePath
Loc.filepath) InterpState ()
interpState.pauseLoc

-- | Write a debug log entry.
writeDebugLog :: T.Text -> AppState n -> AppState n
writeDebugLog :: forall n. Text -> AppState n -> AppState n
writeDebugLog Text
lg AppState n
s = AppState n
s{debugConsoleLogs = take 100 (lg : debugConsoleLogs s)}

toggleActiveLineInterpreter :: AppState n -> AppState n
toggleActiveLineInterpreter :: forall n. AppState n -> AppState n
toggleActiveLineInterpreter s :: AppState n
s@AppState{ActiveWindow
$sel:activeWindow:AppState :: forall n. AppState n -> ActiveWindow
activeWindow :: ActiveWindow
activeWindow} =
    AppState n
s{activeWindow = toggleLogic activeWindow}
  where
    toggleLogic :: ActiveWindow -> ActiveWindow
toggleLogic ActiveWindow
ActiveLiveInterpreter = ActiveWindow
ActiveCodeViewport
    toggleLogic ActiveWindow
_ = ActiveWindow
ActiveLiveInterpreter

-- | Update the source map given any app state changes.
updateSourceMap :: AppState n -> IO (AppState n)
updateSourceMap :: forall n. AppState n -> IO (AppState n)
updateSourceMap AppState n
s = do
    AppState n
s' <- case AppState n -> Maybe FilePath
forall n. AppState n -> Maybe FilePath
selectedFile AppState n
s of
        Just FilePath
sf -> AppState n -> FilePath -> IO (AppState n)
forall n. AppState n -> FilePath -> IO (AppState n)
updateSourceMapWithFilepath AppState n
s FilePath
sf
        Maybe FilePath
Nothing -> AppState n -> IO (AppState n)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AppState n
s
    case AppState n
s'.interpState.pauseLoc of
        Maybe FileLoc
Nothing -> AppState n -> IO (AppState n)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AppState n
s'
        (Just (Loc.FileLoc{FilePath
$sel:filepath:FileLoc :: FileLoc -> FilePath
filepath :: FilePath
filepath})) -> AppState n -> FilePath -> IO (AppState n)
forall n. AppState n -> FilePath -> IO (AppState n)
updateSourceMapWithFilepath AppState n
s' FilePath
filepath

-- | Update the source map with a given filepath.
updateSourceMapWithFilepath :: AppState n -> FilePath -> IO (AppState n)
updateSourceMapWithFilepath :: forall n. AppState n -> FilePath -> IO (AppState n)
updateSourceMapWithFilepath AppState n
s FilePath
filepath
    | FilePath -> Map FilePath Text -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member FilePath
filepath AppState n
s.sourceMap = AppState n -> IO (AppState n)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AppState n
s
    | Bool
otherwise = do
        let adjustedFilepath :: FilePath
adjustedFilepath = AppState n -> FilePath
forall n. AppState n -> FilePath
getCurrentWorkingDir AppState n
s FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"/" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
filepath
        Either IOException Text
eContents <- IO Text -> IO (Either IOException Text)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO Text -> IO (Either IOException Text))
-> IO Text -> IO (Either IOException Text)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Text
T.readFile FilePath
adjustedFilepath :: IO (Either IOException T.Text)
        case Either IOException Text
eContents of
            Left IOException
err -> do
                AppState n -> IO (AppState n)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AppState n -> IO (AppState n)) -> AppState n -> IO (AppState n)
forall a b. (a -> b) -> a -> b
$
                    Text -> AppState n -> AppState n
forall n. Text -> AppState n -> AppState n
writeDebugLog
                        ( Text
"failed to update source map with "
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
filepath
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": "
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (IOException -> FilePath
forall a. Show a => a -> FilePath
show IOException
err)
                        )
                        AppState n
s
            Right Text
contents -> do
                let newSourceMap :: Map FilePath Text
newSourceMap = FilePath -> Text -> Map FilePath Text -> Map FilePath Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert FilePath
filepath (Text -> Text
stripCREndings Text
contents) AppState n
s.sourceMap
                let logMsg :: Text
logMsg = Text
"updated source map with " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
filepath
                AppState n -> IO (AppState n)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> AppState n -> AppState n
forall n. Text -> AppState n -> AppState n
writeDebugLog Text
logMsg AppState n
s{sourceMap = newSourceMap})

-- | Remove CR line endings.
stripCREndings :: T.Text -> T.Text
stripCREndings :: Text -> Text
stripCREndings = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\r" Text
""

listAvailableSources :: AppState n -> [(T.Text, FilePath)]
listAvailableSources :: forall n. AppState n -> [(Text, FilePath)]
listAvailableSources = ModuleFileMap -> [(Text, FilePath)]
Loc.moduleFileMapAssocs (ModuleFileMap -> [(Text, FilePath)])
-> (AppState n -> ModuleFileMap)
-> AppState n
-> [(Text, FilePath)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InterpState () -> ModuleFileMap
forall a. InterpState a -> ModuleFileMap
Daemon.moduleFileMap (InterpState () -> ModuleFileMap)
-> (AppState n -> InterpState ()) -> AppState n -> ModuleFileMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState n -> InterpState ()
forall n. AppState n -> InterpState ()
interpState

-- | Return the potential contents of the current paused file location.
getSourceContents :: AppState n -> Maybe T.Text
getSourceContents :: forall n. AppState n -> Maybe Text
getSourceContents AppState n
s = AppState n -> Maybe FilePath
forall n. AppState n -> Maybe FilePath
selectedFile AppState n
s Maybe FilePath -> (FilePath -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AppState n -> Map FilePath Text
forall n. AppState n -> Map FilePath Text
sourceMap AppState n
s Map FilePath Text -> FilePath -> Maybe Text
forall k a. Ord k => Map k a -> k -> Maybe a
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 :: forall n. AppState n -> Maybe Int
getSourceLineCount AppState n
s = [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Text] -> Int) -> (Text -> [Text]) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines (Text -> Int) -> Maybe Text -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AppState n -> Maybe Text
forall n. AppState n -> Maybe Text
getSourceContents AppState n
s

changeInfoWidgetSize :: Int -> AppState n -> AppState n
changeInfoWidgetSize :: forall n. Int -> AppState n -> AppState n
changeInfoWidgetSize Int
amnt AppState n
s =
    ASetter (AppState n) (AppState n) Int Int
-> Int -> AppState n -> AppState n
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.set
        ((WidgetSizes -> Identity WidgetSizes)
-> AppState n -> Identity (AppState n)
forall n (f :: * -> *).
Functor f =>
(WidgetSizes -> f WidgetSizes) -> AppState n -> f (AppState n)
currentWidgetSizes ((WidgetSizes -> Identity WidgetSizes)
 -> AppState n -> Identity (AppState n))
-> ((Int -> Identity Int) -> WidgetSizes -> Identity WidgetSizes)
-> ASetter (AppState n) (AppState n) Int Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Identity Int) -> WidgetSizes -> Identity WidgetSizes
Lens' WidgetSizes Int
wsInfoWidth)
        -- Do not let the min go too low (<=2), because this causes a memory leak in Brick?
        ((Int, Int) -> Int -> Int
forall a. Ord a => (a, a) -> a -> a
Util.clamp (Int
10, Int
120) (AppState n -> Int
forall n. AppState n -> Int
getInfoWidth AppState n
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
amnt))
        AppState n
s

changeReplWidgetSize :: Int -> AppState n -> AppState n
changeReplWidgetSize :: forall n. Int -> AppState n -> AppState n
changeReplWidgetSize Int
amnt AppState n
s =
    ASetter (AppState n) (AppState n) Int Int
-> Int -> AppState n -> AppState n
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.set
        ((WidgetSizes -> Identity WidgetSizes)
-> AppState n -> Identity (AppState n)
forall n (f :: * -> *).
Functor f =>
(WidgetSizes -> f WidgetSizes) -> AppState n -> f (AppState n)
currentWidgetSizes ((WidgetSizes -> Identity WidgetSizes)
 -> AppState n -> Identity (AppState n))
-> ((Int -> Identity Int) -> WidgetSizes -> Identity WidgetSizes)
-> ASetter (AppState n) (AppState n) Int Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Identity Int) -> WidgetSizes -> Identity WidgetSizes
Lens' WidgetSizes Int
wsReplHeight)
        -- Do not let the min go too low, because the box disappears then.
        ((Int, Int) -> Int -> Int
forall a. Ord a => (a, a) -> a -> a
Util.clamp (Int
1, Int
80) (AppState n -> Int
forall n. AppState n -> Int
getReplHeight AppState n
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
amnt))
        AppState n
s

changeSelectedModuleInInfoPanel :: Int -> AppState n -> AppState n
changeSelectedModuleInInfoPanel :: forall n. Int -> AppState n -> AppState n
changeSelectedModuleInInfoPanel Int
amnt AppState n
s =
    AppState n
s{_infoPanelSelectedModule = newSelection}
  where
    newSelection :: Int
newSelection = (AppState n -> Int
forall n. AppState n -> Int
_infoPanelSelectedModule AppState n
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
amnt) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
numModules
    numModules :: Int
numModules = [(Text, FilePath)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ModuleFileMap -> [(Text, FilePath)]
Loc.moduleFileMapAssocs (InterpState () -> ModuleFileMap
forall a. InterpState a -> ModuleFileMap
Daemon.moduleFileMap (AppState n -> InterpState ()
forall n. AppState n -> InterpState ()
interpState AppState n
s)))

getSelectedModuleInInfoPanel :: AppState n -> Int
getSelectedModuleInInfoPanel :: forall n. AppState n -> Int
getSelectedModuleInInfoPanel = AppState n -> Int
forall n. AppState n -> Int
_infoPanelSelectedModule

-- | Return the info box's desired width in character columns.
getInfoWidth :: AppState n -> Int
getInfoWidth :: forall n. AppState n -> Int
getInfoWidth = WidgetSizes -> Int
_wsInfoWidth (WidgetSizes -> Int)
-> (AppState n -> WidgetSizes) -> AppState n -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState n -> WidgetSizes
forall n. AppState n -> WidgetSizes
_currentWidgetSizes

-- | Return the REPL (interactive interpreter)'s box in lines.
getReplHeight :: AppState n -> Int
getReplHeight :: forall n. AppState n -> Int
getReplHeight = WidgetSizes -> Int
_wsReplHeight (WidgetSizes -> Int)
-> (AppState n -> WidgetSizes) -> AppState n -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState n -> WidgetSizes
forall n. AppState n -> WidgetSizes
_currentWidgetSizes

filePathOfInfoSelectedModule :: AppState n -> Maybe FilePath
filePathOfInfoSelectedModule :: forall n. AppState n -> Maybe FilePath
filePathOfInfoSelectedModule AppState{InterpState ()
$sel:interpState:AppState :: forall n. AppState n -> InterpState ()
interpState :: InterpState ()
interpState, Int
$sel:_infoPanelSelectedModule:AppState :: forall n. AppState n -> Int
_infoPanelSelectedModule :: Int
_infoPanelSelectedModule} =
    ((Text, FilePath) -> FilePath)
-> Maybe (Text, FilePath) -> Maybe FilePath
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, FilePath) -> FilePath
forall a b. (a, b) -> b
snd
        (Maybe (Text, FilePath) -> Maybe FilePath)
-> (InterpState () -> Maybe (Text, FilePath))
-> InterpState ()
-> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Text, FilePath)] -> Int -> Maybe (Text, FilePath))
-> Int -> [(Text, FilePath)] -> Maybe (Text, FilePath)
forall a b c. (a -> b -> c) -> b -> a -> c
flip [(Text, FilePath)] -> Int -> Maybe (Text, FilePath)
forall a. [a] -> Int -> Maybe a
atMay Int
_infoPanelSelectedModule
        ([(Text, FilePath)] -> Maybe (Text, FilePath))
-> (InterpState () -> [(Text, FilePath)])
-> InterpState ()
-> Maybe (Text, FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleFileMap -> [(Text, FilePath)]
Loc.moduleFileMapAssocs
        (ModuleFileMap -> [(Text, FilePath)])
-> (InterpState () -> ModuleFileMap)
-> InterpState ()
-> [(Text, FilePath)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InterpState () -> ModuleFileMap
forall a. InterpState a -> ModuleFileMap
Daemon.moduleFileMap
        (InterpState () -> Maybe FilePath)
-> InterpState () -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ InterpState ()
interpState

-- | Initialise the state from the config.
makeInitialState
    :: AppConfig
    -- ^ Start up config.
    -> T.Text
    -- ^ Daemon command prefix.
    -> FilePath
    -- ^ Workding directory.
    -> IO (AppState AppName)
makeInitialState :: AppConfig -> Text -> FilePath -> IO (AppState AppName)
makeInitialState AppConfig
appConfig Text
target FilePath
cwd = do
    let cwd' :: FilePath
cwd' = if FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
cwd then FilePath
"." else FilePath
cwd
    let fullCmd :: Text
fullCmd = AppConfig -> Text
getCmd AppConfig
appConfig Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
target
    let logOutput :: LogOutput
logOutput = case AppConfig -> FilePath
getDebugLogPath AppConfig
appConfig of
            FilePath
"stderr" -> LogOutput
Daemon.LogOutputStdErr
            FilePath
"stdout" -> LogOutput
Daemon.LogOutputStdOut
            FilePath
filepath -> FilePath -> LogOutput
Daemon.LogOutputFile FilePath
filepath
    let logLevel :: LogLevel
logLevel = Int -> LogLevel
LogConfig.LogLevel (AppConfig -> Int
AppConfig.getVerbosity AppConfig
appConfig)
    let startupConfig :: StartupConfig
startupConfig =
            Daemon.StartupConfig
                { $sel:logLevel:StartupConfig :: LogLevel
Daemon.logLevel = LogLevel
logLevel
                , $sel:logOutput:StartupConfig :: LogOutput
Daemon.logOutput = LogOutput
logOutput
                }
    InterpState ()
interpState <-
        DaemonIO (InterpState ())
-> IO (Either DaemonError (InterpState ()))
forall r. DaemonIO r -> IO (Either DaemonError r)
Daemon.run (FilePath -> FilePath -> StartupConfig -> DaemonIO (InterpState ())
Daemon.startup (Text -> FilePath
T.unpack Text
fullCmd) FilePath
cwd' StartupConfig
startupConfig) IO (Either DaemonError (InterpState ()))
-> (Either DaemonError (InterpState ()) -> IO (InterpState ()))
-> IO (InterpState ())
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Right InterpState ()
iState -> InterpState () -> IO (InterpState ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure InterpState ()
iState
            Left DaemonError
er -> FilePath -> IO (InterpState ())
forall a. HasCallStack => FilePath -> a
error (DaemonError -> FilePath
forall a. Show a => a -> FilePath
show DaemonError
er)
    Maybe Text
splashContents <- AppConfig -> IO (Maybe Text)
forall s. IsString s => AppConfig -> IO (Maybe s)
AppConfig.loadStartupSplash AppConfig
appConfig
    let selectedFile' :: Maybe FilePath
selectedFile' =
            case ModuleFileMap -> [(Text, FilePath)]
Loc.moduleFileMapAssocs (InterpState () -> ModuleFileMap
forall a. InterpState a -> ModuleFileMap
Daemon.moduleFileMap InterpState ()
interpState) of
                -- If we just have one file, select that.
                [(Text
_, FilePath
filepath)] -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
filepath
                -- If we have no module/file mappings, nothing must be selected.
                [] -> Maybe FilePath
forall a. Maybe a
Nothing
                -- If we don't have a selected file, but we have a module loaded,
                -- select the last one.
                [(Text, FilePath)]
_ -> Maybe FilePath
forall a. Maybe a
Nothing
    AppState AppName -> IO (AppState AppName)
forall n. AppState n -> IO (AppState n)
updateSourceMap
        AppState
            { InterpState ()
$sel:interpState:AppState :: InterpState ()
interpState :: InterpState ()
interpState
            , $sel:getCurrentWorkingDir:AppState :: FilePath
getCurrentWorkingDir = FilePath
cwd'
            , $sel:_appInterpState:AppState :: AppInterpState Text AppName
_appInterpState = AppName -> AppInterpState Text AppName
forall n. n -> AppInterpState Text n
AIS.emptyAppInterpState AppName
LiveInterpreter
            , $sel:activeWindow:AppState :: ActiveWindow
activeWindow = ActiveWindow
ActiveCodeViewport
            , AppConfig
$sel:appConfig:AppState :: AppConfig
appConfig :: AppConfig
appConfig
            , $sel:debugConsoleLogs:AppState :: [Text]
debugConsoleLogs = [Text]
forall a. Monoid a => a
mempty
            , $sel:displayDebugConsoleLogs:AppState :: Bool
displayDebugConsoleLogs = AppConfig -> Bool
getDebugConsoleOnStart AppConfig
appConfig
            , $sel:interpLogs:AppState :: [Text]
interpLogs = [Text]
forall a. Monoid a => a
mempty
            , $sel:_selectedFile:AppState :: Maybe FilePath
_selectedFile = Maybe FilePath
selectedFile'
            , $sel:_infoPanelSelectedModule:AppState :: Int
_infoPanelSelectedModule = Int
0
            , $sel:sourceMap:AppState :: Map FilePath Text
sourceMap = Map FilePath Text
forall a. Monoid a => a
mempty
            , $sel:_currentWidgetSizes:AppState :: WidgetSizes
_currentWidgetSizes =
                WidgetSizes
                    { $sel:_wsInfoWidth:WidgetSizes :: Int
_wsInfoWidth = Int
35
                    , $sel:_wsReplHeight:WidgetSizes :: Int
_wsReplHeight = Int
11 -- 10 plus 1 for the entry line.
                    }
            , Maybe Text
$sel:splashContents:AppState :: Maybe Text
splashContents :: Maybe Text
splashContents
            , $sel:_sourceWindow:AppState :: SourceWindow AppName Text
_sourceWindow = AppName -> Text -> SourceWindow AppName Text
forall n. n -> Text -> SourceWindow n Text
SourceWindow.mkSourcWindow AppName
SourceList Text
""
            }