ribosome-0.3.0.0: lib/Ribosome/Menu/Prompt/Run.hs

module Ribosome.Menu.Prompt.Run where

import Conduit (ConduitT, await, awaitForever, evalStateC, yield, (.|))
import Data.Conduit.Combinators (peek)
import qualified Data.Text as Text (drop, dropEnd, length, splitAt)

import Ribosome.Control.Monad.Ribo (MonadRibo)
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))
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 current text =
  update
  where
    update CursorUpdate.OneLeft | current > 0 =
      current - 1
    update CursorUpdate.OneRight | current <= Text.length text =
      current + 1
    update CursorUpdate.Prepend =
      0
    update CursorUpdate.Append =
      Text.length text + 1
    update _ =
      current

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

updatePrompt ::
  Monad m =>
  (PromptEvent -> PromptState -> m PromptUpdate) ->
  PromptEvent ->
  Prompt ->
  m (PromptConsumed, Prompt)
updatePrompt modes update (Prompt cursor state text) = do
  (PromptUpdate newState cursorUpdate textUpdate consumed) <- modes update state
  let
    newPrompt =
      Prompt (updateCursor cursor text cursorUpdate) newState (updateText cursor text textUpdate)
  return (consumed, newPrompt)

processPromptEvent ::
  MonadIO m =>
  MonadRibo m =>
  PromptConfig m ->
  PromptEvent ->
  ConduitT PromptEvent PromptConsumerUpdate (StateT Prompt m) ()
processPromptEvent (PromptConfig _ modes (PromptRenderer _ _ render) _) event = do
  logDebug @Text $ "prompt event: " <> show event
  consumed <- lift . stateM $ lift . updatePrompt modes event
  newPrompt <- get
  yield (PromptConsumerUpdate event newPrompt consumed)
  lift . lift . render $ newPrompt

skippingRenderer ::
  Monad m =>
  (Prompt -> m ()) ->
  ConduitT PromptConsumerUpdate PromptConsumerUpdate m ()
skippingRenderer render =
  go
  where
    go =
      check =<< await
    check (Just next@(PromptConsumerUpdate _ prompt _)) = do
      yield next
      renderIfIdle prompt =<< peek
      go
    check Nothing =
      return ()
    renderIfIdle _ (Just _) =
      return ()
    renderIfIdle prompt Nothing =
      lift (render prompt)

promptC ::
  MonadIO m =>
  MonadRibo m =>
  PromptConfig m ->
  ConduitT () PromptConsumerUpdate m ()
promptC config@(PromptConfig source _ (PromptRenderer _ _ render) insert) =
  sourceWithInit .| process .| skippingRenderer render
  where
    sourceWithInit =
      yield PromptEvent.Init *> source
    process =
      evalStateC (pristinePrompt insert) (awaitForever (processPromptEvent config))

unprocessable :: [Text]
unprocessable =
  [
    "cr"
    ]

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

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

basicTransitionInsert ::
  PromptEvent ->
  PromptUpdate
basicTransitionInsert (PromptEvent.Character "esc") =
  PromptUpdate PromptState.Normal CursorUpdate.OneLeft TextUpdate.Unmodified PromptConsumed.Yes
basicTransitionInsert (PromptEvent.Character "bs") =
  PromptUpdate PromptState.Insert CursorUpdate.OneLeft TextUpdate.DeleteLeft PromptConsumed.Yes
basicTransitionInsert (PromptEvent.Character c) | c `elem` unprocessable =
  PromptUpdate PromptState.Insert CursorUpdate.Unmodified TextUpdate.Unmodified PromptConsumed.No
basicTransitionInsert (PromptEvent.Character c) =
  PromptUpdate PromptState.Insert CursorUpdate.OneRight (TextUpdate.Insert c) PromptConsumed.Yes
basicTransitionInsert _ =
  PromptUpdate PromptState.Insert CursorUpdate.Unmodified TextUpdate.Unmodified PromptConsumed.No

basicTransition ::
  Monad m =>
  PromptEvent ->
  PromptState ->
  m PromptUpdate
basicTransition event PromptState.Normal =
  return $ basicTransitionNormal event
basicTransition event PromptState.Insert =
  return $ basicTransitionInsert event
basicTransition _ PromptState.Quit =
  return $ PromptUpdate PromptState.Quit CursorUpdate.Unmodified TextUpdate.Unmodified PromptConsumed.No

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

noPromptRenderer ::
  Applicative m =>
  PromptRenderer m
noPromptRenderer =
  PromptRenderer unit (const unit) (const unit)