module Ribosome.Menu.Prompt.Run where

import Conduit (ConduitT, MonadResource, await, awaitForever, bracketP, evalStateC, yield, (.|))
import Data.Conduit.Combinators (peek)
import Data.Conduit.TMChan (TMChan, closeTMChan, newTMChan, sourceTMChan)
import qualified Data.Text as Text (drop, dropEnd, isPrefixOf, length, splitAt)
import Prelude hiding (state)

import Ribosome.Control.Monad.Ribo (MonadRibo)
import Ribosome.Data.Conduit (mergeSources)
import Ribosome.Log (logDebug)
import Ribosome.Menu.Prompt.Data.CursorUpdate (CursorUpdate)
import qualified Ribosome.Menu.Prompt.Data.CursorUpdate as CursorUpdate (CursorUpdate(..))
import Ribosome.Menu.Prompt.Data.Prompt (Prompt(Prompt))
import Ribosome.Menu.Prompt.Data.PromptConfig (PromptConfig(PromptConfig), PromptFlag, onlyInsert, startInsert)
import Ribosome.Menu.Prompt.Data.PromptConsumed (PromptConsumed)
import qualified Ribosome.Menu.Prompt.Data.PromptConsumed as PromptConsumed (PromptConsumed(..))
import Ribosome.Menu.Prompt.Data.PromptConsumerUpdate (PromptConsumerUpdate(PromptConsumerUpdate))
import Ribosome.Menu.Prompt.Data.PromptEvent (PromptEvent)
import qualified Ribosome.Menu.Prompt.Data.PromptEvent as PromptEvent (PromptEvent(..))
import Ribosome.Menu.Prompt.Data.PromptRenderer (PromptRenderer(PromptRenderer))
import Ribosome.Menu.Prompt.Data.PromptState (PromptState)
import qualified Ribosome.Menu.Prompt.Data.PromptState as PromptState (PromptState(..))
import Ribosome.Menu.Prompt.Data.PromptUpdate (PromptUpdate(PromptUpdate))
import Ribosome.Menu.Prompt.Data.TextUpdate (TextUpdate)
import qualified Ribosome.Menu.Prompt.Data.TextUpdate as TextUpdate (TextUpdate(..))

updateCursor :: Int -> Text -> CursorUpdate -> Int
updateCursor :: Int -> Text -> CursorUpdate -> Int
updateCursor Int
current Text
text =
  CursorUpdate -> Int
update
  where
    update :: CursorUpdate -> Int
update CursorUpdate
CursorUpdate.OneLeft | Int
current Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 =
      Int
current Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    update CursorUpdate
CursorUpdate.OneLeft =
      Int
current
    update CursorUpdate
CursorUpdate.OneRight | Int
current Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
textLength =
      Int
current Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    update CursorUpdate
CursorUpdate.OneRight =
      Int
current
    update CursorUpdate
CursorUpdate.Prepend =
      Int
0
    update CursorUpdate
CursorUpdate.Append =
      Text -> Int
Text.length Text
text Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    update (CursorUpdate.Index Int
index) =
      Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
textLength (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
index)
    update CursorUpdate
CursorUpdate.Unmodified =
      Int
current
    textLength :: Int
textLength =
      Text -> Int
Text.length Text
text

updateText :: Int -> Text -> TextUpdate -> Text
updateText :: Int -> Text -> TextUpdate -> Text
updateText Int
cursor Text
text =
  TextUpdate -> Text
update
  where
    update :: TextUpdate -> Text
update TextUpdate
TextUpdate.Unmodified =
      Text
text
    update (TextUpdate.Insert Text
new) =
      Text
pre Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
new Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
post
    update TextUpdate
TextUpdate.DeleteLeft =
      Int -> Text -> Text
Text.dropEnd Int
1 Text
pre Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
post
    update TextUpdate
TextUpdate.DeleteRight =
      Text
pre Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.drop Int
1 Text
post
    update (TextUpdate.Set Text
newText) =
      Text
newText
    (Text
pre, Text
post) = Int -> Text -> (Text, Text)
Text.splitAt Int
cursor Text
text

updatePrompt ::
  Monad m =>
  (PromptEvent -> PromptState -> m PromptUpdate) ->
  PromptEvent ->
  Prompt ->
  m (PromptConsumed, Prompt)
updatePrompt :: (PromptEvent -> PromptState -> m PromptUpdate)
-> PromptEvent -> Prompt -> m (PromptConsumed, Prompt)
updatePrompt PromptEvent -> PromptState -> m PromptUpdate
modes PromptEvent
update (Prompt Int
cursor PromptState
state Text
text) = do
  (PromptUpdate PromptState
newState CursorUpdate
cursorUpdate TextUpdate
textUpdate PromptConsumed
consumed) <- PromptEvent -> PromptState -> m PromptUpdate
modes PromptEvent
update PromptState
state
  let
    updatedText :: Text
updatedText =
      Int -> Text -> TextUpdate -> Text
updateText Int
cursor Text
text TextUpdate
textUpdate
    newPrompt :: Prompt
newPrompt =
      Int -> PromptState -> Text -> Prompt
Prompt (Int -> Text -> CursorUpdate -> Int
updateCursor Int
cursor Text
updatedText CursorUpdate
cursorUpdate) PromptState
newState Text
updatedText
  (PromptConsumed, Prompt) -> m (PromptConsumed, Prompt)
forall (m :: * -> *) a. Monad m => a -> m a
return (PromptConsumed
consumed, Prompt
newPrompt)

processPromptEvent ::
  MonadIO m =>
  MonadRibo m =>
  PromptConfig m ->
  PromptEvent ->
  ConduitT PromptEvent PromptConsumerUpdate (StateT Prompt m) ()
processPromptEvent :: PromptConfig m
-> PromptEvent
-> ConduitT PromptEvent PromptConsumerUpdate (StateT Prompt m) ()
processPromptEvent (PromptConfig ConduitT () PromptEvent m ()
_ [PromptFlag] -> PromptEvent -> PromptState -> m PromptUpdate
modes (PromptRenderer m a
_ a -> m ()
_ Prompt -> m ()
render) [PromptFlag]
flags) PromptEvent
event = do
  forall a (m :: * -> *). (Loggable a, MonadRibo m) => a -> m ()
forall (m :: * -> *). (Loggable Text, MonadRibo m) => Text -> m ()
logDebug @Text (Text
 -> ConduitT PromptEvent PromptConsumerUpdate (StateT Prompt m) ())
-> Text
-> ConduitT PromptEvent PromptConsumerUpdate (StateT Prompt m) ()
forall a b. (a -> b) -> a -> b
$ Text
"prompt event: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PromptEvent -> Text
forall b a. (Show a, IsString b) => a -> b
show PromptEvent
event
  PromptConsumed
consumed <- StateT Prompt m PromptConsumed
-> ConduitT
     PromptEvent PromptConsumerUpdate (StateT Prompt m) PromptConsumed
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT Prompt m PromptConsumed
 -> ConduitT
      PromptEvent PromptConsumerUpdate (StateT Prompt m) PromptConsumed)
-> ((Prompt -> StateT Prompt m (PromptConsumed, Prompt))
    -> StateT Prompt m PromptConsumed)
-> (Prompt -> StateT Prompt m (PromptConsumed, Prompt))
-> ConduitT
     PromptEvent PromptConsumerUpdate (StateT Prompt m) PromptConsumed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Prompt -> StateT Prompt m (PromptConsumed, Prompt))
-> StateT Prompt m PromptConsumed
forall s s' (m :: * -> *) a.
MonadDeepState s s' m =>
(s' -> m (a, s')) -> m a
stateM ((Prompt -> StateT Prompt m (PromptConsumed, Prompt))
 -> ConduitT
      PromptEvent PromptConsumerUpdate (StateT Prompt m) PromptConsumed)
-> (Prompt -> StateT Prompt m (PromptConsumed, Prompt))
-> ConduitT
     PromptEvent PromptConsumerUpdate (StateT Prompt m) PromptConsumed
forall a b. (a -> b) -> a -> b
$ m (PromptConsumed, Prompt)
-> StateT Prompt m (PromptConsumed, Prompt)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (PromptConsumed, Prompt)
 -> StateT Prompt m (PromptConsumed, Prompt))
-> (Prompt -> m (PromptConsumed, Prompt))
-> Prompt
-> StateT Prompt m (PromptConsumed, Prompt)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PromptEvent -> PromptState -> m PromptUpdate)
-> PromptEvent -> Prompt -> m (PromptConsumed, Prompt)
forall (m :: * -> *).
Monad m =>
(PromptEvent -> PromptState -> m PromptUpdate)
-> PromptEvent -> Prompt -> m (PromptConsumed, Prompt)
updatePrompt ([PromptFlag] -> PromptEvent -> PromptState -> m PromptUpdate
modes [PromptFlag]
flags) PromptEvent
event
  Prompt
newPrompt <- ConduitT PromptEvent PromptConsumerUpdate (StateT Prompt m) Prompt
forall s s' (m :: * -> *). MonadDeepState s s' m => m s'
get
  PromptConsumerUpdate
-> ConduitT PromptEvent PromptConsumerUpdate (StateT Prompt m) ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (PromptEvent -> Prompt -> PromptConsumed -> PromptConsumerUpdate
PromptConsumerUpdate PromptEvent
event Prompt
newPrompt PromptConsumed
consumed)
  StateT Prompt m ()
-> ConduitT PromptEvent PromptConsumerUpdate (StateT Prompt m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT Prompt m ()
 -> ConduitT PromptEvent PromptConsumerUpdate (StateT Prompt m) ())
-> (Prompt -> StateT Prompt m ())
-> Prompt
-> ConduitT PromptEvent PromptConsumerUpdate (StateT Prompt m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m () -> StateT Prompt m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT Prompt m ())
-> (Prompt -> m ()) -> Prompt -> StateT Prompt m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prompt -> m ()
render (Prompt
 -> ConduitT PromptEvent PromptConsumerUpdate (StateT Prompt m) ())
-> Prompt
-> ConduitT PromptEvent PromptConsumerUpdate (StateT Prompt m) ()
forall a b. (a -> b) -> a -> b
$ Prompt
newPrompt

skippingRenderer ::
  Monad m =>
  (Prompt -> m ()) ->
  ConduitT PromptConsumerUpdate PromptConsumerUpdate m ()
skippingRenderer :: (Prompt -> m ())
-> ConduitT PromptConsumerUpdate PromptConsumerUpdate m ()
skippingRenderer Prompt -> m ()
render =
  ConduitT PromptConsumerUpdate PromptConsumerUpdate m ()
go
  where
    go :: ConduitT PromptConsumerUpdate PromptConsumerUpdate m ()
go =
      Maybe PromptConsumerUpdate
-> ConduitT PromptConsumerUpdate PromptConsumerUpdate m ()
check (Maybe PromptConsumerUpdate
 -> ConduitT PromptConsumerUpdate PromptConsumerUpdate m ())
-> ConduitT
     PromptConsumerUpdate
     PromptConsumerUpdate
     m
     (Maybe PromptConsumerUpdate)
-> ConduitT PromptConsumerUpdate PromptConsumerUpdate m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ConduitT
  PromptConsumerUpdate
  PromptConsumerUpdate
  m
  (Maybe PromptConsumerUpdate)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await
    check :: Maybe PromptConsumerUpdate
-> ConduitT PromptConsumerUpdate PromptConsumerUpdate m ()
check (Just next :: PromptConsumerUpdate
next@(PromptConsumerUpdate PromptEvent
_ Prompt
prompt PromptConsumed
_)) = do
      PromptConsumerUpdate
-> ConduitT PromptConsumerUpdate PromptConsumerUpdate m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield PromptConsumerUpdate
next
      Prompt
-> Maybe PromptConsumerUpdate
-> ConduitT PromptConsumerUpdate PromptConsumerUpdate m ()
renderIfIdle Prompt
prompt (Maybe PromptConsumerUpdate
 -> ConduitT PromptConsumerUpdate PromptConsumerUpdate m ())
-> ConduitT
     PromptConsumerUpdate
     PromptConsumerUpdate
     m
     (Maybe PromptConsumerUpdate)
-> ConduitT PromptConsumerUpdate PromptConsumerUpdate m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ConduitT
  PromptConsumerUpdate
  PromptConsumerUpdate
  m
  (Maybe PromptConsumerUpdate)
forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
peek
      ConduitT PromptConsumerUpdate PromptConsumerUpdate m ()
go
    check Maybe PromptConsumerUpdate
Nothing =
      () -> ConduitT PromptConsumerUpdate PromptConsumerUpdate m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    renderIfIdle :: Prompt
-> Maybe PromptConsumerUpdate
-> ConduitT PromptConsumerUpdate PromptConsumerUpdate m ()
renderIfIdle Prompt
_ (Just PromptConsumerUpdate
_) =
      () -> ConduitT PromptConsumerUpdate PromptConsumerUpdate m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    renderIfIdle Prompt
prompt Maybe PromptConsumerUpdate
Nothing =
      m () -> ConduitT PromptConsumerUpdate PromptConsumerUpdate m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Prompt -> m ()
render Prompt
prompt)

promptWithBackchannel ::
  MonadRibo m =>
  MonadResource m =>
  MonadBaseControl IO m =>
  PromptConfig m ->
  TMChan PromptEvent ->
  ConduitT () PromptConsumerUpdate m ()
promptWithBackchannel :: PromptConfig m
-> TMChan PromptEvent -> ConduitT () PromptConsumerUpdate m ()
promptWithBackchannel config :: PromptConfig m
config@(PromptConfig ConduitT () PromptEvent m ()
source [PromptFlag] -> PromptEvent -> PromptState -> m PromptUpdate
_ (PromptRenderer m a
_ a -> m ()
_ Prompt -> m ()
render) [PromptFlag]
_) TMChan PromptEvent
chan =
  Int
-> [ConduitT () PromptEvent m ()] -> ConduitT () PromptEvent m ()
forall (m :: * -> *) a.
(MonadResource m, MonadBaseControl IO m) =>
Int -> [ConduitT () a m ()] -> ConduitT () a m ()
mergeSources Int
64 [Item [ConduitT () PromptEvent m ()]
ConduitT () PromptEvent m ()
sourceWithInit, TMChan PromptEvent -> ConduitT () PromptEvent m ()
forall (m :: * -> *) a. MonadIO m => TMChan a -> ConduitT () a m ()
sourceTMChan TMChan PromptEvent
chan] ConduitT () PromptEvent m ()
-> ConduitM PromptEvent PromptConsumerUpdate m ()
-> ConduitT () PromptConsumerUpdate m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM PromptEvent PromptConsumerUpdate m ()
process ConduitM PromptEvent PromptConsumerUpdate m ()
-> ConduitM PromptConsumerUpdate PromptConsumerUpdate m ()
-> ConduitM PromptEvent PromptConsumerUpdate m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (Prompt -> m ())
-> ConduitM PromptConsumerUpdate PromptConsumerUpdate m ()
forall (m :: * -> *).
Monad m =>
(Prompt -> m ())
-> ConduitT PromptConsumerUpdate PromptConsumerUpdate m ()
skippingRenderer Prompt -> m ()
render
  where
    sourceWithInit :: ConduitT () PromptEvent m ()
sourceWithInit =
      PromptEvent -> ConduitT () PromptEvent m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield PromptEvent
PromptEvent.Init ConduitT () PromptEvent m ()
-> ConduitT () PromptEvent m () -> ConduitT () PromptEvent m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ConduitT () PromptEvent m ()
source ConduitT () PromptEvent m ()
-> ConduitT () PromptEvent m () -> ConduitT () PromptEvent m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* STM () -> ConduitT () PromptEvent m ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (TMChan PromptEvent -> STM ()
forall a. TMChan a -> STM ()
closeTMChan TMChan PromptEvent
chan)
    process :: ConduitM PromptEvent PromptConsumerUpdate m ()
process =
      Prompt
-> ConduitT PromptEvent PromptConsumerUpdate (StateT Prompt m) ()
-> ConduitM PromptEvent PromptConsumerUpdate m ()
forall (m :: * -> *) s i o r.
Monad m =>
s -> ConduitT i o (StateT s m) r -> ConduitT i o m r
evalStateC (Bool -> Prompt
pristinePrompt (PromptConfig m -> Bool
forall a. TestPromptFlag a => a -> Bool
startInsert PromptConfig m
config)) ((PromptEvent
 -> ConduitT PromptEvent PromptConsumerUpdate (StateT Prompt m) ())
-> ConduitT PromptEvent PromptConsumerUpdate (StateT Prompt m) ()
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
awaitForever (PromptConfig m
-> PromptEvent
-> ConduitT PromptEvent PromptConsumerUpdate (StateT Prompt m) ()
forall (m :: * -> *).
(MonadIO m, MonadRibo m) =>
PromptConfig m
-> PromptEvent
-> ConduitT PromptEvent PromptConsumerUpdate (StateT Prompt m) ()
processPromptEvent PromptConfig m
config))

promptC ::
  MonadRibo m =>
  MonadResource m =>
  MonadBaseControl IO m =>
  PromptConfig m ->
  m (TMChan PromptEvent, ConduitT () PromptConsumerUpdate m ())
promptC :: PromptConfig m
-> m (TMChan PromptEvent, ConduitT () PromptConsumerUpdate m ())
promptC PromptConfig m
config = do
  TMChan PromptEvent
chan <- STM (TMChan PromptEvent) -> m (TMChan PromptEvent)
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically STM (TMChan PromptEvent)
forall a. STM (TMChan a)
newTMChan
  return (TMChan PromptEvent
chan, IO (TMChan PromptEvent)
-> (TMChan PromptEvent -> IO ())
-> (TMChan PromptEvent -> ConduitT () PromptConsumerUpdate m ())
-> ConduitT () PromptConsumerUpdate m ()
forall (m :: * -> *) a i o r.
MonadResource m =>
IO a -> (a -> IO ()) -> (a -> ConduitT i o m r) -> ConduitT i o m r
bracketP (TMChan PromptEvent -> IO (TMChan PromptEvent)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TMChan PromptEvent
chan) TMChan PromptEvent -> IO ()
forall (m :: * -> *) a. MonadIO m => TMChan a -> m ()
release (PromptConfig m
-> TMChan PromptEvent -> ConduitT () PromptConsumerUpdate m ()
forall (m :: * -> *).
(MonadRibo m, MonadResource m, MonadBaseControl IO m) =>
PromptConfig m
-> TMChan PromptEvent -> ConduitT () PromptConsumerUpdate m ()
promptWithBackchannel PromptConfig m
config))
  where
    release :: TMChan a -> m ()
release TMChan a
chan =
      STM () -> m ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> m ()) -> STM () -> m ()
forall a b. (a -> b) -> a -> b
$ TMChan a -> STM ()
forall a. TMChan a -> STM ()
closeTMChan TMChan a
chan

unprocessableChars :: [Text]
unprocessableChars :: [Text]
unprocessableChars =
  [
    Item [Text]
"cr",
    Item [Text]
"tab"
    ]

unprocessable :: Text -> Bool
unprocessable :: Text -> Bool
unprocessable Text
char =
  Text
char Text -> [Text] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [Text]
unprocessableChars Bool -> Bool -> Bool
|| Text -> Text -> Bool
Text.isPrefixOf Text
"c-" Text
char

consumeUnmodified :: PromptState -> CursorUpdate -> PromptUpdate
consumeUnmodified :: PromptState -> CursorUpdate -> PromptUpdate
consumeUnmodified PromptState
s CursorUpdate
u =
  PromptState
-> CursorUpdate -> TextUpdate -> PromptConsumed -> PromptUpdate
PromptUpdate PromptState
s CursorUpdate
u TextUpdate
TextUpdate.Unmodified PromptConsumed
PromptConsumed.Yes

basicTransitionNormal ::
  PromptEvent ->
  PromptUpdate
basicTransitionNormal :: PromptEvent -> PromptUpdate
basicTransitionNormal (PromptEvent.Character Text
"esc") =
  PromptState -> CursorUpdate -> PromptUpdate
consumeUnmodified PromptState
PromptState.Quit CursorUpdate
CursorUpdate.Unmodified
basicTransitionNormal (PromptEvent.Character Text
"q") =
  PromptState -> CursorUpdate -> PromptUpdate
consumeUnmodified PromptState
PromptState.Quit CursorUpdate
CursorUpdate.Unmodified
basicTransitionNormal (PromptEvent.Character Text
"i") =
  PromptState -> CursorUpdate -> PromptUpdate
consumeUnmodified PromptState
PromptState.Insert CursorUpdate
CursorUpdate.Unmodified
basicTransitionNormal (PromptEvent.Character Text
"I") =
  PromptState -> CursorUpdate -> PromptUpdate
consumeUnmodified PromptState
PromptState.Insert CursorUpdate
CursorUpdate.Prepend
basicTransitionNormal (PromptEvent.Character Text
"a") =
  PromptState -> CursorUpdate -> PromptUpdate
consumeUnmodified PromptState
PromptState.Insert CursorUpdate
CursorUpdate.OneRight
basicTransitionNormal (PromptEvent.Character Text
"A") =
  PromptState -> CursorUpdate -> PromptUpdate
consumeUnmodified PromptState
PromptState.Insert CursorUpdate
CursorUpdate.Append
basicTransitionNormal (PromptEvent.Character Text
"h") =
  PromptState -> CursorUpdate -> PromptUpdate
consumeUnmodified PromptState
PromptState.Normal CursorUpdate
CursorUpdate.OneLeft
basicTransitionNormal (PromptEvent.Character Text
"l") =
  PromptState -> CursorUpdate -> PromptUpdate
consumeUnmodified PromptState
PromptState.Normal CursorUpdate
CursorUpdate.OneRight
basicTransitionNormal (PromptEvent.Character Text
"x") =
  PromptState
-> CursorUpdate -> TextUpdate -> PromptConsumed -> PromptUpdate
PromptUpdate PromptState
PromptState.Normal CursorUpdate
CursorUpdate.OneLeft TextUpdate
TextUpdate.DeleteRight PromptConsumed
PromptConsumed.Yes
basicTransitionNormal PromptEvent
_ =
  PromptState
-> CursorUpdate -> TextUpdate -> PromptConsumed -> PromptUpdate
PromptUpdate PromptState
PromptState.Normal CursorUpdate
CursorUpdate.Unmodified TextUpdate
TextUpdate.Unmodified PromptConsumed
PromptConsumed.No

basicTransitionInsert ::
  [PromptFlag] ->
  PromptEvent ->
  PromptUpdate
basicTransitionInsert :: [PromptFlag] -> PromptEvent -> PromptUpdate
basicTransitionInsert [PromptFlag]
flags =
  PromptEvent -> PromptUpdate
trans
  where
    trans :: PromptEvent -> PromptUpdate
trans (PromptEvent.Character Text
"esc") | [PromptFlag] -> Bool
forall a. TestPromptFlag a => a -> Bool
onlyInsert [PromptFlag]
flags =
      PromptState
-> CursorUpdate -> TextUpdate -> PromptConsumed -> PromptUpdate
PromptUpdate PromptState
PromptState.Quit CursorUpdate
CursorUpdate.Unmodified TextUpdate
TextUpdate.Unmodified PromptConsumed
PromptConsumed.Yes
    trans (PromptEvent.Character Text
"esc") =
      PromptUpdate
normal
    trans (PromptEvent.Character Text
"c-n") =
      PromptUpdate
normal
    trans (PromptEvent.Character Text
"bs") =
      CursorUpdate -> TextUpdate -> PromptConsumed -> PromptUpdate
insert CursorUpdate
CursorUpdate.OneLeft TextUpdate
TextUpdate.DeleteLeft PromptConsumed
PromptConsumed.Yes
    trans (PromptEvent.Character Text
c) | Text -> Bool
unprocessable Text
c =
      CursorUpdate -> TextUpdate -> PromptConsumed -> PromptUpdate
insert CursorUpdate
CursorUpdate.Unmodified TextUpdate
TextUpdate.Unmodified PromptConsumed
PromptConsumed.No
    trans (PromptEvent.Character Text
"space") =
      CursorUpdate -> TextUpdate -> PromptConsumed -> PromptUpdate
insert CursorUpdate
CursorUpdate.OneRight (Text -> TextUpdate
TextUpdate.Insert Text
" ") PromptConsumed
PromptConsumed.Yes
    trans (PromptEvent.Character Text
c) =
      CursorUpdate -> TextUpdate -> PromptConsumed -> PromptUpdate
insert CursorUpdate
CursorUpdate.OneRight (Text -> TextUpdate
TextUpdate.Insert Text
c) PromptConsumed
PromptConsumed.Yes
    trans PromptEvent
_ =
      CursorUpdate -> TextUpdate -> PromptConsumed -> PromptUpdate
insert CursorUpdate
CursorUpdate.Unmodified TextUpdate
TextUpdate.Unmodified PromptConsumed
PromptConsumed.No
    insert :: CursorUpdate -> TextUpdate -> PromptConsumed -> PromptUpdate
insert =
      PromptState
-> CursorUpdate -> TextUpdate -> PromptConsumed -> PromptUpdate
PromptUpdate PromptState
PromptState.Insert
    normal :: PromptUpdate
normal =
      PromptState
-> CursorUpdate -> TextUpdate -> PromptConsumed -> PromptUpdate
PromptUpdate PromptState
PromptState.Normal CursorUpdate
CursorUpdate.OneLeft TextUpdate
TextUpdate.Unmodified PromptConsumed
PromptConsumed.Yes

basicTransition ::
  Monad m =>
  [PromptFlag] ->
  PromptEvent ->
  PromptState ->
  m PromptUpdate
basicTransition :: [PromptFlag] -> PromptEvent -> PromptState -> m PromptUpdate
basicTransition [PromptFlag]
_ (PromptEvent.Set (Prompt Int
cursor PromptState
state Text
text)) PromptState
_ =
  PromptUpdate -> m PromptUpdate
forall (m :: * -> *) a. Monad m => a -> m a
return (PromptUpdate -> m PromptUpdate) -> PromptUpdate -> m PromptUpdate
forall a b. (a -> b) -> a -> b
$ PromptState
-> CursorUpdate -> TextUpdate -> PromptConsumed -> PromptUpdate
PromptUpdate PromptState
state (Int -> CursorUpdate
CursorUpdate.Index Int
cursor) (Text -> TextUpdate
TextUpdate.Set Text
text) PromptConsumed
PromptConsumed.Yes
basicTransition [PromptFlag]
_ PromptEvent
event PromptState
PromptState.Normal =
  PromptUpdate -> m PromptUpdate
forall (m :: * -> *) a. Monad m => a -> m a
return (PromptUpdate -> m PromptUpdate) -> PromptUpdate -> m PromptUpdate
forall a b. (a -> b) -> a -> b
$ PromptEvent -> PromptUpdate
basicTransitionNormal PromptEvent
event
basicTransition [PromptFlag]
flags PromptEvent
event PromptState
PromptState.Insert =
  PromptUpdate -> m PromptUpdate
forall (m :: * -> *) a. Monad m => a -> m a
return (PromptUpdate -> m PromptUpdate) -> PromptUpdate -> m PromptUpdate
forall a b. (a -> b) -> a -> b
$ [PromptFlag] -> PromptEvent -> PromptUpdate
basicTransitionInsert [PromptFlag]
flags PromptEvent
event
basicTransition [PromptFlag]
_ PromptEvent
_ PromptState
PromptState.Quit =
  PromptUpdate -> m PromptUpdate
forall (m :: * -> *) a. Monad m => a -> m a
return (PromptUpdate -> m PromptUpdate) -> PromptUpdate -> m PromptUpdate
forall a b. (a -> b) -> a -> b
$ PromptState
-> CursorUpdate -> TextUpdate -> PromptConsumed -> PromptUpdate
PromptUpdate PromptState
PromptState.Quit CursorUpdate
CursorUpdate.Unmodified TextUpdate
TextUpdate.Unmodified PromptConsumed
PromptConsumed.No

pristinePrompt :: Bool -> Prompt
pristinePrompt :: Bool -> Prompt
pristinePrompt Bool
insert =
  Int -> PromptState -> Text -> Prompt
Prompt Int
0 (if Bool
insert then PromptState
PromptState.Insert else PromptState
PromptState.Normal) Text
""

noPromptRenderer ::
  Applicative m =>
  PromptRenderer m
noPromptRenderer :: PromptRenderer m
noPromptRenderer =
  m () -> (() -> m ()) -> (Prompt -> m ()) -> PromptRenderer m
forall (m :: * -> *) a.
m a -> (a -> m ()) -> (Prompt -> m ()) -> PromptRenderer m
PromptRenderer m ()
forall (f :: * -> *). Applicative f => f ()
unit (m () -> () -> m ()
forall a b. a -> b -> a
const m ()
forall (f :: * -> *). Applicative f => f ()
unit) (m () -> Prompt -> m ()
forall a b. a -> b -> a
const m ()
forall (f :: * -> *). Applicative f => f ()
unit)