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
=
(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) ()
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 ()
=
(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)
(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 ()
(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)
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)
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)
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))