{-# LANGUAGE RecordWildCards #-}

module Ghcitui.Brick.AppInterpState
    ( AppInterpState (_liveEditor, _viewLock, _commandBuffer, historyPos)
    , commandBuffer
    , emptyAppInterpState
    , futHistoryPos
    , cmdHistory
    , isScanningHist
    , liveEditor
    , pastHistoryPos
    , pushHistory
    , viewLock
    ) where

import qualified Brick.Widgets.Edit as BE
import qualified Data.Text as T
import Lens.Micro as Lens

{- | The state of the Live Interpreter (GHCi) window. The one at the bottom of
     the TUI normally. It's solely visual TUI state. It holds bits of Brick state,
     and only Brick-related things. For example, the last things you ran in the terminal,
     whether you're scrolling the history, and what's the current command buffer.
-}
data AppInterpState s n = AppInterpState
    { forall s n. AppInterpState s n -> Editor s n
_liveEditor :: !(BE.Editor s n)
    -- ^ Brick editor for the actual interactive prompt.
    , forall s n. AppInterpState s n -> Bool
_viewLock :: !Bool
    -- ^ Whether we're locked to the bottom of the interpreter (True) window or not (False).
    , forall s n. AppInterpState s n -> [s]
_commandBuffer :: ![s]
    -- ^ The text currently typed into the editor, but not yet executed or in the history.
    , forall s n. AppInterpState s n -> [[s]]
_cmdHistory :: ![[s]]
    , forall s n. AppInterpState s n -> Int
historyPos :: !Int
    -- ^ Current position
    }
    deriving (Int -> AppInterpState s n -> ShowS
[AppInterpState s n] -> ShowS
AppInterpState s n -> String
(Int -> AppInterpState s n -> ShowS)
-> (AppInterpState s n -> String)
-> ([AppInterpState s n] -> ShowS)
-> Show (AppInterpState s n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall s n. (Show s, Show n) => Int -> AppInterpState s n -> ShowS
forall s n. (Show s, Show n) => [AppInterpState s n] -> ShowS
forall s n. (Show s, Show n) => AppInterpState s n -> String
$cshowsPrec :: forall s n. (Show s, Show n) => Int -> AppInterpState s n -> ShowS
showsPrec :: Int -> AppInterpState s n -> ShowS
$cshow :: forall s n. (Show s, Show n) => AppInterpState s n -> String
show :: AppInterpState s n -> String
$cshowList :: forall s n. (Show s, Show n) => [AppInterpState s n] -> ShowS
showList :: [AppInterpState s n] -> ShowS
Show)

-- | Lens accessor for the editor. See '_liveEditor'.
liveEditor :: Lens.Lens' (AppInterpState s n) (BE.Editor s n)
liveEditor :: forall s n (f :: * -> *).
Functor f =>
(Editor s n -> f (Editor s n))
-> AppInterpState s n -> f (AppInterpState s n)
liveEditor = (AppInterpState s n -> Editor s n)
-> (AppInterpState s n -> Editor s n -> AppInterpState s n)
-> Lens
     (AppInterpState s n) (AppInterpState s n) (Editor s n) (Editor s n)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens AppInterpState s n -> Editor s n
forall s n. AppInterpState s n -> Editor s n
_liveEditor (\AppInterpState s n
ais Editor s n
le -> AppInterpState s n
ais{_liveEditor = le})

-- | Lens for the view lock setting. See '_viewLock'.
viewLock :: Lens.Lens' (AppInterpState s n) Bool
viewLock :: forall s n (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> AppInterpState s n -> f (AppInterpState s n)
viewLock = (AppInterpState s n -> Bool)
-> (AppInterpState s n -> Bool -> AppInterpState s n)
-> Lens (AppInterpState s n) (AppInterpState s n) Bool Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens AppInterpState s n -> Bool
forall s n. AppInterpState s n -> Bool
_viewLock (\AppInterpState s n
ais Bool
x -> AppInterpState s n
ais{_viewLock = x})

-- | Lens for the current contents of the command line buffer. See '_commandBuffer'.
commandBuffer :: Lens.Lens' (AppInterpState s n) [s]
commandBuffer :: forall s n (f :: * -> *).
Functor f =>
([s] -> f [s]) -> AppInterpState s n -> f (AppInterpState s n)
commandBuffer = (AppInterpState s n -> [s])
-> (AppInterpState s n -> [s] -> AppInterpState s n)
-> Lens (AppInterpState s n) (AppInterpState s n) [s] [s]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens AppInterpState s n -> [s]
forall s n. AppInterpState s n -> [s]
_commandBuffer (\AppInterpState s n
ais [s]
x -> AppInterpState s n
ais{_commandBuffer = x})

{- | Return the interpreter command history (what you've typed in the past.)
     Sorted most recent first, oldest last.
-}
cmdHistory :: AppInterpState s n -> [[s]]
cmdHistory :: forall s n. AppInterpState s n -> [[s]]
cmdHistory = AppInterpState s n -> [[s]]
forall s n. AppInterpState s n -> [[s]]
_cmdHistory

-- | Create a base interpreter state.
emptyAppInterpState
    :: n
    -- ^ Name for the 'Brick.Editor'.
    -> AppInterpState T.Text n
emptyAppInterpState :: forall n. n -> AppInterpState Text n
emptyAppInterpState n
name =
    AppInterpState
        { $sel:_liveEditor:AppInterpState :: Editor Text n
_liveEditor = n -> Maybe Int -> Editor Text n
forall n. n -> Maybe Int -> Editor Text n
initInterpWidget n
name (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1)
        , $sel:_viewLock:AppInterpState :: Bool
_viewLock = Bool
True
        , $sel:_commandBuffer:AppInterpState :: [Text]
_commandBuffer = [Text]
forall a. Monoid a => a
mempty
        , $sel:_cmdHistory:AppInterpState :: [[Text]]
_cmdHistory = [[Text]]
forall a. Monoid a => a
mempty
        , $sel:historyPos:AppInterpState :: Int
historyPos = Int
0
        }

resetHistoryPos :: AppInterpState s n -> AppInterpState s n
resetHistoryPos :: forall s n. AppInterpState s n -> AppInterpState s n
resetHistoryPos AppInterpState s n
s = AppInterpState s n
s{historyPos = 0}

-- | Move interpreter history back.
pastHistoryPos :: AppInterpState s n -> AppInterpState s n
pastHistoryPos :: forall s n. AppInterpState s n -> AppInterpState s n
pastHistoryPos s :: AppInterpState s n
s@AppInterpState{Bool
Int
[s]
[[s]]
Editor s n
$sel:_liveEditor:AppInterpState :: forall s n. AppInterpState s n -> Editor s n
$sel:_viewLock:AppInterpState :: forall s n. AppInterpState s n -> Bool
$sel:_commandBuffer:AppInterpState :: forall s n. AppInterpState s n -> [s]
$sel:historyPos:AppInterpState :: forall s n. AppInterpState s n -> Int
$sel:_cmdHistory:AppInterpState :: forall s n. AppInterpState s n -> [[s]]
_liveEditor :: Editor s n
_viewLock :: Bool
_commandBuffer :: [s]
_cmdHistory :: [[s]]
historyPos :: Int
..} =
    -- Note we do want it to stop at length _history, not length _history - 1
    -- because 0 is not the beginning of the history, it's the commandBuffer.
    AppInterpState s n
s{historyPos = min (length _cmdHistory) $ succ historyPos}

-- | Are we currently viewing past contents?
isScanningHist :: AppInterpState s n -> Bool
isScanningHist :: forall s n. AppInterpState s n -> Bool
isScanningHist AppInterpState{Bool
Int
[s]
[[s]]
Editor s n
$sel:_liveEditor:AppInterpState :: forall s n. AppInterpState s n -> Editor s n
$sel:_viewLock:AppInterpState :: forall s n. AppInterpState s n -> Bool
$sel:_commandBuffer:AppInterpState :: forall s n. AppInterpState s n -> [s]
$sel:historyPos:AppInterpState :: forall s n. AppInterpState s n -> Int
$sel:_cmdHistory:AppInterpState :: forall s n. AppInterpState s n -> [[s]]
_liveEditor :: Editor s n
_viewLock :: Bool
_commandBuffer :: [s]
_cmdHistory :: [[s]]
historyPos :: Int
..} = Int
historyPos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0

-- | Move interpreter history forward.
futHistoryPos :: AppInterpState s n -> AppInterpState s n
futHistoryPos :: forall s n. AppInterpState s n -> AppInterpState s n
futHistoryPos s :: AppInterpState s n
s@AppInterpState{Bool
Int
[s]
[[s]]
Editor s n
$sel:_liveEditor:AppInterpState :: forall s n. AppInterpState s n -> Editor s n
$sel:_viewLock:AppInterpState :: forall s n. AppInterpState s n -> Bool
$sel:_commandBuffer:AppInterpState :: forall s n. AppInterpState s n -> [s]
$sel:historyPos:AppInterpState :: forall s n. AppInterpState s n -> Int
$sel:_cmdHistory:AppInterpState :: forall s n. AppInterpState s n -> [[s]]
_liveEditor :: Editor s n
_viewLock :: Bool
_commandBuffer :: [s]
_cmdHistory :: [[s]]
historyPos :: Int
..} = AppInterpState s n
s{historyPos = max 0 $ pred historyPos}

-- | Push a new value on to the history stack and reset the position.
pushHistory :: [s] -> AppInterpState s n -> AppInterpState s n
pushHistory :: forall s n. [s] -> AppInterpState s n -> AppInterpState s n
pushHistory [s]
cmdLines AppInterpState s n
s = AppInterpState s n -> AppInterpState s n
forall s n. AppInterpState s n -> AppInterpState s n
resetHistoryPos (AppInterpState s n -> AppInterpState s n)
-> AppInterpState s n -> AppInterpState s n
forall a b. (a -> b) -> a -> b
$ AppInterpState s n
s{_cmdHistory = cmdLines : cmdHistory s}

-- | Create the initial live interpreter widget object.
initInterpWidget
    :: n
    -- ^ Editor name (must be a unique identifier).
    -> Maybe Int
    -- ^ Line height of the editor. Nothing for unlimited.
    -> BE.Editor T.Text n
initInterpWidget :: forall n. n -> Maybe Int -> Editor Text n
initInterpWidget n
name Maybe Int
height = n -> Maybe Int -> Text -> Editor Text n
forall n. n -> Maybe Int -> Text -> Editor Text n
BE.editorText n
name Maybe Int
height Text
forall a. Monoid a => a
mempty