{-# LANGUAGE DerivingVia       #-}
{-# LANGUAGE OverloadedLabels  #-}
{-# LANGUAGE OverloadedStrings #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Cornelis.Utils where

import           Control.Concurrent.Async
import           Control.Exception (throwIO)
import           Control.Lens ((%~))
import           Control.Monad.IO.Unlift (MonadUnliftIO(withRunInIO))
import           Control.Monad.Reader (withReaderT)
import           Control.Monad.State.Class
import           Cornelis.Types
import qualified Data.Map as M
import           Data.Maybe
import           Data.Text.Encoding (decodeUtf8)
import           Data.Traversable
import qualified Data.Vector as V
import           Neovim hiding (err)
import           Neovim.API.Text
import           Neovim.Context.Internal (Neovim(..), retypeConfig)

objectToInt :: Num a => Object -> Maybe a
objectToInt :: forall a. Num a => Object -> Maybe a
objectToInt (ObjectUInt Word64
w) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w
objectToInt (ObjectInt BufferNum
w) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ BufferNum -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral BufferNum
w
objectToInt Object
_ = Maybe a
forall a. Maybe a
Nothing

objectToText :: Object -> Maybe Text
objectToText :: Object -> Maybe Text
objectToText (ObjectString ByteString
w) = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 ByteString
w
objectToText Object
_ = Maybe Text
forall a. Maybe a
Nothing

neovimAsync :: (MonadUnliftIO m) => m a -> m (Async a)
neovimAsync :: forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
neovimAsync m a
m =
  ((forall a. m a -> IO a) -> IO (Async a)) -> m (Async a)
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO (Async a)) -> m (Async a))
-> ((forall a. m a -> IO a) -> IO (Async a)) -> m (Async a)
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
lower ->
    IO (Async a) -> IO (Async a)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Async a) -> IO (Async a)) -> IO (Async a) -> IO (Async a)
forall a b. (a -> b) -> a -> b
$ IO a -> IO (Async a)
forall a. IO a -> IO (Async a)
async (IO a -> IO (Async a)) -> IO a -> IO (Async a)
forall a b. (a -> b) -> a -> b
$ m a -> IO a
forall a. m a -> IO a
lower m a
m

savingCurrentPosition :: Window -> Neovim env a -> Neovim env a
savingCurrentPosition :: forall env a. Window -> Neovim env a -> Neovim env a
savingCurrentPosition Window
w Neovim env a
m = do
  (BufferNum, BufferNum)
c <- Window -> Neovim env (BufferNum, BufferNum)
forall env. Window -> Neovim env (BufferNum, BufferNum)
window_get_cursor Window
w
  Neovim env a
m Neovim env a -> Neovim env () -> Neovim env a
forall a b. Neovim env a -> Neovim env b -> Neovim env a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Window -> (BufferNum, BufferNum) -> Neovim env ()
forall env. Window -> (BufferNum, BufferNum) -> Neovim env ()
window_set_cursor Window
w (BufferNum, BufferNum)
c

savingCurrentWindow :: Neovim env a -> Neovim env a
savingCurrentWindow :: forall env a. Neovim env a -> Neovim env a
savingCurrentWindow Neovim env a
m = do
  Window
w <- Neovim env Window
forall env. Neovim env Window
nvim_get_current_win
  Neovim env a
m Neovim env a -> Neovim env () -> Neovim env a
forall a b. Neovim env a -> Neovim env b -> Neovim env a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Window -> Neovim env ()
forall env. Window -> Neovim env ()
nvim_set_current_win Window
w

windowsForBuffer :: Buffer -> Neovim env [Window]
windowsForBuffer :: forall env. Buffer -> Neovim env [Window]
windowsForBuffer Buffer
b = do
  [Window]
wins <- (Vector Window -> [Window])
-> Neovim env (Vector Window) -> Neovim env [Window]
forall a b. (a -> b) -> Neovim env a -> Neovim env b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector Window -> [Window]
forall a. Vector a -> [a]
V.toList Neovim env (Vector Window)
forall env. Neovim env (Vector Window)
vim_get_windows
  ([Maybe Window] -> [Window])
-> Neovim env [Maybe Window] -> Neovim env [Window]
forall a b. (a -> b) -> Neovim env a -> Neovim env b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe Window] -> [Window]
forall a. [Maybe a] -> [a]
catMaybes (Neovim env [Maybe Window] -> Neovim env [Window])
-> Neovim env [Maybe Window] -> Neovim env [Window]
forall a b. (a -> b) -> a -> b
$ [Window]
-> (Window -> Neovim env (Maybe Window))
-> Neovim env [Maybe Window]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Window]
wins ((Window -> Neovim env (Maybe Window))
 -> Neovim env [Maybe Window])
-> (Window -> Neovim env (Maybe Window))
-> Neovim env [Maybe Window]
forall a b. (a -> b) -> a -> b
$ \Window
w -> do
    Buffer
wb <- Window -> Neovim env Buffer
forall env. Window -> Neovim env Buffer
window_get_buffer Window
w
    Maybe Window -> Neovim env (Maybe Window)
forall a. a -> Neovim env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Window -> Neovim env (Maybe Window))
-> Maybe Window -> Neovim env (Maybe Window)
forall a b. (a -> b) -> a -> b
$ case Buffer
wb Buffer -> Buffer -> Bool
forall a. Eq a => a -> a -> Bool
== Buffer
b of
      Bool
False -> Maybe Window
forall a. Maybe a
Nothing
      Bool
True -> Window -> Maybe Window
forall a. a -> Maybe a
Just Window
w

visibleBuffers :: Neovim env [(Window, Buffer)]
visibleBuffers :: forall env. Neovim env [(Window, Buffer)]
visibleBuffers = do
  [Window]
wins <- (Vector Window -> [Window])
-> Neovim env (Vector Window) -> Neovim env [Window]
forall a b. (a -> b) -> Neovim env a -> Neovim env b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector Window -> [Window]
forall a. Vector a -> [a]
V.toList Neovim env (Vector Window)
forall env. Neovim env (Vector Window)
vim_get_windows
  [Window]
-> (Window -> Neovim env (Window, Buffer))
-> Neovim env [(Window, Buffer)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Window]
wins ((Window -> Neovim env (Window, Buffer))
 -> Neovim env [(Window, Buffer)])
-> (Window -> Neovim env (Window, Buffer))
-> Neovim env [(Window, Buffer)]
forall a b. (a -> b) -> a -> b
$ \Window
w -> (Buffer -> (Window, Buffer))
-> Neovim env Buffer -> Neovim env (Window, Buffer)
forall a b. (a -> b) -> Neovim env a -> Neovim env b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Window
w, ) (Neovim env Buffer -> Neovim env (Window, Buffer))
-> Neovim env Buffer -> Neovim env (Window, Buffer)
forall a b. (a -> b) -> a -> b
$ Window -> Neovim env Buffer
forall env. Window -> Neovim env Buffer
window_get_buffer Window
w

criticalFailure :: Text -> Neovim env a
criticalFailure :: forall env a. Text -> Neovim env a
criticalFailure Text
err = do
  Text -> Neovim env ()
forall env. Text -> Neovim env ()
vim_report_error Text
err
  IO a -> Neovim env a
forall a. IO a -> Neovim env a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Neovim env a) -> IO a -> Neovim env a
forall a b. (a -> b) -> a -> b
$ NeovimException -> IO a
forall e a. Exception e => e -> IO a
throwIO (NeovimException -> IO a) -> NeovimException -> IO a
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle -> Object -> NeovimException
ErrorResult Doc AnsiStyle
"critical error" Object
ObjectNil

modifyBufferStuff :: Buffer -> (BufferStuff -> BufferStuff) -> Neovim CornelisEnv ()
modifyBufferStuff :: Buffer -> (BufferStuff -> BufferStuff) -> Neovim CornelisEnv ()
modifyBufferStuff Buffer
b BufferStuff -> BufferStuff
f = (CornelisState -> CornelisState) -> Neovim CornelisEnv ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((CornelisState -> CornelisState) -> Neovim CornelisEnv ())
-> (CornelisState -> CornelisState) -> Neovim CornelisEnv ()
forall a b. (a -> b) -> a -> b
$! ASetter
  CornelisState
  CornelisState
  (Map Buffer BufferStuff)
  (Map Buffer BufferStuff)
#cs_buffers ASetter
  CornelisState
  CornelisState
  (Map Buffer BufferStuff)
  (Map Buffer BufferStuff)
-> (Map Buffer BufferStuff -> Map Buffer BufferStuff)
-> CornelisState
-> CornelisState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (BufferStuff -> Maybe BufferStuff)
-> Buffer -> Map Buffer BufferStuff -> Map Buffer BufferStuff
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
M.update (BufferStuff -> Maybe BufferStuff
forall a. a -> Maybe a
Just (BufferStuff -> Maybe BufferStuff)
-> (BufferStuff -> BufferStuff) -> BufferStuff -> Maybe BufferStuff
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BufferStuff -> BufferStuff
f) Buffer
b

withBufferStuff :: Monoid a => Buffer -> (BufferStuff -> Neovim CornelisEnv a) -> Neovim CornelisEnv a
withBufferStuff :: forall a.
Monoid a =>
Buffer
-> (BufferStuff -> Neovim CornelisEnv a) -> Neovim CornelisEnv a
withBufferStuff Buffer
b BufferStuff -> Neovim CornelisEnv a
f =
  (CornelisState -> Maybe BufferStuff)
-> Neovim CornelisEnv (Maybe BufferStuff)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Buffer -> Map Buffer BufferStuff -> Maybe BufferStuff
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Buffer
b (Map Buffer BufferStuff -> Maybe BufferStuff)
-> (CornelisState -> Map Buffer BufferStuff)
-> CornelisState
-> Maybe BufferStuff
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CornelisState -> Map Buffer BufferStuff
cs_buffers) Neovim CornelisEnv (Maybe BufferStuff)
-> (Maybe BufferStuff -> Neovim CornelisEnv a)
-> Neovim CornelisEnv a
forall a b.
Neovim CornelisEnv a
-> (a -> Neovim CornelisEnv b) -> Neovim CornelisEnv b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe BufferStuff
Nothing -> Text -> Neovim CornelisEnv ()
forall env. Text -> Neovim env ()
vim_report_error Text
"no buffer stuff!" Neovim CornelisEnv ()
-> Neovim CornelisEnv a -> Neovim CornelisEnv a
forall a b.
Neovim CornelisEnv a
-> Neovim CornelisEnv b -> Neovim CornelisEnv b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Neovim CornelisEnv a
forall a. a -> Neovim CornelisEnv a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
    Just BufferStuff
bs -> BufferStuff -> Neovim CornelisEnv a
f BufferStuff
bs

withLocalEnv :: env -> Neovim env a -> Neovim env' a
withLocalEnv :: forall env a env'. env -> Neovim env a -> Neovim env' a
withLocalEnv env
env (Neovim ReaderT (Config env) IO a
t) = ReaderT (Config env') IO a -> Neovim env' a
forall env a. ReaderT (Config env) IO a -> Neovim env a
Neovim (ReaderT (Config env') IO a -> Neovim env' a)
-> ReaderT (Config env') IO a -> Neovim env' a
forall a b. (a -> b) -> a -> b
$ ((Config env' -> Config env)
 -> ReaderT (Config env) IO a -> ReaderT (Config env') IO a)
-> ReaderT (Config env) IO a
-> (Config env' -> Config env)
-> ReaderT (Config env') IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Config env' -> Config env)
-> ReaderT (Config env) IO a -> ReaderT (Config env') IO a
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT ReaderT (Config env) IO a
t ((Config env' -> Config env) -> ReaderT (Config env') IO a)
-> (Config env' -> Config env) -> ReaderT (Config env') IO a
forall a b. (a -> b) -> a -> b
$ env -> Config env' -> Config env
forall env anotherEnv. env -> Config anotherEnv -> Config env
retypeConfig env
env