module Ribosome.Host.Api.Event where

import Ribosome.Host.Api.Data (Buffer)
import Ribosome.Host.Class.Msgpack.Array (msgpackArray)
import Ribosome.Host.Class.Msgpack.Decode (pattern Msgpack)
import Ribosome.Host.Data.Event (Event (Event))

pattern BufLinesEvent :: Buffer -> Maybe Int -> Int -> Int -> [Text] -> Bool -> Event
pattern $bBufLinesEvent :: Buffer -> Maybe Int -> Int -> Int -> [Text] -> Bool -> Event
$mBufLinesEvent :: forall {r}.
Event
-> (Buffer -> Maybe Int -> Int -> Int -> [Text] -> Bool -> r)
-> (Void# -> r)
-> r
BufLinesEvent {Event -> Buffer
buffer, Event -> Maybe Int
changedtick, Event -> Int
firstline, Event -> Int
lastline, Event -> [Text]
linedata, Event -> Bool
more} <- Event "nvim_buf_lines_event" [
  Msgpack buffer,
  Msgpack changedtick,
  Msgpack firstline,
  Msgpack lastline,
  Msgpack linedata,
  Msgpack more
  ] where
    BufLinesEvent Buffer
b Maybe Int
c Int
f Int
l [Text]
ld Bool
m =
      EventName -> [Object] -> Event
Event EventName
"nvim_buf_lines_event" (Buffer -> Maybe Int -> Int -> Int -> [Text] -> Bool -> [Object]
forall a. MsgpackArray a => a
msgpackArray Buffer
b Maybe Int
c Int
f Int
l [Text]
ld Bool
m)