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)