module Ribosome.Api.Buffer where
import qualified Data.Text as Text (null)
import Exon (exon)
import Path (Abs, Dir, File, Path, parseAbsFile, parseRelFile, (</>))
import Ribosome.Api.Path (nvimCwd)
import Ribosome.Data.FileBuffer (FileBuffer (FileBuffer))
import qualified Ribosome.Host.Api.Data as Data
import Ribosome.Host.Api.Data (Buffer)
import Ribosome.Host.Api.Effect (
bufferGetLines,
bufferGetName,
bufferGetNumber,
bufferGetOption,
bufferIsValid,
bufferSetLines,
nvimBufDelete,
nvimCallFunction,
nvimCommand,
nvimGetCurrentBuf,
nvimWinSetBuf,
vimGetBuffers,
vimGetCurrentBuffer,
vimGetCurrentWindow,
)
import Ribosome.Host.Class.Msgpack.Encode (toMsgpack)
import Ribosome.Host.Data.RpcError (RpcError)
import qualified Ribosome.Host.Effect.Rpc as Rpc
import Ribosome.Host.Effect.Rpc (Rpc)
import Ribosome.Host.Modify (silentBang)
import Ribosome.Host.Path (pathText)
edit ::
Member Rpc r =>
Path b t ->
Sem r ()
edit :: forall (r :: EffectRow) b t. Member Rpc r => Path b t -> Sem r ()
edit Path b t
path =
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 [exon|edit #{pathText path}|]
buflisted ::
Member (Rpc !! RpcError) r =>
Buffer ->
Sem r Bool
buflisted :: forall (r :: EffectRow).
Member (Rpc !! RpcError) r =>
Buffer -> Sem r Bool
buflisted Buffer
buf = do
Bool -> Sem (Rpc : r) Bool -> Sem r Bool
forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
a -> Sem (eff : r) a -> Sem r a
resumeAs Bool
False do
Int
num <- Buffer -> Sem (Rpc : r) Int
forall (r :: EffectRow). Member Rpc r => Buffer -> Sem r Int
bufferGetNumber Buffer
buf
Text -> [Object] -> Sem (Rpc : r) Bool
forall a (r :: EffectRow).
(Member Rpc r, MsgpackDecode a) =>
Text -> [Object] -> Sem r a
nvimCallFunction Text
"buflisted" [Int -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack Int
num]
bufferContent ::
Member Rpc r =>
Buffer ->
Sem r [Text]
bufferContent :: forall (r :: EffectRow). Member Rpc r => Buffer -> Sem r [Text]
bufferContent Buffer
buffer =
Buffer -> Int -> Int -> Bool -> Sem r [Text]
forall (r :: EffectRow).
Member Rpc r =>
Buffer -> Int -> Int -> Bool -> Sem r [Text]
bufferGetLines Buffer
buffer Int
0 (-Int
1) Bool
False
currentBufferContent ::
Member Rpc r =>
Sem r [Text]
currentBufferContent :: forall (r :: EffectRow). Member Rpc r => Sem r [Text]
currentBufferContent =
Buffer -> Sem r [Text]
forall (r :: EffectRow). Member Rpc r => Buffer -> Sem r [Text]
bufferContent (Buffer -> Sem r [Text]) -> Sem r Buffer -> Sem r [Text]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem r Buffer
forall (r :: EffectRow). Member Rpc r => Sem r Buffer
vimGetCurrentBuffer
setBufferContent ::
Member Rpc r =>
Buffer ->
[Text] ->
Sem r ()
setBufferContent :: forall (r :: EffectRow).
Member Rpc r =>
Buffer -> [Text] -> Sem r ()
setBufferContent Buffer
buffer =
Buffer -> Int -> Int -> Bool -> [Text] -> Sem r ()
forall (r :: EffectRow).
Member Rpc r =>
Buffer -> Int -> Int -> Bool -> [Text] -> Sem r ()
bufferSetLines Buffer
buffer Int
0 (-Int
1) Bool
False
setCurrentBufferContent ::
Member Rpc r =>
[Text] ->
Sem r ()
setCurrentBufferContent :: forall (r :: EffectRow). Member Rpc r => [Text] -> Sem r ()
setCurrentBufferContent [Text]
content = do
Buffer
buffer <- Sem r Buffer
forall (r :: EffectRow). Member Rpc r => Sem r Buffer
vimGetCurrentBuffer
Buffer -> [Text] -> Sem r ()
forall (r :: EffectRow).
Member Rpc r =>
Buffer -> [Text] -> Sem r ()
setBufferContent Buffer
buffer [Text]
content
setBufferLine ::
Member Rpc r =>
Buffer ->
Int ->
Text ->
Sem r ()
setBufferLine :: forall (r :: EffectRow).
Member Rpc r =>
Buffer -> Int -> Text -> Sem r ()
setBufferLine Buffer
buffer Int
line Text
text =
Buffer -> Int -> Int -> Bool -> [Text] -> Sem r ()
forall (r :: EffectRow).
Member Rpc r =>
Buffer -> Int -> Int -> Bool -> [Text] -> Sem r ()
bufferSetLines Buffer
buffer Int
line (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Bool
False [Text
Item [Text]
text]
whenValid ::
Member Rpc r =>
(Buffer -> Sem r ()) ->
Buffer ->
Sem r ()
whenValid :: forall (r :: EffectRow).
Member Rpc r =>
(Buffer -> Sem r ()) -> Buffer -> Sem r ()
whenValid Buffer -> Sem r ()
use Buffer
buffer =
Sem r Bool -> Sem r () -> Sem r ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Buffer -> Sem r Bool
forall (r :: EffectRow). Member Rpc r => Buffer -> Sem r Bool
bufferIsValid Buffer
buffer) (Buffer -> Sem r ()
use Buffer
buffer)
withBufferNumber ::
Member Rpc r =>
(Int -> Sem r ()) ->
Buffer ->
Sem r ()
withBufferNumber :: forall (r :: EffectRow).
Member Rpc r =>
(Int -> Sem r ()) -> Buffer -> Sem r ()
withBufferNumber Int -> Sem r ()
run =
(Buffer -> Sem r ()) -> Buffer -> Sem r ()
forall (r :: EffectRow).
Member Rpc r =>
(Buffer -> Sem r ()) -> Buffer -> Sem r ()
whenValid (Int -> Sem r ()
run (Int -> Sem r ()) -> (Buffer -> Sem r Int) -> Buffer -> Sem r ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Buffer -> Sem r Int
forall (r :: EffectRow). Member Rpc r => Buffer -> Sem r Int
bufferGetNumber)
closeBuffer ::
Member Rpc r =>
Buffer ->
Sem r ()
closeBuffer :: forall (r :: EffectRow). Member Rpc r => Buffer -> Sem r ()
closeBuffer =
Sem r () -> Sem r ()
forall (r :: EffectRow) a. Member Rpc r => Sem r a -> Sem r a
silentBang (Sem r () -> Sem r ())
-> (Buffer -> Sem r ()) -> Buffer -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Sem r ()) -> Buffer -> Sem r ()
forall (r :: EffectRow).
Member Rpc r =>
(Int -> Sem r ()) -> Buffer -> Sem r ()
withBufferNumber Int -> Sem r ()
forall {r :: EffectRow} {a}.
(Member Rpc r, Show a) =>
a -> Sem r ()
del
where
del :: a -> Sem r ()
del a
number =
Text -> Sem r ()
forall (r :: EffectRow). Member Rpc r => Text -> Sem r ()
nvimCommand [exon|bdelete! #{show number}|]
wipeBuffer ::
Member Rpc r =>
Buffer ->
Sem r ()
wipeBuffer :: forall (r :: EffectRow). Member Rpc r => Buffer -> Sem r ()
wipeBuffer =
(Buffer -> Sem r ()) -> Buffer -> Sem r ()
forall (r :: EffectRow).
Member Rpc r =>
(Buffer -> Sem r ()) -> Buffer -> Sem r ()
whenValid \ Buffer
b -> Buffer -> Map Text Object -> Sem r ()
forall (r :: EffectRow).
Member Rpc r =>
Buffer -> Map Text Object -> Sem r ()
nvimBufDelete Buffer
b [(Text
"force", Bool -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack Bool
True)]
unloadBuffer ::
Member Rpc r =>
Buffer ->
Sem r ()
unloadBuffer :: forall (r :: EffectRow). Member Rpc r => Buffer -> Sem r ()
unloadBuffer =
(Buffer -> Sem r ()) -> Buffer -> Sem r ()
forall (r :: EffectRow).
Member Rpc r =>
(Buffer -> Sem r ()) -> Buffer -> Sem r ()
whenValid \ Buffer
b -> Buffer -> Map Text Object -> Sem r ()
forall (r :: EffectRow).
Member Rpc r =>
Buffer -> Map Text Object -> Sem r ()
nvimBufDelete Buffer
b [(Text
"force", Bool -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack Bool
True), (Text
"unload", Bool -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack Bool
True)]
addBuffer ::
Member Rpc r =>
Text ->
Sem r ()
addBuffer :: forall (r :: EffectRow). Member Rpc r => Text -> Sem r ()
addBuffer Text
path =
Text -> Sem r ()
forall (r :: EffectRow). Member Rpc r => Text -> Sem r ()
nvimCommand [exon|badd #{path}|]
fileBuffer ::
Path Abs Dir ->
Buffer ->
Text ->
Maybe FileBuffer
fileBuffer :: Path Abs Dir -> Buffer -> Text -> Maybe FileBuffer
fileBuffer Path Abs Dir
cwd Buffer
buffer (Text -> String
forall a. ToString a => a -> String
toString -> String
path) =
Buffer -> Path Abs File -> FileBuffer
FileBuffer Buffer
buffer (Path Abs File -> FileBuffer)
-> Maybe (Path Abs File) -> Maybe FileBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Maybe (Path Abs File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Abs File)
parseAbsFile String
path Maybe (Path Abs File)
-> Maybe (Path Abs File) -> Maybe (Path Abs File)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Path Abs Dir
cwd Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</>) (Path Rel File -> Path Abs File)
-> Maybe (Path Rel File) -> Maybe (Path Abs File)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe (Path Rel File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile String
path)
fileBuffers ::
Member Rpc r =>
Sem r [FileBuffer]
fileBuffers :: forall (r :: EffectRow). Member Rpc r => Sem r [FileBuffer]
fileBuffers = do
Path Abs Dir
cwd <- Sem r (Path Abs Dir)
forall (r :: EffectRow). Member Rpc r => Sem r (Path Abs Dir)
nvimCwd
[Buffer]
buffers <- Sem r [Buffer]
forall (r :: EffectRow). Member Rpc r => Sem r [Buffer]
vimGetBuffers
[Text]
names <- RpcCall [Text] -> Sem r [Text]
forall (r :: EffectRow) a. Member Rpc r => RpcCall a -> Sem r a
Rpc.sync ((Buffer -> RpcCall [Text]) -> [Buffer] -> RpcCall [Text]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Text -> [Text]) -> RpcCall Text -> RpcCall [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RpcCall Text -> RpcCall [Text])
-> (Buffer -> RpcCall Text) -> Buffer -> RpcCall [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Buffer -> RpcCall Text
Data.bufferGetName) [Buffer]
buffers)
pure ([Maybe FileBuffer] -> [FileBuffer]
forall a. [Maybe a] -> [a]
catMaybes ((Buffer -> Text -> Maybe FileBuffer)
-> [Buffer] -> [Text] -> [Maybe FileBuffer]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Path Abs Dir -> Buffer -> Text -> Maybe FileBuffer
fileBuffer Path Abs Dir
cwd) [Buffer]
buffers [Text]
names))
bufferForFile ::
Member Rpc r =>
Path Abs File ->
Sem r (Maybe FileBuffer)
bufferForFile :: forall (r :: EffectRow).
Member Rpc r =>
Path Abs File -> Sem r (Maybe FileBuffer)
bufferForFile Path Abs File
target =
(FileBuffer -> Bool) -> [FileBuffer] -> Maybe FileBuffer
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find FileBuffer -> Bool
sameBuffer ([FileBuffer] -> Maybe FileBuffer)
-> Sem r [FileBuffer] -> Sem r (Maybe FileBuffer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem r [FileBuffer]
forall (r :: EffectRow). Member Rpc r => Sem r [FileBuffer]
fileBuffers
where
sameBuffer :: FileBuffer -> Bool
sameBuffer (FileBuffer Buffer
_ Path Abs File
path) =
Path Abs File
path Path Abs File -> Path Abs File -> Bool
forall a. Eq a => a -> a -> Bool
== Path Abs File
target
currentBufferName ::
Member Rpc r =>
Sem r Text
currentBufferName :: forall (r :: EffectRow). Member Rpc r => Sem r Text
currentBufferName =
Buffer -> Sem r Text
forall (r :: EffectRow). Member Rpc r => Buffer -> Sem r Text
bufferGetName (Buffer -> Sem r Text) -> Sem r Buffer -> Sem r Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem r Buffer
forall (r :: EffectRow). Member Rpc r => Sem r Buffer
vimGetCurrentBuffer
setCurrentBuffer ::
Member Rpc r =>
Buffer ->
Sem r ()
setCurrentBuffer :: forall (r :: EffectRow). Member Rpc r => Buffer -> Sem r ()
setCurrentBuffer Buffer
buf = do
Window
win <- Sem r Window
forall (r :: EffectRow). Member Rpc r => Sem r Window
vimGetCurrentWindow
Window -> Buffer -> Sem r ()
forall (r :: EffectRow).
Member Rpc r =>
Window -> Buffer -> Sem r ()
nvimWinSetBuf Window
win Buffer
buf
bufferIsFile ::
Member Rpc r =>
Buffer ->
Sem r Bool
bufferIsFile :: forall (r :: EffectRow). Member Rpc r => Buffer -> Sem r Bool
bufferIsFile Buffer
buf =
Text -> Bool
Text.null (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
bufferGetOption Buffer
buf Text
"buftype"
bufferCount ::
Member Rpc r =>
Sem r Natural
bufferCount :: forall (r :: EffectRow). Member Rpc r => Sem r Natural
bufferCount =
Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural) -> ([Buffer] -> Int) -> [Buffer] -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Buffer] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Buffer] -> Natural) -> Sem r [Buffer] -> Sem r Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem r [Buffer]
forall (r :: EffectRow). Member Rpc r => Sem r [Buffer]
vimGetBuffers
bufferPath ::
Member Rpc r =>
Buffer ->
Sem r (Maybe (Path Abs File))
bufferPath :: forall (r :: EffectRow).
Member Rpc r =>
Buffer -> Sem r (Maybe (Path Abs File))
bufferPath Buffer
buffer = do
RpcCall (Maybe (Path Abs File)) -> Sem r (Maybe (Path Abs File))
forall (r :: EffectRow) a. Member Rpc r => RpcCall a -> Sem r a
Rpc.sync do
Path Abs Dir
cwd <- Text -> [Object] -> RpcCall (Path Abs Dir)
forall a. MsgpackDecode a => Text -> [Object] -> RpcCall a
Data.vimCallFunction Text
"getcwd" []
Text
name <- Buffer -> RpcCall Text
Data.bufferGetName Buffer
buffer
pure (Path Abs Dir -> Buffer -> Text -> Maybe FileBuffer
fileBuffer Path Abs Dir
cwd Buffer
buffer Text
name Maybe FileBuffer
-> (FileBuffer -> Path Abs File) -> Maybe (Path Abs File)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ (FileBuffer Buffer
_ Path Abs File
path) -> Path Abs File
path)
currentBufferPath ::
Member Rpc r =>
Sem r (Maybe (Path Abs File))
currentBufferPath :: forall (r :: EffectRow).
Member Rpc r =>
Sem r (Maybe (Path Abs File))
currentBufferPath =
Buffer -> Sem r (Maybe (Path Abs File))
forall (r :: EffectRow).
Member Rpc r =>
Buffer -> Sem r (Maybe (Path Abs File))
bufferPath (Buffer -> Sem r (Maybe (Path Abs File)))
-> Sem r Buffer -> Sem r (Maybe (Path Abs File))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem r Buffer
forall (r :: EffectRow). Member Rpc r => Sem r Buffer
nvimGetCurrentBuf
filterListed ::
Member Rpc r =>
[Buffer] ->
Sem r [Buffer]
filterListed :: forall (r :: EffectRow). Member Rpc r => [Buffer] -> Sem r [Buffer]
filterListed [Buffer]
bufs = do
[Int]
nums <- RpcCall [Int] -> Sem r [Int]
forall (r :: EffectRow) a. Member Rpc r => RpcCall a -> Sem r a
Rpc.sync ((Buffer -> RpcCall Int) -> [Buffer] -> RpcCall [Int]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Buffer -> RpcCall Int
Data.bufferGetNumber [Buffer]
bufs)
[Bool]
listedFlags <- RpcCall [Bool] -> Sem r [Bool]
forall (r :: EffectRow) a. Member Rpc r => RpcCall a -> Sem r a
Rpc.sync ((Int -> RpcCall Bool) -> [Int] -> RpcCall [Bool]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Text -> [Object] -> RpcCall Bool
forall a. MsgpackDecode a => Text -> [Object] -> RpcCall a
Data.nvimCallFunction Text
"buflisted" ([Object] -> RpcCall Bool)
-> (Int -> [Object]) -> Int -> RpcCall Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> [Object]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> [Object]) -> (Int -> Object) -> Int -> [Object]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack) [Int]
nums)
let listed :: [Buffer]
listed = ((Buffer, Bool) -> Maybe Buffer) -> [(Buffer, Bool)] -> [Buffer]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Buffer, Bool) -> Maybe Buffer
forall {a}. (a, Bool) -> Maybe a
chooseListed ([Buffer] -> [Bool] -> [(Buffer, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Buffer]
bufs [Bool]
listedFlags)
[Text]
buftypes :: [Text] <- RpcCall [Text] -> Sem r [Text]
forall (r :: EffectRow) a. Member Rpc r => RpcCall a -> Sem r a
Rpc.sync ((Buffer -> RpcCall Text) -> [Buffer] -> RpcCall [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\ Buffer
buf -> Buffer -> Text -> RpcCall Text
forall a. MsgpackDecode a => Buffer -> Text -> RpcCall a
Data.bufferGetOption Buffer
buf Text
"buftype") [Buffer]
listed)
pure (((Buffer, Text) -> Maybe Buffer) -> [(Buffer, Text)] -> [Buffer]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Buffer, Text) -> Maybe Buffer
forall {a}. (a, Text) -> Maybe a
chooseEmptyTypes ([Buffer] -> [Text] -> [(Buffer, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Buffer]
bufs [Text]
buftypes))
where
chooseListed :: (a, Bool) -> Maybe a
chooseListed (a
b, Bool
l) =
if Bool
l then a -> Maybe a
forall a. a -> Maybe a
Just a
b else Maybe a
forall a. Maybe a
Nothing
chooseEmptyTypes :: (a, Text) -> Maybe a
chooseEmptyTypes = \case
(a
b, Text
"") -> a -> Maybe a
forall a. a -> Maybe a
Just a
b
(a
_, Text
_) -> Maybe a
forall a. Maybe a
Nothing