-- |API functions for windows.
module Ribosome.Api.Window where

import Ribosome.Data.WindowView (PartialWindowView, WindowView)
import Ribosome.Host.Api.Data (Window)
import Ribosome.Host.Api.Effect (
  nvimBufGetOption,
  nvimCallFunction,
  nvimCommand,
  nvimGetCurrentWin,
  nvimWinClose,
  nvimWinGetBuf,
  nvimWinGetCursor,
  nvimWinSetCursor,
  vimCallFunction,
  vimGetWindows,
  vimSetCurrentWindow,
  windowIsValid,
  )
import Ribosome.Host.Class.Msgpack.Encode (toMsgpack)
import Ribosome.Host.Effect.Rpc (Rpc)
import Ribosome.Host.Modify (silentBang)

-- |Close a window if it is valid and not the last one.
closeWindow ::
  Member Rpc r =>
  Window ->
  Sem r ()
closeWindow :: forall (r :: EffectRow). Member Rpc r => Window -> Sem r ()
closeWindow Window
window = do
  Bool
valid <- Window -> Sem r Bool
forall (r :: EffectRow). Member Rpc r => Window -> Sem r Bool
windowIsValid Window
window
  Bool
last' <- (Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==) (Int -> Bool) -> ([Window] -> Int) -> [Window] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Window] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Window] -> Bool) -> Sem r [Window] -> Sem r Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem r [Window]
forall (r :: EffectRow). Member Rpc r => Sem r [Window]
vimGetWindows
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
valid Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
last') (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Window -> Bool -> Sem r ()
forall (r :: EffectRow). Member Rpc r => Window -> Bool -> Sem r ()
nvimWinClose Window
window Bool
True

-- |Get the zero-based position of the cursor in a window.
cursor ::
  Member Rpc r =>
  Window ->
  Sem r (Int, Int)
cursor :: forall (r :: EffectRow). Member Rpc r => Window -> Sem r (Int, Int)
cursor Window
window = do
  (Int
line, Int
col) <- Window -> Sem r (Int, Int)
forall (r :: EffectRow). Member Rpc r => Window -> Sem r (Int, Int)
nvimWinGetCursor Window
window
  (Int, Int) -> Sem r (Int, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int
col)

-- |Get the zero-based position of the cursor in the active window.
currentCursor ::
  Member Rpc r =>
  Sem r (Int, Int)
currentCursor :: forall (r :: EffectRow). Member Rpc r => Sem r (Int, Int)
currentCursor =
  Window -> Sem r (Int, Int)
forall (r :: EffectRow). Member Rpc r => Window -> Sem r (Int, Int)
cursor (Window -> Sem r (Int, Int)) -> Sem r Window -> Sem r (Int, Int)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem r Window
forall (r :: EffectRow). Member Rpc r => Sem r Window
nvimGetCurrentWin

-- |Get the zero-based line number of the cursor in a window.
windowLine ::
  Member Rpc r =>
  Window ->
  Sem r Int
windowLine :: forall (r :: EffectRow). Member Rpc r => Window -> Sem r Int
windowLine Window
window =
  (Int, Int) -> Int
forall a b. (a, b) -> a
fst ((Int, Int) -> Int) -> Sem r (Int, Int) -> Sem r Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Window -> Sem r (Int, Int)
forall (r :: EffectRow). Member Rpc r => Window -> Sem r (Int, Int)
cursor Window
window

-- |Get the zero-based line number of the cursor in the active window.
currentLine ::
  Member Rpc r =>
  Sem r Int
currentLine :: forall (r :: EffectRow). Member Rpc r => Sem r Int
currentLine =
  Window -> Sem r Int
forall (r :: EffectRow). Member Rpc r => Window -> Sem r Int
windowLine (Window -> Sem r Int) -> Sem r Window -> Sem r Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem r Window
forall (r :: EffectRow). Member Rpc r => Sem r Window
nvimGetCurrentWin

-- |Set the zero-based position of the cursor in a window.
setCursor ::
  Member Rpc r =>
  Window ->
  Int ->
  Int ->
  Sem r ()
setCursor :: forall (r :: EffectRow).
Member Rpc r =>
Window -> Int -> Int -> Sem r ()
setCursor Window
window Int
line Int
col =
  Window -> (Int, Int) -> Sem r ()
forall (r :: EffectRow).
Member Rpc r =>
Window -> (Int, Int) -> Sem r ()
nvimWinSetCursor Window
window (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
col)

-- |Set the zero-based position of the cursor in the current window.
setCurrentCursor ::
  Member Rpc r =>
  Int ->
  Int ->
  Sem r ()
setCurrentCursor :: forall (r :: EffectRow). Member Rpc r => Int -> Int -> Sem r ()
setCurrentCursor Int
line Int
col = do
  Window
window <- Sem r Window
forall (r :: EffectRow). Member Rpc r => Sem r Window
nvimGetCurrentWin
  Window -> Int -> Int -> Sem r ()
forall (r :: EffectRow).
Member Rpc r =>
Window -> Int -> Int -> Sem r ()
setCursor Window
window Int
line Int
col

-- |Set the zero-based line number of the cursor in a window, using the beginning of the line for the column.
setLine ::
  Member Rpc r =>
  Window ->
  Int ->
  Sem r ()
setLine :: forall (r :: EffectRow). Member Rpc r => Window -> Int -> Sem r ()
setLine Window
window Int
line =
  Window -> Int -> Int -> Sem r ()
forall (r :: EffectRow).
Member Rpc r =>
Window -> Int -> Int -> Sem r ()
setCursor Window
window Int
line Int
0

-- |Set the zero-based line number of the cursor in the current window, using the beginning of the line for the column.
setCurrentLine ::
  Member Rpc r =>
  Int ->
  Sem r ()
setCurrentLine :: forall (r :: EffectRow). Member Rpc r => Int -> Sem r ()
setCurrentLine Int
line =
  Int -> Int -> Sem r ()
forall (r :: EffectRow). Member Rpc r => Int -> Int -> Sem r ()
setCurrentCursor Int
line Int
0

-- |Redraw the screen.
redraw ::
  Member Rpc r =>
  Sem r ()
redraw :: forall (r :: EffectRow). Member Rpc r => Sem r ()
redraw =
  Sem r () -> Sem r ()
forall (r :: EffectRow) a. Member Rpc r => Sem r a -> Sem r a
silentBang do
    Text -> Sem r ()
forall (r :: EffectRow). Member Rpc r => Text -> Sem r ()
nvimCommand Text
"redraw!"

-- |A main window means here any non-window that may be used to edit a file, i.e. one with an empty @buftype@.
findMainWindow ::
  Member Rpc r =>
  Sem r (Maybe Window)
findMainWindow :: forall (r :: EffectRow). Member Rpc r => Sem r (Maybe Window)
findMainWindow =
  [Window] -> Maybe Window
forall a. [a] -> Maybe a
listToMaybe ([Window] -> Maybe Window)
-> Sem r [Window] -> Sem r (Maybe Window)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Window -> Sem r Bool) -> [Window] -> Sem r [Window]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM Window -> Sem r Bool
forall (r :: EffectRow). Member Rpc r => Window -> Sem r Bool
isFile ([Window] -> Sem r [Window]) -> Sem r [Window] -> Sem r [Window]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem r [Window]
forall (r :: EffectRow). Member Rpc r => Sem r [Window]
vimGetWindows)
  where
    isFile :: Window -> Sem r Bool
isFile Window
w = do
      Buffer
buf <- Window -> Sem r Buffer
forall (r :: EffectRow). Member Rpc r => Window -> Sem r Buffer
nvimWinGetBuf Window
w
      ((Text
"" :: Text) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==) (Text -> Bool) -> Sem r Text -> Sem r Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Buffer -> Text -> Sem r Text
forall a (r :: EffectRow).
(Member Rpc r, MsgpackDecode a) =>
Buffer -> Text -> Sem r a
nvimBufGetOption Buffer
buf Text
"buftype"

-- |Create a new window at the top if no existing window has empty @buftype@.
-- Focuses the window.
ensureMainWindow ::
  Member Rpc r =>
  Sem r Window
ensureMainWindow :: forall (r :: EffectRow). Member Rpc r => Sem r Window
ensureMainWindow =
  Sem r Window
-> (Window -> Sem r Window) -> Maybe Window -> Sem r Window
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Sem r Window
create Window -> Sem r Window
forall {r :: EffectRow}. Member Rpc r => Window -> Sem r Window
focus (Maybe Window -> Sem r Window)
-> Sem r (Maybe Window) -> Sem r Window
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem r (Maybe Window)
forall (r :: EffectRow). Member Rpc r => Sem r (Maybe Window)
findMainWindow
  where
    create :: Sem r Window
create = do
      Text -> Sem r ()
forall (r :: EffectRow). Member Rpc r => Text -> Sem r ()
nvimCommand Text
"aboveleft new"
      Sem r Window
forall (r :: EffectRow). Member Rpc r => Sem r Window
nvimGetCurrentWin Sem r Window -> Sem r () -> Sem r Window
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Sem r ()
forall (r :: EffectRow). Member Rpc r => Text -> Sem r ()
nvimCommand Text
"wincmd K"
    focus :: Window -> Sem r Window
focus Window
w =
      Window
w Window -> Sem r () -> Sem r Window
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Window -> Sem r ()
forall (r :: EffectRow). Member Rpc r => Window -> Sem r ()
vimSetCurrentWindow Window
w

-- |Call @winsaveview@.
saveView ::
  Member Rpc r =>
  Sem r WindowView
saveView :: forall (r :: EffectRow). Member Rpc r => Sem r WindowView
saveView =
  Text -> [Object] -> Sem r WindowView
forall a (r :: EffectRow).
(Member Rpc r, MsgpackDecode a) =>
Text -> [Object] -> Sem r a
vimCallFunction Text
"winsaveview" []

-- |Call @winrestview@ with a previously obtained view from 'saveView'.
restoreView ::
  Member Rpc r =>
  PartialWindowView ->
  Sem r ()
restoreView :: forall (r :: EffectRow).
Member Rpc r =>
PartialWindowView -> Sem r ()
restoreView PartialWindowView
v =
  Text -> [Object] -> Sem r ()
forall a (r :: EffectRow).
(Member Rpc r, MsgpackDecode a) =>
Text -> [Object] -> Sem r a
vimCallFunction Text
"winrestview" [PartialWindowView -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack PartialWindowView
v]

-- |Execute a command in a window.
windowExec ::
  Member Rpc r =>
  Window ->
  Text ->
  Sem r ()
windowExec :: forall (r :: EffectRow). Member Rpc r => Window -> Text -> Sem r ()
windowExec Window
window Text
cmd =
  Text -> [Object] -> Sem r ()
forall a (r :: EffectRow).
(Member Rpc r, MsgpackDecode a) =>
Text -> [Object] -> Sem r a
nvimCallFunction Text
"win_execute" [Window -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack Window
window, Text -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack Text
cmd]