module Ribosome.Menu.Run where

import Conduit (ConduitT, MonadResource, await, awaitForever, mapC, runConduit, yield, (.|))
import Control.Concurrent.STM.TMChan (TMChan, writeTMChan)
import Control.Exception.Lifted (bracket)
import Control.Lens (over, set, view)
import Data.Conduit.Combinators (iterM)
import qualified Data.Conduit.Combinators as Conduit (last)
import Data.Conduit.Lift (evalStateC)
import qualified Data.Text as Text

import Ribosome.Api.Window (closeWindow)
import Ribosome.Config.Setting (settingOr)
import qualified Ribosome.Config.Settings as Settings
import Ribosome.Control.Monad.Ribo (MonadRibo, NvimE)
import Ribosome.Data.Conduit (mergeSources)
import Ribosome.Data.Scratch (scratchWindow)
import Ribosome.Data.ScratchOptions (ScratchOptions)
import qualified Ribosome.Data.ScratchOptions as ScratchOptions (size, syntax)
import Ribosome.Data.WindowConfig (WindowConfig(WindowConfig))
import Ribosome.Log (showDebug)
import Ribosome.Menu.Data.Menu (Menu)
import qualified Ribosome.Menu.Data.Menu as Menu (maxItems)
import Ribosome.Menu.Data.MenuAction (MenuAction)
import qualified Ribosome.Menu.Data.MenuAction as MenuAction (MenuAction(..))
import Ribosome.Menu.Data.MenuConfig (MenuConfig(MenuConfig))
import qualified Ribosome.Menu.Data.MenuConfig as MenuConfig (prompt)
import Ribosome.Menu.Data.MenuConsumer (MenuConsumer(MenuConsumer))
import Ribosome.Menu.Data.MenuEvent (MenuEvent, QuitReason)
import qualified Ribosome.Menu.Data.MenuEvent as MenuEvent (MenuEvent(..))
import qualified Ribosome.Menu.Data.MenuEvent as QuitReason (QuitReason(..))
import Ribosome.Menu.Data.MenuItem (MenuItem)
import qualified Ribosome.Menu.Data.MenuItem as MenuItem (MenuItem(_text))
import Ribosome.Menu.Data.MenuRenderEvent (MenuRenderEvent)
import qualified Ribosome.Menu.Data.MenuRenderEvent as MenuRenderEvent (MenuRenderEvent(..))
import Ribosome.Menu.Data.MenuResult (MenuResult)
import qualified Ribosome.Menu.Data.MenuResult as MenuResult (MenuResult(..))
import Ribosome.Menu.Data.MenuUpdate (MenuUpdate(MenuUpdate))
import Ribosome.Menu.Nvim (menuSyntax, renderNvimMenu)
import Ribosome.Menu.Prompt.Data.Prompt (Prompt(Prompt))
import Ribosome.Menu.Prompt.Data.PromptConfig (PromptConfig)
import qualified Ribosome.Menu.Prompt.Data.PromptConfig as PromptConfig (render)
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 qualified Ribosome.Menu.Prompt.Data.PromptState as PromptState (PromptState(..))
import Ribosome.Menu.Prompt.Run (promptC)
import Ribosome.Msgpack.Decode (fromMsgpack)
import Ribosome.Msgpack.Encode (MsgpackEncode(toMsgpack))
import Ribosome.Msgpack.Error (DecodeError)
import Ribosome.Nvim.Api.Data (Window)
import Ribosome.Nvim.Api.IO (nvimWinGetConfig, vimCallFunction, vimGetWindows, windowSetOption)
import Ribosome.Scratch (showInScratch)

promptEvent ::
  PromptEvent ->
  Prompt ->
  PromptConsumed ->
  MenuEvent m a i
promptEvent :: PromptEvent -> Prompt -> PromptConsumed -> MenuEvent m a i
promptEvent PromptEvent
_ (Prompt Int
_ PromptState
PromptState.Quit Text
_) PromptConsumed
_ =
  QuitReason m a -> MenuEvent m a i
forall (m :: * -> *) a i. QuitReason m a -> MenuEvent m a i
MenuEvent.Quit QuitReason m a
forall (m :: * -> *) a. QuitReason m a
QuitReason.Aborted
promptEvent (PromptEvent.Character Text
a) Prompt
prompt PromptConsumed
PromptConsumed.No =
  Text -> Prompt -> MenuEvent m a i
forall (m :: * -> *) a i. Text -> Prompt -> MenuEvent m a i
MenuEvent.Mapping Text
a Prompt
prompt
promptEvent (PromptEvent.Character Text
_) prompt :: Prompt
prompt@(Prompt Int
_ PromptState
PromptState.Insert Text
_) PromptConsumed
_ =
  Prompt -> MenuEvent m a i
forall (m :: * -> *) a i. Prompt -> MenuEvent m a i
MenuEvent.PromptChange Prompt
prompt
promptEvent (PromptEvent.Character Text
_) Prompt
prompt PromptConsumed
PromptConsumed.Yes =
  Prompt -> MenuEvent m a i
forall (m :: * -> *) a i. Prompt -> MenuEvent m a i
MenuEvent.PromptChange Prompt
prompt
promptEvent (PromptEvent.Set Prompt
_) Prompt
prompt PromptConsumed
_ =
  Prompt -> MenuEvent m a i
forall (m :: * -> *) a i. Prompt -> MenuEvent m a i
MenuEvent.PromptChange Prompt
prompt
promptEvent PromptEvent
PromptEvent.Init Prompt
prompt PromptConsumed
_ =
  Prompt -> MenuEvent m a i
forall (m :: * -> *) a i. Prompt -> MenuEvent m a i
MenuEvent.Init Prompt
prompt
promptEvent (PromptEvent.Unexpected Int
code) Prompt
_ PromptConsumed
_ =
  QuitReason m a -> MenuEvent m a i
forall (m :: * -> *) a i. QuitReason m a -> MenuEvent m a i
MenuEvent.Quit (QuitReason m a -> MenuEvent m a i)
-> (Text -> QuitReason m a) -> Text -> MenuEvent m a i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> QuitReason m a
forall (m :: * -> *) a. Text -> QuitReason m a
QuitReason.PromptError (Text -> MenuEvent m a i) -> Text -> MenuEvent m a i
forall a b. (a -> b) -> a -> b
$ Text
"unexpected input character code: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
code
promptEvent PromptEvent
PromptEvent.Interrupt Prompt
_ PromptConsumed
_ =
  QuitReason m a -> MenuEvent m a i
forall (m :: * -> *) a i. QuitReason m a -> MenuEvent m a i
MenuEvent.Quit QuitReason m a
forall (m :: * -> *) a. QuitReason m a
QuitReason.Aborted
promptEvent (PromptEvent.Error Text
e) Prompt
_ PromptConsumed
_ =
  QuitReason m a -> MenuEvent m a i
forall (m :: * -> *) a i. QuitReason m a -> MenuEvent m a i
MenuEvent.Quit (Text -> QuitReason m a
forall (m :: * -> *) a. Text -> QuitReason m a
QuitReason.PromptError Text
e)

menuEvent ::
  Either PromptConsumerUpdate [MenuItem i] ->
  MenuEvent m a i
menuEvent :: Either PromptConsumerUpdate [MenuItem i] -> MenuEvent m a i
menuEvent =
  (PromptConsumerUpdate -> MenuEvent m a i)
-> ([MenuItem i] -> MenuEvent m a i)
-> Either PromptConsumerUpdate [MenuItem i]
-> MenuEvent m a i
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either PromptConsumerUpdate -> MenuEvent m a i
forall (m :: * -> *) a i. PromptConsumerUpdate -> MenuEvent m a i
promptUpdate [MenuItem i] -> MenuEvent m a i
forall (m :: * -> *) a i. [MenuItem i] -> MenuEvent m a i
MenuEvent.NewItems
  where
    promptUpdate :: PromptConsumerUpdate -> MenuEvent m a i
promptUpdate (PromptConsumerUpdate PromptEvent
event Prompt
prompt PromptConsumed
consumed) =
      PromptEvent -> Prompt -> PromptConsumed -> MenuEvent m a i
forall (m :: * -> *) a i.
PromptEvent -> Prompt -> PromptConsumed -> MenuEvent m a i
promptEvent PromptEvent
event Prompt
prompt PromptConsumed
consumed

updateMenu ::
  MonadRibo m =>
  TMChan PromptEvent ->
  MenuConsumer m a i ->
  Either PromptConsumerUpdate [MenuItem i] ->
  ConduitT (Either PromptConsumerUpdate [MenuItem i]) (MenuRenderEvent m a i) (StateT (Menu i) m) ()
updateMenu :: TMChan PromptEvent
-> MenuConsumer m a i
-> Either PromptConsumerUpdate [MenuItem i]
-> ConduitT
     (Either PromptConsumerUpdate [MenuItem i])
     (MenuRenderEvent m a i)
     (StateT (Menu i) m)
     ()
updateMenu TMChan PromptEvent
backchannel (MenuConsumer MenuUpdate m a i -> m (MenuAction m a, Menu i)
consumer) Either PromptConsumerUpdate [MenuItem i]
input = do
  Text
-> Either PromptConsumerUpdate [Text]
-> ConduitT
     (Either PromptConsumerUpdate [MenuItem i])
     (MenuRenderEvent m a i)
     (StateT (Menu i) m)
     ()
forall a (m :: * -> *). (Show a, MonadRibo m) => Text -> a -> m ()
showDebug Text
"menu update:" (MenuItem i -> Text
forall a. MenuItem a -> Text
MenuItem._text (MenuItem i -> Text)
-> Either PromptConsumerUpdate [MenuItem i]
-> Either PromptConsumerUpdate [Text]
forall (f0 :: * -> *) (f1 :: * -> *) a b.
(Functor f0, Functor f1) =>
(a -> b) -> f1 (f0 a) -> f1 (f0 b)
<$$> Either PromptConsumerUpdate [MenuItem i]
input)
  MenuAction m a
action <- StateT (Menu i) m (MenuAction m a)
-> ConduitT
     (Either PromptConsumerUpdate [MenuItem i])
     (MenuRenderEvent m a i)
     (StateT (Menu i) m)
     (MenuAction m a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (Menu i) m (MenuAction m a)
 -> ConduitT
      (Either PromptConsumerUpdate [MenuItem i])
      (MenuRenderEvent m a i)
      (StateT (Menu i) m)
      (MenuAction m a))
-> ((Menu i -> StateT (Menu i) m (MenuAction m a, Menu i))
    -> StateT (Menu i) m (MenuAction m a))
-> (Menu i -> StateT (Menu i) m (MenuAction m a, Menu i))
-> ConduitT
     (Either PromptConsumerUpdate [MenuItem i])
     (MenuRenderEvent m a i)
     (StateT (Menu i) m)
     (MenuAction m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu i -> StateT (Menu i) m (MenuAction m a, Menu i))
-> StateT (Menu i) m (MenuAction m a)
forall s s' (m :: * -> *) a.
MonadDeepState s s' m =>
(s' -> m (a, s')) -> m a
stateM ((Menu i -> StateT (Menu i) m (MenuAction m a, Menu i))
 -> ConduitT
      (Either PromptConsumerUpdate [MenuItem i])
      (MenuRenderEvent m a i)
      (StateT (Menu i) m)
      (MenuAction m a))
-> (Menu i -> StateT (Menu i) m (MenuAction m a, Menu i))
-> ConduitT
     (Either PromptConsumerUpdate [MenuItem i])
     (MenuRenderEvent m a i)
     (StateT (Menu i) m)
     (MenuAction m a)
forall a b. (a -> b) -> a -> b
$ m (MenuAction m a, Menu i)
-> StateT (Menu i) m (MenuAction m a, Menu i)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (MenuAction m a, Menu i)
 -> StateT (Menu i) m (MenuAction m a, Menu i))
-> (Menu i -> m (MenuAction m a, Menu i))
-> Menu i
-> StateT (Menu i) m (MenuAction m a, Menu i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MenuUpdate m a i -> m (MenuAction m a, Menu i)
consumer (MenuUpdate m a i -> m (MenuAction m a, Menu i))
-> (Menu i -> MenuUpdate m a i)
-> Menu i
-> m (MenuAction m a, Menu i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MenuEvent m a i -> Menu i -> MenuUpdate m a i
forall (m :: * -> *) a i.
MenuEvent m a i -> Menu i -> MenuUpdate m a i
MenuUpdate (Either PromptConsumerUpdate [MenuItem i] -> MenuEvent m a i
forall i (m :: * -> *) a.
Either PromptConsumerUpdate [MenuItem i] -> MenuEvent m a i
menuEvent Either PromptConsumerUpdate [MenuItem i]
input)
  Text
-> MenuAction m a
-> ConduitT
     (Either PromptConsumerUpdate [MenuItem i])
     (MenuRenderEvent m a i)
     (StateT (Menu i) m)
     ()
forall a (m :: * -> *). (Show a, MonadRibo m) => Text -> a -> m ()
showDebug Text
"menu action:" MenuAction m a
action
  MenuAction m a
-> ConduitT
     (Either PromptConsumerUpdate [MenuItem i])
     (MenuRenderEvent m a i)
     (StateT (Menu i) m)
     ()
emit MenuAction m a
action
  where
    emit :: MenuAction m a
-> ConduitT
     (Either PromptConsumerUpdate [MenuItem i])
     (MenuRenderEvent m a i)
     (StateT (Menu i) m)
     ()
emit MenuAction m a
MenuAction.Continue =
      ()
-> ConduitT
     (Either PromptConsumerUpdate [MenuItem i])
     (MenuRenderEvent m a i)
     (StateT (Menu i) m)
     ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    emit (MenuAction.Execute m ()
thunk) =
      StateT (Menu i) m ()
-> ConduitT
     (Either PromptConsumerUpdate [MenuItem i])
     (MenuRenderEvent m a i)
     (StateT (Menu i) m)
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (Menu i) m ()
 -> ConduitT
      (Either PromptConsumerUpdate [MenuItem i])
      (MenuRenderEvent m a i)
      (StateT (Menu i) m)
      ())
-> StateT (Menu i) m ()
-> ConduitT
     (Either PromptConsumerUpdate [MenuItem i])
     (MenuRenderEvent m a i)
     (StateT (Menu i) m)
     ()
forall a b. (a -> b) -> a -> b
$ m () -> StateT (Menu i) m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ()
thunk
    emit (MenuAction.Render Bool
changed) =
      MenuRenderEvent m a i
-> ConduitT
     (Either PromptConsumerUpdate [MenuItem i])
     (MenuRenderEvent m a i)
     (StateT (Menu i) m)
     ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (MenuRenderEvent m a i
 -> ConduitT
      (Either PromptConsumerUpdate [MenuItem i])
      (MenuRenderEvent m a i)
      (StateT (Menu i) m)
      ())
-> (Menu i -> MenuRenderEvent m a i)
-> Menu i
-> ConduitT
     (Either PromptConsumerUpdate [MenuItem i])
     (MenuRenderEvent m a i)
     (StateT (Menu i) m)
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Menu i -> MenuRenderEvent m a i
forall (m :: * -> *) a i. Bool -> Menu i -> MenuRenderEvent m a i
MenuRenderEvent.Render Bool
changed (Menu i
 -> ConduitT
      (Either PromptConsumerUpdate [MenuItem i])
      (MenuRenderEvent m a i)
      (StateT (Menu i) m)
      ())
-> ConduitT
     (Either PromptConsumerUpdate [MenuItem i])
     (MenuRenderEvent m a i)
     (StateT (Menu i) m)
     (Menu i)
-> ConduitT
     (Either PromptConsumerUpdate [MenuItem i])
     (MenuRenderEvent m a i)
     (StateT (Menu i) m)
     ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ConduitT
  (Either PromptConsumerUpdate [MenuItem i])
  (MenuRenderEvent m a i)
  (StateT (Menu i) m)
  (Menu i)
forall s s' (m :: * -> *). MonadDeepState s s' m => m s'
get
    emit (MenuAction.UpdatePrompt Prompt
prompt) =
      STM ()
-> ConduitT
     (Either PromptConsumerUpdate [MenuItem i])
     (MenuRenderEvent m a i)
     (StateT (Menu i) m)
     ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM ()
 -> ConduitT
      (Either PromptConsumerUpdate [MenuItem i])
      (MenuRenderEvent m a i)
      (StateT (Menu i) m)
      ())
-> STM ()
-> ConduitT
     (Either PromptConsumerUpdate [MenuItem i])
     (MenuRenderEvent m a i)
     (StateT (Menu i) m)
     ()
forall a b. (a -> b) -> a -> b
$ TMChan PromptEvent -> PromptEvent -> STM ()
forall a. TMChan a -> a -> STM ()
writeTMChan TMChan PromptEvent
backchannel (Prompt -> PromptEvent
PromptEvent.Set Prompt
prompt)
    emit (MenuAction.Quit QuitReason m a
reason) =
      MenuRenderEvent m a i
-> ConduitT
     (Either PromptConsumerUpdate [MenuItem i])
     (MenuRenderEvent m a i)
     (StateT (Menu i) m)
     ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (QuitReason m a -> MenuRenderEvent m a i
forall (m :: * -> *) a i. QuitReason m a -> MenuRenderEvent m a i
MenuRenderEvent.Quit QuitReason m a
reason)

menuTerminator ::
  Monad m =>
  ConduitT (MenuRenderEvent m a i) (QuitReason m a) m ()
menuTerminator :: ConduitT (MenuRenderEvent m a i) (QuitReason m a) m ()
menuTerminator =
  (MenuRenderEvent m a i
 -> ConduitT (MenuRenderEvent m a i) (QuitReason m a) m ())
-> Maybe (MenuRenderEvent m a i)
-> ConduitT (MenuRenderEvent m a i) (QuitReason m a) m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ MenuRenderEvent m a i
-> ConduitT (MenuRenderEvent m a i) (QuitReason m a) m ()
forall (m :: * -> *) a i i.
Monad m =>
MenuRenderEvent m a i
-> ConduitT (MenuRenderEvent m a i) (QuitReason m a) m ()
check (Maybe (MenuRenderEvent m a i)
 -> ConduitT (MenuRenderEvent m a i) (QuitReason m a) m ())
-> ConduitT
     (MenuRenderEvent m a i)
     (QuitReason m a)
     m
     (Maybe (MenuRenderEvent m a i))
-> ConduitT (MenuRenderEvent m a i) (QuitReason m a) m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ConduitT
  (MenuRenderEvent m a i)
  (QuitReason m a)
  m
  (Maybe (MenuRenderEvent m a i))
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await
  where
    check :: MenuRenderEvent m a i
-> ConduitT (MenuRenderEvent m a i) (QuitReason m a) m ()
check (MenuRenderEvent.Quit QuitReason m a
reason) =
      QuitReason m a
-> ConduitT (MenuRenderEvent m a i) (QuitReason m a) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield QuitReason m a
reason
    check MenuRenderEvent m a i
_ =
      ConduitT (MenuRenderEvent m a i) (QuitReason m a) m ()
forall (m :: * -> *) a i.
Monad m =>
ConduitT (MenuRenderEvent m a i) (QuitReason m a) m ()
menuTerminator

menuResult ::
  Monad m =>
  QuitReason m a ->
  m (MenuResult a)
menuResult :: QuitReason m a -> m (MenuResult a)
menuResult (QuitReason.Return a
a) =
  MenuResult a -> m (MenuResult a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> MenuResult a
forall a. a -> MenuResult a
MenuResult.Return a
a)
menuResult (QuitReason.Execute m a
ma) =
  a -> MenuResult a
forall a. a -> MenuResult a
MenuResult.Return (a -> MenuResult a) -> m a -> m (MenuResult a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
ma
menuResult (QuitReason.PromptError Text
err) =
  MenuResult a -> m (MenuResult a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> MenuResult a
forall a. Text -> MenuResult a
MenuResult.Error Text
err)
menuResult QuitReason m a
QuitReason.NoOutput =
  MenuResult a -> m (MenuResult a)
forall (m :: * -> *) a. Monad m => a -> m a
return MenuResult a
forall a. MenuResult a
MenuResult.NoOutput
menuResult QuitReason m a
QuitReason.Aborted =
  MenuResult a -> m (MenuResult a)
forall (m :: * -> *) a. Monad m => a -> m a
return MenuResult a
forall a. MenuResult a
MenuResult.Aborted

menuC ::
  MonadRibo m =>
  MonadResource m =>
  MonadBaseControl IO m =>
  MenuConfig m a i ->
  ConduitT () (QuitReason m a) m ()
menuC :: MenuConfig m a i -> ConduitT () (QuitReason m a) m ()
menuC (MenuConfig ConduitT () [MenuItem i] m ()
items MenuConsumer m a i
handle MenuRenderEvent m a i -> m ()
render PromptConfig m
promptConfig Maybe Int
maxItems) = do
  (TMChan PromptEvent
backchannel, ConduitT () PromptConsumerUpdate m ()
source) <- m (TMChan PromptEvent, ConduitT () PromptConsumerUpdate m ())
-> ConduitT
     ()
     (QuitReason m a)
     m
     (TMChan PromptEvent, ConduitT () PromptConsumerUpdate m ())
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (TMChan PromptEvent, ConduitT () PromptConsumerUpdate m ())
 -> ConduitT
      ()
      (QuitReason m a)
      m
      (TMChan PromptEvent, ConduitT () PromptConsumerUpdate m ()))
-> m (TMChan PromptEvent, ConduitT () PromptConsumerUpdate m ())
-> ConduitT
     ()
     (QuitReason m a)
     m
     (TMChan PromptEvent, ConduitT () PromptConsumerUpdate m ())
forall a b. (a -> b) -> a -> b
$ PromptConfig m
-> m (TMChan PromptEvent, ConduitT () PromptConsumerUpdate m ())
forall (m :: * -> *).
(MonadRibo m, MonadResource m, MonadBaseControl IO m) =>
PromptConfig m
-> m (TMChan PromptEvent, ConduitT () PromptConsumerUpdate m ())
promptC PromptConfig m
promptConfig
  Int
-> [ConduitT () (Either PromptConsumerUpdate [MenuItem i]) m ()]
-> ConduitT () (Either PromptConsumerUpdate [MenuItem i]) m ()
forall (m :: * -> *) a.
(MonadResource m, MonadBaseControl IO m) =>
Int -> [ConduitT () a m ()] -> ConduitT () a m ()
mergeSources Int
64 [ConduitT () PromptConsumerUpdate m ()
source ConduitT () PromptConsumerUpdate m ()
-> ConduitM
     PromptConsumerUpdate
     (Either PromptConsumerUpdate [MenuItem i])
     m
     ()
-> ConduitT () (Either PromptConsumerUpdate [MenuItem i]) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (PromptConsumerUpdate -> Either PromptConsumerUpdate [MenuItem i])
-> ConduitM
     PromptConsumerUpdate
     (Either PromptConsumerUpdate [MenuItem i])
     m
     ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC PromptConsumerUpdate -> Either PromptConsumerUpdate [MenuItem i]
forall a b. a -> Either a b
Left, ConduitT () [MenuItem i] m ()
items ConduitT () [MenuItem i] m ()
-> ConduitM
     [MenuItem i] (Either PromptConsumerUpdate [MenuItem i]) m ()
-> ConduitT () (Either PromptConsumerUpdate [MenuItem i]) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ([MenuItem i] -> Either PromptConsumerUpdate [MenuItem i])
-> ConduitM
     [MenuItem i] (Either PromptConsumerUpdate [MenuItem i]) m ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC [MenuItem i] -> Either PromptConsumerUpdate [MenuItem i]
forall a b. b -> Either a b
Right] ConduitT () (Either PromptConsumerUpdate [MenuItem i]) m ()
-> ConduitM
     (Either PromptConsumerUpdate [MenuItem i]) (QuitReason m a) m ()
-> ConduitT () (QuitReason m a) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| TMChan PromptEvent
-> ConduitM
     (Either PromptConsumerUpdate [MenuItem i]) (QuitReason m a) m ()
consumer TMChan PromptEvent
backchannel
  where
    consumer :: TMChan PromptEvent
-> ConduitM
     (Either PromptConsumerUpdate [MenuItem i]) (QuitReason m a) m ()
consumer TMChan PromptEvent
backchannel =
      Menu i
-> ConduitT
     (Either PromptConsumerUpdate [MenuItem i])
     (MenuRenderEvent m a i)
     (StateT (Menu i) m)
     ()
-> ConduitT
     (Either PromptConsumerUpdate [MenuItem i])
     (MenuRenderEvent m a i)
     m
     ()
forall (m :: * -> *) s i o r.
Monad m =>
s -> ConduitT i o (StateT s m) r -> ConduitT i o m r
evalStateC Menu i
initial (TMChan PromptEvent
-> ConduitT
     (Either PromptConsumerUpdate [MenuItem i])
     (MenuRenderEvent m a i)
     (StateT (Menu i) m)
     ()
menuHandler TMChan PromptEvent
backchannel) ConduitT
  (Either PromptConsumerUpdate [MenuItem i])
  (MenuRenderEvent m a i)
  m
  ()
-> ConduitM (MenuRenderEvent m a i) (QuitReason m a) m ()
-> ConduitM
     (Either PromptConsumerUpdate [MenuItem i]) (QuitReason m a) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (MenuRenderEvent m a i -> m ())
-> ConduitT (MenuRenderEvent m a i) (MenuRenderEvent m a i) m ()
forall (m :: * -> *) a. Monad m => (a -> m ()) -> ConduitT a a m ()
iterM MenuRenderEvent m a i -> m ()
render ConduitT (MenuRenderEvent m a i) (MenuRenderEvent m a i) m ()
-> ConduitM (MenuRenderEvent m a i) (QuitReason m a) m ()
-> ConduitM (MenuRenderEvent m a i) (QuitReason m a) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM (MenuRenderEvent m a i) (QuitReason m a) m ()
forall (m :: * -> *) a i.
Monad m =>
ConduitT (MenuRenderEvent m a i) (QuitReason m a) m ()
menuTerminator
    initial :: Menu i
initial =
      ASetter (Menu i) (Menu i) (Maybe Int) (Maybe Int)
-> Maybe Int -> Menu i -> Menu i
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter (Menu i) (Menu i) (Maybe Int) (Maybe Int)
forall c a. HasMenu c a => Lens' c (Maybe Int)
Menu.maxItems Maybe Int
maxItems Menu i
forall a. Default a => a
def
    menuHandler :: TMChan PromptEvent
-> ConduitT
     (Either PromptConsumerUpdate [MenuItem i])
     (MenuRenderEvent m a i)
     (StateT (Menu i) m)
     ()
menuHandler TMChan PromptEvent
backchannel =
      (Either PromptConsumerUpdate [MenuItem i]
 -> ConduitT
      (Either PromptConsumerUpdate [MenuItem i])
      (MenuRenderEvent m a i)
      (StateT (Menu i) m)
      ())
-> ConduitT
     (Either PromptConsumerUpdate [MenuItem i])
     (MenuRenderEvent m a i)
     (StateT (Menu i) m)
     ()
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
awaitForever ((Either PromptConsumerUpdate [MenuItem i]
  -> ConduitT
       (Either PromptConsumerUpdate [MenuItem i])
       (MenuRenderEvent m a i)
       (StateT (Menu i) m)
       ())
 -> ConduitT
      (Either PromptConsumerUpdate [MenuItem i])
      (MenuRenderEvent m a i)
      (StateT (Menu i) m)
      ())
-> (MenuConsumer m a i
    -> Either PromptConsumerUpdate [MenuItem i]
    -> ConduitT
         (Either PromptConsumerUpdate [MenuItem i])
         (MenuRenderEvent m a i)
         (StateT (Menu i) m)
         ())
-> MenuConsumer m a i
-> ConduitT
     (Either PromptConsumerUpdate [MenuItem i])
     (MenuRenderEvent m a i)
     (StateT (Menu i) m)
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TMChan PromptEvent
-> MenuConsumer m a i
-> Either PromptConsumerUpdate [MenuItem i]
-> ConduitT
     (Either PromptConsumerUpdate [MenuItem i])
     (MenuRenderEvent m a i)
     (StateT (Menu i) m)
     ()
forall (m :: * -> *) a i.
MonadRibo m =>
TMChan PromptEvent
-> MenuConsumer m a i
-> Either PromptConsumerUpdate [MenuItem i]
-> ConduitT
     (Either PromptConsumerUpdate [MenuItem i])
     (MenuRenderEvent m a i)
     (StateT (Menu i) m)
     ()
updateMenu TMChan PromptEvent
backchannel (MenuConsumer m a i
 -> ConduitT
      (Either PromptConsumerUpdate [MenuItem i])
      (MenuRenderEvent m a i)
      (StateT (Menu i) m)
      ())
-> MenuConsumer m a i
-> ConduitT
     (Either PromptConsumerUpdate [MenuItem i])
     (MenuRenderEvent m a i)
     (StateT (Menu i) m)
     ()
forall a b. (a -> b) -> a -> b
$ MenuConsumer m a i
handle

isFloat ::
  NvimE e m =>
  Window ->
  m Bool
isFloat :: Window -> m Bool
isFloat =
  (Map Text Object -> Bool) -> m (Map Text Object) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Either Err WindowConfig -> Bool
forall a. Either a WindowConfig -> Bool
check (Either Err WindowConfig -> Bool)
-> (Map Text Object -> Either Err WindowConfig)
-> Map Text Object
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Either Err WindowConfig
forall a. MsgpackDecode a => Object -> Either Err a
fromMsgpack (Object -> Either Err WindowConfig)
-> (Map Text Object -> Object)
-> Map Text Object
-> Either Err WindowConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text Object -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack) (m (Map Text Object) -> m Bool)
-> (Window -> m (Map Text Object)) -> Window -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> m (Map Text Object)
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
Window -> m (Map Text Object)
nvimWinGetConfig
  where
    check :: Either a WindowConfig -> Bool
check (Right (WindowConfig Text
relative Bool
_ Bool
_)) =
      Bool -> Bool
not (Text -> Bool
Text.null Text
relative)
    check Either a WindowConfig
_ =
      Bool
False

closeFloats ::
  NvimE e m =>
  m ()
closeFloats :: m ()
closeFloats = do
  (Window -> m ()) -> [Window] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Window -> m ()
forall e (m :: * -> *). NvimE e m => Window -> m ()
closeWindow ([Window] -> m ()) -> m [Window] -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Window -> m Bool) -> [Window] -> m [Window]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM Window -> m Bool
forall e (m :: * -> *). NvimE e m => Window -> m Bool
isFloat ([Window] -> m [Window]) -> m [Window] -> m [Window]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m [Window]
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
m [Window]
vimGetWindows

runMenu ::
  MonadRibo m =>
  MonadResource m =>
  MonadBaseControl IO m =>
  MenuConfig m a i ->
  m (MenuResult a)
runMenu :: MenuConfig m a i -> m (MenuResult a)
runMenu MenuConfig m a i
config =
  PromptRenderer m -> m (MenuResult a)
bracketPrompt (Getting (PromptRenderer m) (MenuConfig m a i) (PromptRenderer m)
-> MenuConfig m a i -> PromptRenderer m
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((PromptConfig m -> Const (PromptRenderer m) (PromptConfig m))
-> MenuConfig m a i -> Const (PromptRenderer m) (MenuConfig m a i)
forall c (m :: * -> *) a i.
HasMenuConfig c m a i =>
Lens' c (PromptConfig m)
MenuConfig.prompt ((PromptConfig m -> Const (PromptRenderer m) (PromptConfig m))
 -> MenuConfig m a i -> Const (PromptRenderer m) (MenuConfig m a i))
-> ((PromptRenderer m
     -> Const (PromptRenderer m) (PromptRenderer m))
    -> PromptConfig m -> Const (PromptRenderer m) (PromptConfig m))
-> Getting (PromptRenderer m) (MenuConfig m a i) (PromptRenderer m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PromptRenderer m -> Const (PromptRenderer m) (PromptRenderer m))
-> PromptConfig m -> Const (PromptRenderer m) (PromptConfig m)
forall c (m :: * -> *).
HasPromptConfig c m =>
Lens' c (PromptRenderer m)
PromptConfig.render) MenuConfig m a i
config)
  where
    bracketPrompt :: PromptRenderer m -> m (MenuResult a)
bracketPrompt (PromptRenderer m a
acquire a -> m ()
release Prompt -> m ()
_) =
      m a -> (a -> m ()) -> (a -> m (MenuResult a)) -> m (MenuResult a)
forall (m :: * -> *) a b c.
MonadBaseControl IO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket m a
acquire a -> m ()
release (m (MenuResult a) -> a -> m (MenuResult a)
forall a b. a -> b -> a
const m (MenuResult a)
runForResult)
    runForResult :: m (MenuResult a)
runForResult =
      QuitReason m a -> m (MenuResult a)
forall (m :: * -> *) a.
Monad m =>
QuitReason m a -> m (MenuResult a)
menuResult (QuitReason m a -> m (MenuResult a))
-> m (QuitReason m a) -> m (MenuResult a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (QuitReason m a) -> QuitReason m a
forall (m :: * -> *) a. Maybe (QuitReason m a) -> QuitReason m a
quitReason (Maybe (QuitReason m a) -> QuitReason m a)
-> m (Maybe (QuitReason m a)) -> m (QuitReason m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Maybe (QuitReason m a))
run
    run :: m (Maybe (QuitReason m a))
run =
      ConduitT () Void m (Maybe (QuitReason m a))
-> m (Maybe (QuitReason m a))
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (MenuConfig m a i -> ConduitT () (QuitReason m a) m ()
forall (m :: * -> *) a i.
(MonadRibo m, MonadResource m, MonadBaseControl IO m) =>
MenuConfig m a i -> ConduitT () (QuitReason m a) m ()
menuC MenuConfig m a i
config ConduitT () (QuitReason m a) m ()
-> ConduitM (QuitReason m a) Void m (Maybe (QuitReason m a))
-> ConduitT () Void m (Maybe (QuitReason m a))
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM (QuitReason m a) Void m (Maybe (QuitReason m a))
forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
Conduit.last)
    quitReason :: Maybe (QuitReason m a) -> QuitReason m a
quitReason =
      QuitReason m a -> Maybe (QuitReason m a) -> QuitReason m a
forall a. a -> Maybe a -> a
fromMaybe QuitReason m a
forall (m :: * -> *) a. QuitReason m a
QuitReason.NoOutput

nvimMenu ::
  NvimE e m =>
  MonadRibo m =>
  MonadResource m =>
  MonadBaseControl IO m =>
  MonadDeepError e DecodeError m =>
  ScratchOptions ->
  ConduitT () [MenuItem i] m () ->
  (MenuUpdate m a i -> m (MenuAction m a, Menu i)) ->
  PromptConfig m ->
  Maybe Int ->
  m (MenuResult a)
nvimMenu :: ScratchOptions
-> ConduitT () [MenuItem i] m ()
-> (MenuUpdate m a i -> m (MenuAction m a, Menu i))
-> PromptConfig m
-> Maybe Int
-> m (MenuResult a)
nvimMenu ScratchOptions
options ConduitT () [MenuItem i] m ()
items MenuUpdate m a i -> m (MenuAction m a, Menu i)
handle PromptConfig m
promptConfig Maybe Int
maxItems = do
  Int
_ :: Int <- Text -> [Object] -> m Int
forall (m :: * -> *) e a.
(Nvim m, MonadDeepError e RpcError m, MsgpackDecode a) =>
Text -> [Object] -> m a
vimCallFunction Text
"inputsave" []
  m Bool -> m () -> m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Bool -> Setting Bool -> m Bool
forall (m :: * -> *) a.
(MonadIO m, Nvim m, MonadRibo m, MsgpackDecode a) =>
a -> Setting a -> m a
settingOr Bool
True Setting Bool
Settings.menuCloseFloats) m ()
forall e (m :: * -> *). NvimE e m => m ()
closeFloats
  Scratch -> m (MenuResult a)
run (Scratch -> m (MenuResult a)) -> m Scratch -> m (MenuResult a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Text] -> ScratchOptions -> m Scratch
forall (t :: * -> *) e (m :: * -> *).
(Foldable t, NvimE e m, MonadRibo m, MonadBaseControl IO m,
 MonadDeepError e DecodeError m) =>
t Text -> ScratchOptions -> m Scratch
showInScratch @[] [] (ScratchOptions -> ScratchOptions
withSyntax (ScratchOptions -> ScratchOptions
ensureSize ScratchOptions
options))
  where
    run :: Scratch -> m (MenuResult a)
run Scratch
scratch = do
      Window -> Text -> Object -> m ()
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
Window -> Text -> Object -> m ()
windowSetOption (Scratch -> Window
scratchWindow Scratch
scratch) Text
"cursorline" (Bool -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack Bool
True)
      MenuConfig m a i -> m (MenuResult a)
forall (m :: * -> *) a i.
(MonadRibo m, MonadResource m, MonadBaseControl IO m) =>
MenuConfig m a i -> m (MenuResult a)
runMenu (MenuConfig m a i -> m (MenuResult a))
-> MenuConfig m a i -> m (MenuResult a)
forall a b. (a -> b) -> a -> b
$ ConduitT () [MenuItem i] m ()
-> MenuConsumer m a i
-> (MenuRenderEvent m a i -> m ())
-> PromptConfig m
-> Maybe Int
-> MenuConfig m a i
forall (m :: * -> *) a i.
ConduitT () [MenuItem i] m ()
-> MenuConsumer m a i
-> (MenuRenderEvent m a i -> m ())
-> PromptConfig m
-> Maybe Int
-> MenuConfig m a i
MenuConfig ConduitT () [MenuItem i] m ()
items ((MenuUpdate m a i -> m (MenuAction m a, Menu i))
-> MenuConsumer m a i
forall (m :: * -> *) a i.
(MenuUpdate m a i -> m (MenuAction m a, Menu i))
-> MenuConsumer m a i
MenuConsumer MenuUpdate m a i -> m (MenuAction m a, Menu i)
handle) (Scratch -> MenuRenderEvent m a i -> m ()
render Scratch
scratch) PromptConfig m
promptConfig Maybe Int
maxItems
    render :: Scratch -> MenuRenderEvent m a i -> m ()
render =
      ScratchOptions -> Scratch -> MenuRenderEvent m a i -> m ()
forall (m :: * -> *) e a i.
(MonadRibo m, NvimE e m) =>
ScratchOptions -> Scratch -> MenuRenderEvent m a i -> m ()
renderNvimMenu ScratchOptions
options
    ensureSize :: ScratchOptions -> ScratchOptions
ensureSize =
      ASetter ScratchOptions ScratchOptions (Maybe Int) (Maybe Int)
-> (Maybe Int -> Maybe Int) -> ScratchOptions -> ScratchOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter ScratchOptions ScratchOptions (Maybe Int) (Maybe Int)
forall c. HasScratchOptions c => Lens' c (Maybe Int)
ScratchOptions.size (Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1)
    withSyntax :: ScratchOptions -> ScratchOptions
withSyntax =
      ASetter ScratchOptions ScratchOptions [Syntax] [Syntax]
-> ([Syntax] -> [Syntax]) -> ScratchOptions -> ScratchOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter ScratchOptions ScratchOptions [Syntax] [Syntax]
forall c. HasScratchOptions c => Lens' c [Syntax]
ScratchOptions.syntax ([Syntax] -> [Syntax] -> [Syntax]
forall a. [a] -> [a] -> [a]
++ [Item [Syntax]
Syntax
menuSyntax])

strictNvimMenu ::
  NvimE e m =>
  MonadRibo m =>
  MonadResource m =>
  MonadBaseControl IO m =>
  MonadDeepError e DecodeError m =>
  ScratchOptions ->
  [MenuItem i] ->
  (MenuUpdate m a i -> m (MenuAction m a, Menu i)) ->
  PromptConfig m ->
  Maybe Int ->
  m (MenuResult a)
strictNvimMenu :: ScratchOptions
-> [MenuItem i]
-> (MenuUpdate m a i -> m (MenuAction m a, Menu i))
-> PromptConfig m
-> Maybe Int
-> m (MenuResult a)
strictNvimMenu ScratchOptions
options [MenuItem i]
items =
  ScratchOptions
-> ConduitT () [MenuItem i] m ()
-> (MenuUpdate m a i -> m (MenuAction m a, Menu i))
-> PromptConfig m
-> Maybe Int
-> m (MenuResult a)
forall e (m :: * -> *) i a.
(NvimE e m, MonadRibo m, MonadResource m, MonadBaseControl IO m,
 MonadDeepError e DecodeError m) =>
ScratchOptions
-> ConduitT () [MenuItem i] m ()
-> (MenuUpdate m a i -> m (MenuAction m a, Menu i))
-> PromptConfig m
-> Maybe Int
-> m (MenuResult a)
nvimMenu (ScratchOptions -> ScratchOptions
ensureSize ScratchOptions
options) ([MenuItem i] -> ConduitT () [MenuItem i] m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield [MenuItem i]
items)
  where
    ensureSize :: ScratchOptions -> ScratchOptions
ensureSize =
      ASetter ScratchOptions ScratchOptions (Maybe Int) (Maybe Int)
-> (Maybe Int -> Maybe Int) -> ScratchOptions -> ScratchOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter ScratchOptions ScratchOptions (Maybe Int) (Maybe Int)
forall c. HasScratchOptions c => Lens' c (Maybe Int)
ScratchOptions.size (Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Maybe Int
forall a. a -> Maybe a
Just ([MenuItem i] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [MenuItem i]
items))