-- |API functions for @getpos@.
module Ribosome.Api.Position where

import Ribosome.Host.Api.Data (nvimCallFunction)
import Ribosome.Host.Class.Msgpack.Encode (toMsgpack)
import Ribosome.Host.Data.RpcCall (RpcCall)
import qualified Ribosome.Host.Effect.Rpc as Rpc
import Ribosome.Host.Effect.Rpc (Rpc)

-- |'RpcCall' for the function @getpos@ that returns a 4-tuple.
getposCall ::
  Text ->
  RpcCall (Int, Int, Int, Int)
getposCall :: Text -> RpcCall (Int, Int, Int, Int)
getposCall Text
expr =
  Text -> [Object] -> RpcCall (Int, Int, Int, Int)
forall a. MsgpackDecode a => Text -> [Object] -> RpcCall a
nvimCallFunction Text
"getpos" [Text -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack Text
expr]

-- |Call the function @getpos@ and return a 4-tuple.
getpos ::
  Member Rpc r =>
  Text ->
  Sem r (Int, Int, Int, Int)
getpos :: forall (r :: EffectRow).
Member Rpc r =>
Text -> Sem r (Int, Int, Int, Int)
getpos =
  RpcCall (Int, Int, Int, Int) -> Sem r (Int, Int, Int, Int)
forall (r :: EffectRow) a. Member Rpc r => RpcCall a -> Sem r a
Rpc.sync (RpcCall (Int, Int, Int, Int) -> Sem r (Int, Int, Int, Int))
-> (Text -> RpcCall (Int, Int, Int, Int))
-> Text
-> Sem r (Int, Int, Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> RpcCall (Int, Int, Int, Int)
getposCall

-- |Return the start and end coordinates of visual mode.
visualPos ::
  Member Rpc r =>
  Sem r ((Int, Int), (Int, Int))
visualPos :: forall (r :: EffectRow).
Member Rpc r =>
Sem r ((Int, Int), (Int, Int))
visualPos = do
  ((Int
_, Int
lnumStart, Int
colStart, Int
_), (Int
_, Int
lnumEnd, Int
colEnd, Int
_)) <- RpcCall ((Int, Int, Int, Int), (Int, Int, Int, Int))
-> Sem r ((Int, Int, Int, Int), (Int, Int, Int, Int))
forall (r :: EffectRow) a. Member Rpc r => RpcCall a -> Sem r a
Rpc.sync do
    (Int, Int, Int, Int)
start <- Text -> RpcCall (Int, Int, Int, Int)
getposCall Text
"'<"
    (Int, Int, Int, Int)
end <- Text -> RpcCall (Int, Int, Int, Int)
getposCall Text
"'>"
    pure ((Int, Int, Int, Int)
start, (Int, Int, Int, Int)
end)
  ((Int, Int), (Int, Int)) -> Sem r ((Int, Int), (Int, Int))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Int
lnumStart, Int
colStart), (Int
lnumEnd, Int
colEnd))