-- |Functions for constructing and activating 'Mapping's
module Ribosome.Mapping where

import Data.MessagePack (Object)
import Exon (exon)

import Ribosome.Data.Mapping (
  MapMode,
  Mapping (Mapping),
  MappingAction (MappingCall, MappingEvent),
  MappingId (MappingId),
  MappingLhs (MappingLhs),
  MappingSpec (MappingSpec),
  mapModeShortName,
  unMappingId,
  )
import qualified Ribosome.Host.Api.Data as Data
import Ribosome.Host.Api.Data (Buffer)
import Ribosome.Host.Data.ChannelId (ChannelId (ChannelId))
import Ribosome.Host.Data.Event (EventName (EventName))
import Ribosome.Host.Data.RpcCall (RpcCall)
import Ribosome.Host.Data.RpcHandler (RpcHandler (RpcHandler, rpcName))
import Ribosome.Host.Data.RpcName (RpcName (RpcName))
import qualified Ribosome.Host.Effect.Rpc as Rpc
import Ribosome.Host.Effect.Rpc (Rpc)

-- |Generate an atomic call executing a mapping cmd for all modes specified in the 'Mapping' and run it.
mappingCmdWith ::
  Member Rpc r =>
  (Text -> Text -> Text -> Map Text Object -> RpcCall ()) ->
  Mapping ->
  Sem r ()
mappingCmdWith :: forall (r :: EffectRow).
Member Rpc r =>
(Text -> Text -> Text -> Map Text Object -> RpcCall ())
-> Mapping -> Sem r ()
mappingCmdWith Text -> Text -> Text -> Map Text Object -> RpcCall ()
call (Mapping MappingAction
action (MappingSpec (MappingLhs Text
lhs) NonEmpty MapMode
modes) Maybe MappingId
ident Map Text Object
opts) = do
  Text
cmd <- MappingAction -> Sem r Text
command MappingAction
action
  RpcCall () -> Sem r ()
forall (r :: EffectRow) a. Member Rpc r => RpcCall a -> Sem r a
Rpc.sync (RpcCall () -> Sem r ()) -> RpcCall () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ NonEmpty MapMode -> (MapMode -> RpcCall ()) -> RpcCall ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ NonEmpty MapMode
modes \ MapMode
mode ->
    Text -> Text -> Text -> Map Text Object -> RpcCall ()
call (MapMode -> Text
mapModeShortName MapMode
mode) Text
lhs [exon|<cmd>#{cmd}<cr>|] Map Text Object
opts
  where
    command :: MappingAction -> Sem r Text
command = \case
      MappingCall (RpcName Text
name) ->
        Text -> Sem r Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure [exon|silent #{name}#{i}|]
      MappingEvent (EventName Text
name) -> do
        ChannelId Int64
cid <- Sem r ChannelId
forall (r :: EffectRow). Member Rpc r => Sem r ChannelId
Rpc.channelId
        Text -> Sem r Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure [exon|call rpcnotify(#{show cid}, '#{name}'#{foldMap idArg ident})|]
    i :: Text
i =
      (MappingId -> Text) -> Maybe MappingId -> Text
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap MappingId -> Text
unMappingId Maybe MappingId
ident
    idArg :: MappingId -> Text
idArg = \case
      MappingId Text
mi -> [exon|, '#{mi}'|]

-- |Generate an atomic call executing a mapping cmd for all modes specified in the 'Mapping' and run it.
mappingCmd ::
  Member Rpc r =>
  Mapping ->
  Sem r ()
mappingCmd :: forall (r :: EffectRow). Member Rpc r => Mapping -> Sem r ()
mappingCmd = do
  (Text -> Text -> Text -> Map Text Object -> RpcCall ())
-> Mapping -> Sem r ()
forall (r :: EffectRow).
Member Rpc r =>
(Text -> Text -> Text -> Map Text Object -> RpcCall ())
-> Mapping -> Sem r ()
mappingCmdWith Text -> Text -> Text -> Map Text Object -> RpcCall ()
Data.nvimSetKeymap

-- |Generate an atomic call executing a buffer mapping cmd for all modes specified in the 'Mapping' and run it.
bufferMappingCmd ::
  Member Rpc r =>
  -- |Use @<buffer>@ to create a buffer-local mapping.
  Buffer ->
  Mapping ->
  Sem r ()
bufferMappingCmd :: forall (r :: EffectRow).
Member Rpc r =>
Buffer -> Mapping -> Sem r ()
bufferMappingCmd Buffer
buffer =
  (Text -> Text -> Text -> Map Text Object -> RpcCall ())
-> Mapping -> Sem r ()
forall (r :: EffectRow).
Member Rpc r =>
(Text -> Text -> Text -> Map Text Object -> RpcCall ())
-> Mapping -> Sem r ()
mappingCmdWith (Buffer -> Text -> Text -> Text -> Map Text Object -> RpcCall ()
Data.nvimBufSetKeymap Buffer
buffer)

-- |Register a mapping globally.
activateMapping ::
  Member Rpc r =>
  Mapping ->
  Sem r ()
activateMapping :: forall (r :: EffectRow). Member Rpc r => Mapping -> Sem r ()
activateMapping =
  Mapping -> Sem r ()
forall (r :: EffectRow). Member Rpc r => Mapping -> Sem r ()
mappingCmd

-- |Register a mapping in the supplied buffer.
activateBufferMapping ::
  Member Rpc r =>
  Buffer ->
  Mapping ->
  Sem r ()
activateBufferMapping :: forall (r :: EffectRow).
Member Rpc r =>
Buffer -> Mapping -> Sem r ()
activateBufferMapping Buffer
buffer =
  Buffer -> Mapping -> Sem r ()
forall (r :: EffectRow).
Member Rpc r =>
Buffer -> Mapping -> Sem r ()
bufferMappingCmd Buffer
buffer

-- |Construct a 'Mapping' using the name from the supplied 'RpcHandler'.
mappingFor ::
  RpcHandler r ->
  MappingLhs ->
  NonEmpty MapMode ->
  Maybe MappingId ->
  Map Text Object ->
  Mapping
mappingFor :: forall (r :: EffectRow).
RpcHandler r
-> MappingLhs
-> NonEmpty MapMode
-> Maybe MappingId
-> Map Text Object
-> Mapping
mappingFor RpcHandler {RpcName
rpcName :: RpcName
$sel:rpcName:RpcHandler :: forall (r :: EffectRow). RpcHandler r -> RpcName
rpcName} MappingLhs
lhs NonEmpty MapMode
mode =
  MappingAction
-> MappingSpec -> Maybe MappingId -> Map Text Object -> Mapping
Mapping (RpcName -> MappingAction
MappingCall RpcName
rpcName) (MappingLhs -> NonEmpty MapMode -> MappingSpec
MappingSpec MappingLhs
lhs NonEmpty MapMode
mode)

-- |Construct a 'Mapping' using the supplied 'EventName'.
eventMapping ::
  EventName ->
  MappingLhs ->
  NonEmpty MapMode ->
  Maybe MappingId ->
  Map Text Object ->
  Mapping
eventMapping :: EventName
-> MappingLhs
-> NonEmpty MapMode
-> Maybe MappingId
-> Map Text Object
-> Mapping
eventMapping EventName
event MappingLhs
lhs NonEmpty MapMode
mode =
  MappingAction
-> MappingSpec -> Maybe MappingId -> Map Text Object -> Mapping
Mapping (EventName -> MappingAction
MappingEvent EventName
event) (MappingLhs -> NonEmpty MapMode -> MappingSpec
MappingSpec MappingLhs
lhs NonEmpty MapMode
mode)