module Ribosome.Host.Data.RpcType where

import Data.MessagePack (Object)
import Exon (exon)

import Ribosome.Host.Class.Msgpack.Decode (MsgpackDecode)
import Ribosome.Host.Class.Msgpack.Encode (MsgpackEncode)
import Ribosome.Host.Data.RpcName (RpcName (RpcName), unRpcName)

-- |A set of autocmd event specifiers, like @BufEnter@, used to create and trigger autocmds.
newtype AutocmdEvents =
  AutocmdEvents { AutocmdEvents -> [Text]
unAutocmdEvent :: [Text] }
  deriving stock (AutocmdEvents -> AutocmdEvents -> Bool
(AutocmdEvents -> AutocmdEvents -> Bool)
-> (AutocmdEvents -> AutocmdEvents -> Bool) -> Eq AutocmdEvents
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AutocmdEvents -> AutocmdEvents -> Bool
$c/= :: AutocmdEvents -> AutocmdEvents -> Bool
== :: AutocmdEvents -> AutocmdEvents -> Bool
$c== :: AutocmdEvents -> AutocmdEvents -> Bool
Eq, Int -> AutocmdEvents -> ShowS
[AutocmdEvents] -> ShowS
AutocmdEvents -> String
(Int -> AutocmdEvents -> ShowS)
-> (AutocmdEvents -> String)
-> ([AutocmdEvents] -> ShowS)
-> Show AutocmdEvents
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AutocmdEvents] -> ShowS
$cshowList :: [AutocmdEvents] -> ShowS
show :: AutocmdEvents -> String
$cshow :: AutocmdEvents -> String
showsPrec :: Int -> AutocmdEvents -> ShowS
$cshowsPrec :: Int -> AutocmdEvents -> ShowS
Show, (forall x. AutocmdEvents -> Rep AutocmdEvents x)
-> (forall x. Rep AutocmdEvents x -> AutocmdEvents)
-> Generic AutocmdEvents
forall x. Rep AutocmdEvents x -> AutocmdEvents
forall x. AutocmdEvents -> Rep AutocmdEvents x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AutocmdEvents x -> AutocmdEvents
$cfrom :: forall x. AutocmdEvents -> Rep AutocmdEvents x
Generic)
  deriving newtype (AutocmdEvents -> Object
(AutocmdEvents -> Object) -> MsgpackEncode AutocmdEvents
forall a. (a -> Object) -> MsgpackEncode a
toMsgpack :: AutocmdEvents -> Object
$ctoMsgpack :: AutocmdEvents -> Object
MsgpackEncode, Object -> Either DecodeError AutocmdEvents
(Object -> Either DecodeError AutocmdEvents)
-> MsgpackDecode AutocmdEvents
forall a. (Object -> Either DecodeError a) -> MsgpackDecode a
fromMsgpack :: Object -> Either DecodeError AutocmdEvents
$cfromMsgpack :: Object -> Either DecodeError AutocmdEvents
MsgpackDecode)

instance IsString AutocmdEvents where
  fromString :: String -> AutocmdEvents
fromString =
    [Text] -> AutocmdEvents
AutocmdEvents ([Text] -> AutocmdEvents)
-> (String -> [Text]) -> String -> AutocmdEvents
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [Text]) -> (String -> Text) -> String -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString

-- |A file pattern like @*.hs@ that defines the files in which an autocmd should be triggered.
--
-- If the 'AutocmdEvents' contain @User@, this denotes the custom event name.
newtype AutocmdPatterns =
  AutocmdPatterns { AutocmdPatterns -> [Text]
unAutocmdPattern :: [Text] }
  deriving stock (AutocmdPatterns -> AutocmdPatterns -> Bool
(AutocmdPatterns -> AutocmdPatterns -> Bool)
-> (AutocmdPatterns -> AutocmdPatterns -> Bool)
-> Eq AutocmdPatterns
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AutocmdPatterns -> AutocmdPatterns -> Bool
$c/= :: AutocmdPatterns -> AutocmdPatterns -> Bool
== :: AutocmdPatterns -> AutocmdPatterns -> Bool
$c== :: AutocmdPatterns -> AutocmdPatterns -> Bool
Eq, Int -> AutocmdPatterns -> ShowS
[AutocmdPatterns] -> ShowS
AutocmdPatterns -> String
(Int -> AutocmdPatterns -> ShowS)
-> (AutocmdPatterns -> String)
-> ([AutocmdPatterns] -> ShowS)
-> Show AutocmdPatterns
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AutocmdPatterns] -> ShowS
$cshowList :: [AutocmdPatterns] -> ShowS
show :: AutocmdPatterns -> String
$cshow :: AutocmdPatterns -> String
showsPrec :: Int -> AutocmdPatterns -> ShowS
$cshowsPrec :: Int -> AutocmdPatterns -> ShowS
Show)
  deriving newtype (AutocmdPatterns -> Object
(AutocmdPatterns -> Object) -> MsgpackEncode AutocmdPatterns
forall a. (a -> Object) -> MsgpackEncode a
toMsgpack :: AutocmdPatterns -> Object
$ctoMsgpack :: AutocmdPatterns -> Object
MsgpackEncode, Object -> Either DecodeError AutocmdPatterns
(Object -> Either DecodeError AutocmdPatterns)
-> MsgpackDecode AutocmdPatterns
forall a. (Object -> Either DecodeError a) -> MsgpackDecode a
fromMsgpack :: Object -> Either DecodeError AutocmdPatterns
$cfromMsgpack :: Object -> Either DecodeError AutocmdPatterns
MsgpackDecode)

instance IsString AutocmdPatterns where
  fromString :: String -> AutocmdPatterns
fromString =
    [Text] -> AutocmdPatterns
AutocmdPatterns ([Text] -> AutocmdPatterns)
-> (String -> [Text]) -> String -> AutocmdPatterns
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [Text]) -> (String -> Text) -> String -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString

instance Default AutocmdPatterns where
  def :: AutocmdPatterns
def =
    AutocmdPatterns
"*"

-- |The buffer number in which a buffer autocmd is supposed to be created.
newtype AutocmdBuffer =
  AutocmdBuffer { AutocmdBuffer -> Int
unAutocmdBuffer :: Int }
  deriving stock (AutocmdBuffer -> AutocmdBuffer -> Bool
(AutocmdBuffer -> AutocmdBuffer -> Bool)
-> (AutocmdBuffer -> AutocmdBuffer -> Bool) -> Eq AutocmdBuffer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AutocmdBuffer -> AutocmdBuffer -> Bool
$c/= :: AutocmdBuffer -> AutocmdBuffer -> Bool
== :: AutocmdBuffer -> AutocmdBuffer -> Bool
$c== :: AutocmdBuffer -> AutocmdBuffer -> Bool
Eq, Int -> AutocmdBuffer -> ShowS
[AutocmdBuffer] -> ShowS
AutocmdBuffer -> String
(Int -> AutocmdBuffer -> ShowS)
-> (AutocmdBuffer -> String)
-> ([AutocmdBuffer] -> ShowS)
-> Show AutocmdBuffer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AutocmdBuffer] -> ShowS
$cshowList :: [AutocmdBuffer] -> ShowS
show :: AutocmdBuffer -> String
$cshow :: AutocmdBuffer -> String
showsPrec :: Int -> AutocmdBuffer -> ShowS
$cshowsPrec :: Int -> AutocmdBuffer -> ShowS
Show)
  deriving newtype (Integer -> AutocmdBuffer
AutocmdBuffer -> AutocmdBuffer
AutocmdBuffer -> AutocmdBuffer -> AutocmdBuffer
(AutocmdBuffer -> AutocmdBuffer -> AutocmdBuffer)
-> (AutocmdBuffer -> AutocmdBuffer -> AutocmdBuffer)
-> (AutocmdBuffer -> AutocmdBuffer -> AutocmdBuffer)
-> (AutocmdBuffer -> AutocmdBuffer)
-> (AutocmdBuffer -> AutocmdBuffer)
-> (AutocmdBuffer -> AutocmdBuffer)
-> (Integer -> AutocmdBuffer)
-> Num AutocmdBuffer
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> AutocmdBuffer
$cfromInteger :: Integer -> AutocmdBuffer
signum :: AutocmdBuffer -> AutocmdBuffer
$csignum :: AutocmdBuffer -> AutocmdBuffer
abs :: AutocmdBuffer -> AutocmdBuffer
$cabs :: AutocmdBuffer -> AutocmdBuffer
negate :: AutocmdBuffer -> AutocmdBuffer
$cnegate :: AutocmdBuffer -> AutocmdBuffer
* :: AutocmdBuffer -> AutocmdBuffer -> AutocmdBuffer
$c* :: AutocmdBuffer -> AutocmdBuffer -> AutocmdBuffer
- :: AutocmdBuffer -> AutocmdBuffer -> AutocmdBuffer
$c- :: AutocmdBuffer -> AutocmdBuffer -> AutocmdBuffer
+ :: AutocmdBuffer -> AutocmdBuffer -> AutocmdBuffer
$c+ :: AutocmdBuffer -> AutocmdBuffer -> AutocmdBuffer
Num, Num AutocmdBuffer
Ord AutocmdBuffer
Num AutocmdBuffer
-> Ord AutocmdBuffer
-> (AutocmdBuffer -> Rational)
-> Real AutocmdBuffer
AutocmdBuffer -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: AutocmdBuffer -> Rational
$ctoRational :: AutocmdBuffer -> Rational
Real, Int -> AutocmdBuffer
AutocmdBuffer -> Int
AutocmdBuffer -> [AutocmdBuffer]
AutocmdBuffer -> AutocmdBuffer
AutocmdBuffer -> AutocmdBuffer -> [AutocmdBuffer]
AutocmdBuffer -> AutocmdBuffer -> AutocmdBuffer -> [AutocmdBuffer]
(AutocmdBuffer -> AutocmdBuffer)
-> (AutocmdBuffer -> AutocmdBuffer)
-> (Int -> AutocmdBuffer)
-> (AutocmdBuffer -> Int)
-> (AutocmdBuffer -> [AutocmdBuffer])
-> (AutocmdBuffer -> AutocmdBuffer -> [AutocmdBuffer])
-> (AutocmdBuffer -> AutocmdBuffer -> [AutocmdBuffer])
-> (AutocmdBuffer
    -> AutocmdBuffer -> AutocmdBuffer -> [AutocmdBuffer])
-> Enum AutocmdBuffer
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: AutocmdBuffer -> AutocmdBuffer -> AutocmdBuffer -> [AutocmdBuffer]
$cenumFromThenTo :: AutocmdBuffer -> AutocmdBuffer -> AutocmdBuffer -> [AutocmdBuffer]
enumFromTo :: AutocmdBuffer -> AutocmdBuffer -> [AutocmdBuffer]
$cenumFromTo :: AutocmdBuffer -> AutocmdBuffer -> [AutocmdBuffer]
enumFromThen :: AutocmdBuffer -> AutocmdBuffer -> [AutocmdBuffer]
$cenumFromThen :: AutocmdBuffer -> AutocmdBuffer -> [AutocmdBuffer]
enumFrom :: AutocmdBuffer -> [AutocmdBuffer]
$cenumFrom :: AutocmdBuffer -> [AutocmdBuffer]
fromEnum :: AutocmdBuffer -> Int
$cfromEnum :: AutocmdBuffer -> Int
toEnum :: Int -> AutocmdBuffer
$ctoEnum :: Int -> AutocmdBuffer
pred :: AutocmdBuffer -> AutocmdBuffer
$cpred :: AutocmdBuffer -> AutocmdBuffer
succ :: AutocmdBuffer -> AutocmdBuffer
$csucc :: AutocmdBuffer -> AutocmdBuffer
Enum, Enum AutocmdBuffer
Real AutocmdBuffer
Real AutocmdBuffer
-> Enum AutocmdBuffer
-> (AutocmdBuffer -> AutocmdBuffer -> AutocmdBuffer)
-> (AutocmdBuffer -> AutocmdBuffer -> AutocmdBuffer)
-> (AutocmdBuffer -> AutocmdBuffer -> AutocmdBuffer)
-> (AutocmdBuffer -> AutocmdBuffer -> AutocmdBuffer)
-> (AutocmdBuffer
    -> AutocmdBuffer -> (AutocmdBuffer, AutocmdBuffer))
-> (AutocmdBuffer
    -> AutocmdBuffer -> (AutocmdBuffer, AutocmdBuffer))
-> (AutocmdBuffer -> Integer)
-> Integral AutocmdBuffer
AutocmdBuffer -> Integer
AutocmdBuffer -> AutocmdBuffer -> (AutocmdBuffer, AutocmdBuffer)
AutocmdBuffer -> AutocmdBuffer -> AutocmdBuffer
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: AutocmdBuffer -> Integer
$ctoInteger :: AutocmdBuffer -> Integer
divMod :: AutocmdBuffer -> AutocmdBuffer -> (AutocmdBuffer, AutocmdBuffer)
$cdivMod :: AutocmdBuffer -> AutocmdBuffer -> (AutocmdBuffer, AutocmdBuffer)
quotRem :: AutocmdBuffer -> AutocmdBuffer -> (AutocmdBuffer, AutocmdBuffer)
$cquotRem :: AutocmdBuffer -> AutocmdBuffer -> (AutocmdBuffer, AutocmdBuffer)
mod :: AutocmdBuffer -> AutocmdBuffer -> AutocmdBuffer
$cmod :: AutocmdBuffer -> AutocmdBuffer -> AutocmdBuffer
div :: AutocmdBuffer -> AutocmdBuffer -> AutocmdBuffer
$cdiv :: AutocmdBuffer -> AutocmdBuffer -> AutocmdBuffer
rem :: AutocmdBuffer -> AutocmdBuffer -> AutocmdBuffer
$crem :: AutocmdBuffer -> AutocmdBuffer -> AutocmdBuffer
quot :: AutocmdBuffer -> AutocmdBuffer -> AutocmdBuffer
$cquot :: AutocmdBuffer -> AutocmdBuffer -> AutocmdBuffer
Integral, Eq AutocmdBuffer
Eq AutocmdBuffer
-> (AutocmdBuffer -> AutocmdBuffer -> Ordering)
-> (AutocmdBuffer -> AutocmdBuffer -> Bool)
-> (AutocmdBuffer -> AutocmdBuffer -> Bool)
-> (AutocmdBuffer -> AutocmdBuffer -> Bool)
-> (AutocmdBuffer -> AutocmdBuffer -> Bool)
-> (AutocmdBuffer -> AutocmdBuffer -> AutocmdBuffer)
-> (AutocmdBuffer -> AutocmdBuffer -> AutocmdBuffer)
-> Ord AutocmdBuffer
AutocmdBuffer -> AutocmdBuffer -> Bool
AutocmdBuffer -> AutocmdBuffer -> Ordering
AutocmdBuffer -> AutocmdBuffer -> AutocmdBuffer
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AutocmdBuffer -> AutocmdBuffer -> AutocmdBuffer
$cmin :: AutocmdBuffer -> AutocmdBuffer -> AutocmdBuffer
max :: AutocmdBuffer -> AutocmdBuffer -> AutocmdBuffer
$cmax :: AutocmdBuffer -> AutocmdBuffer -> AutocmdBuffer
>= :: AutocmdBuffer -> AutocmdBuffer -> Bool
$c>= :: AutocmdBuffer -> AutocmdBuffer -> Bool
> :: AutocmdBuffer -> AutocmdBuffer -> Bool
$c> :: AutocmdBuffer -> AutocmdBuffer -> Bool
<= :: AutocmdBuffer -> AutocmdBuffer -> Bool
$c<= :: AutocmdBuffer -> AutocmdBuffer -> Bool
< :: AutocmdBuffer -> AutocmdBuffer -> Bool
$c< :: AutocmdBuffer -> AutocmdBuffer -> Bool
compare :: AutocmdBuffer -> AutocmdBuffer -> Ordering
$ccompare :: AutocmdBuffer -> AutocmdBuffer -> Ordering
Ord, AutocmdBuffer -> Object
(AutocmdBuffer -> Object) -> MsgpackEncode AutocmdBuffer
forall a. (a -> Object) -> MsgpackEncode a
toMsgpack :: AutocmdBuffer -> Object
$ctoMsgpack :: AutocmdBuffer -> Object
MsgpackEncode, Object -> Either DecodeError AutocmdBuffer
(Object -> Either DecodeError AutocmdBuffer)
-> MsgpackDecode AutocmdBuffer
forall a. (Object -> Either DecodeError a) -> MsgpackDecode a
fromMsgpack :: Object -> Either DecodeError AutocmdBuffer
$cfromMsgpack :: Object -> Either DecodeError AutocmdBuffer
MsgpackDecode)

-- |An autocmd group.
newtype AutocmdGroup =
  AutocmdGroup { AutocmdGroup -> Text
unAutocmdGroup :: Text }
  deriving stock (AutocmdGroup -> AutocmdGroup -> Bool
(AutocmdGroup -> AutocmdGroup -> Bool)
-> (AutocmdGroup -> AutocmdGroup -> Bool) -> Eq AutocmdGroup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AutocmdGroup -> AutocmdGroup -> Bool
$c/= :: AutocmdGroup -> AutocmdGroup -> Bool
== :: AutocmdGroup -> AutocmdGroup -> Bool
$c== :: AutocmdGroup -> AutocmdGroup -> Bool
Eq, Int -> AutocmdGroup -> ShowS
[AutocmdGroup] -> ShowS
AutocmdGroup -> String
(Int -> AutocmdGroup -> ShowS)
-> (AutocmdGroup -> String)
-> ([AutocmdGroup] -> ShowS)
-> Show AutocmdGroup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AutocmdGroup] -> ShowS
$cshowList :: [AutocmdGroup] -> ShowS
show :: AutocmdGroup -> String
$cshow :: AutocmdGroup -> String
showsPrec :: Int -> AutocmdGroup -> ShowS
$cshowsPrec :: Int -> AutocmdGroup -> ShowS
Show)
  deriving newtype (String -> AutocmdGroup
(String -> AutocmdGroup) -> IsString AutocmdGroup
forall a. (String -> a) -> IsString a
fromString :: String -> AutocmdGroup
$cfromString :: String -> AutocmdGroup
IsString, Eq AutocmdGroup
Eq AutocmdGroup
-> (AutocmdGroup -> AutocmdGroup -> Ordering)
-> (AutocmdGroup -> AutocmdGroup -> Bool)
-> (AutocmdGroup -> AutocmdGroup -> Bool)
-> (AutocmdGroup -> AutocmdGroup -> Bool)
-> (AutocmdGroup -> AutocmdGroup -> Bool)
-> (AutocmdGroup -> AutocmdGroup -> AutocmdGroup)
-> (AutocmdGroup -> AutocmdGroup -> AutocmdGroup)
-> Ord AutocmdGroup
AutocmdGroup -> AutocmdGroup -> Bool
AutocmdGroup -> AutocmdGroup -> Ordering
AutocmdGroup -> AutocmdGroup -> AutocmdGroup
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AutocmdGroup -> AutocmdGroup -> AutocmdGroup
$cmin :: AutocmdGroup -> AutocmdGroup -> AutocmdGroup
max :: AutocmdGroup -> AutocmdGroup -> AutocmdGroup
$cmax :: AutocmdGroup -> AutocmdGroup -> AutocmdGroup
>= :: AutocmdGroup -> AutocmdGroup -> Bool
$c>= :: AutocmdGroup -> AutocmdGroup -> Bool
> :: AutocmdGroup -> AutocmdGroup -> Bool
$c> :: AutocmdGroup -> AutocmdGroup -> Bool
<= :: AutocmdGroup -> AutocmdGroup -> Bool
$c<= :: AutocmdGroup -> AutocmdGroup -> Bool
< :: AutocmdGroup -> AutocmdGroup -> Bool
$c< :: AutocmdGroup -> AutocmdGroup -> Bool
compare :: AutocmdGroup -> AutocmdGroup -> Ordering
$ccompare :: AutocmdGroup -> AutocmdGroup -> Ordering
Ord, AutocmdGroup -> Object
(AutocmdGroup -> Object) -> MsgpackEncode AutocmdGroup
forall a. (a -> Object) -> MsgpackEncode a
toMsgpack :: AutocmdGroup -> Object
$ctoMsgpack :: AutocmdGroup -> Object
MsgpackEncode, Object -> Either DecodeError AutocmdGroup
(Object -> Either DecodeError AutocmdGroup)
-> MsgpackDecode AutocmdGroup
forall a. (Object -> Either DecodeError a) -> MsgpackDecode a
fromMsgpack :: Object -> Either DecodeError AutocmdGroup
$cfromMsgpack :: Object -> Either DecodeError AutocmdGroup
MsgpackDecode)

-- |The options with which an autocmd may be defined.
--
-- See @:help :autocmd@.
data AutocmdOptions =
  AutocmdOptions {
    AutocmdOptions -> Either AutocmdBuffer AutocmdPatterns
target :: Either AutocmdBuffer AutocmdPatterns,
    AutocmdOptions -> Bool
nested :: Bool,
    AutocmdOptions -> Bool
once :: Bool,
    AutocmdOptions -> Maybe AutocmdGroup
group :: Maybe AutocmdGroup
  }
  deriving stock (AutocmdOptions -> AutocmdOptions -> Bool
(AutocmdOptions -> AutocmdOptions -> Bool)
-> (AutocmdOptions -> AutocmdOptions -> Bool) -> Eq AutocmdOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AutocmdOptions -> AutocmdOptions -> Bool
$c/= :: AutocmdOptions -> AutocmdOptions -> Bool
== :: AutocmdOptions -> AutocmdOptions -> Bool
$c== :: AutocmdOptions -> AutocmdOptions -> Bool
Eq, Int -> AutocmdOptions -> ShowS
[AutocmdOptions] -> ShowS
AutocmdOptions -> String
(Int -> AutocmdOptions -> ShowS)
-> (AutocmdOptions -> String)
-> ([AutocmdOptions] -> ShowS)
-> Show AutocmdOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AutocmdOptions] -> ShowS
$cshowList :: [AutocmdOptions] -> ShowS
show :: AutocmdOptions -> String
$cshow :: AutocmdOptions -> String
showsPrec :: Int -> AutocmdOptions -> ShowS
$cshowsPrec :: Int -> AutocmdOptions -> ShowS
Show, (forall x. AutocmdOptions -> Rep AutocmdOptions x)
-> (forall x. Rep AutocmdOptions x -> AutocmdOptions)
-> Generic AutocmdOptions
forall x. Rep AutocmdOptions x -> AutocmdOptions
forall x. AutocmdOptions -> Rep AutocmdOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AutocmdOptions x -> AutocmdOptions
$cfrom :: forall x. AutocmdOptions -> Rep AutocmdOptions x
Generic)

instance Default AutocmdOptions where
  def :: AutocmdOptions
def =
    Either AutocmdBuffer AutocmdPatterns
-> Bool -> Bool -> Maybe AutocmdGroup -> AutocmdOptions
AutocmdOptions (AutocmdPatterns -> Either AutocmdBuffer AutocmdPatterns
forall a b. b -> Either a b
Right AutocmdPatterns
"*") Bool
False Bool
False Maybe AutocmdGroup
forall a. Maybe a
Nothing

instance IsString AutocmdOptions where
  fromString :: String -> AutocmdOptions
fromString String
pat =
    AutocmdOptions
forall a. Default a => a
def { $sel:target:AutocmdOptions :: Either AutocmdBuffer AutocmdPatterns
target = AutocmdPatterns -> Either AutocmdBuffer AutocmdPatterns
forall a b. b -> Either a b
Right (String -> AutocmdPatterns
forall a. IsString a => String -> a
fromString String
pat) }

-- |Neovim assigns ID numbers to autocmds.
newtype AutocmdId =
  AutocmdId { AutocmdId -> Int
unAutocmdId :: Int }
  deriving stock (AutocmdId -> AutocmdId -> Bool
(AutocmdId -> AutocmdId -> Bool)
-> (AutocmdId -> AutocmdId -> Bool) -> Eq AutocmdId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AutocmdId -> AutocmdId -> Bool
$c/= :: AutocmdId -> AutocmdId -> Bool
== :: AutocmdId -> AutocmdId -> Bool
$c== :: AutocmdId -> AutocmdId -> Bool
Eq, Int -> AutocmdId -> ShowS
[AutocmdId] -> ShowS
AutocmdId -> String
(Int -> AutocmdId -> ShowS)
-> (AutocmdId -> String)
-> ([AutocmdId] -> ShowS)
-> Show AutocmdId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AutocmdId] -> ShowS
$cshowList :: [AutocmdId] -> ShowS
show :: AutocmdId -> String
$cshow :: AutocmdId -> String
showsPrec :: Int -> AutocmdId -> ShowS
$cshowsPrec :: Int -> AutocmdId -> ShowS
Show)
  deriving newtype (Integer -> AutocmdId
AutocmdId -> AutocmdId
AutocmdId -> AutocmdId -> AutocmdId
(AutocmdId -> AutocmdId -> AutocmdId)
-> (AutocmdId -> AutocmdId -> AutocmdId)
-> (AutocmdId -> AutocmdId -> AutocmdId)
-> (AutocmdId -> AutocmdId)
-> (AutocmdId -> AutocmdId)
-> (AutocmdId -> AutocmdId)
-> (Integer -> AutocmdId)
-> Num AutocmdId
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> AutocmdId
$cfromInteger :: Integer -> AutocmdId
signum :: AutocmdId -> AutocmdId
$csignum :: AutocmdId -> AutocmdId
abs :: AutocmdId -> AutocmdId
$cabs :: AutocmdId -> AutocmdId
negate :: AutocmdId -> AutocmdId
$cnegate :: AutocmdId -> AutocmdId
* :: AutocmdId -> AutocmdId -> AutocmdId
$c* :: AutocmdId -> AutocmdId -> AutocmdId
- :: AutocmdId -> AutocmdId -> AutocmdId
$c- :: AutocmdId -> AutocmdId -> AutocmdId
+ :: AutocmdId -> AutocmdId -> AutocmdId
$c+ :: AutocmdId -> AutocmdId -> AutocmdId
Num, Num AutocmdId
Ord AutocmdId
Num AutocmdId
-> Ord AutocmdId -> (AutocmdId -> Rational) -> Real AutocmdId
AutocmdId -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: AutocmdId -> Rational
$ctoRational :: AutocmdId -> Rational
Real, Int -> AutocmdId
AutocmdId -> Int
AutocmdId -> [AutocmdId]
AutocmdId -> AutocmdId
AutocmdId -> AutocmdId -> [AutocmdId]
AutocmdId -> AutocmdId -> AutocmdId -> [AutocmdId]
(AutocmdId -> AutocmdId)
-> (AutocmdId -> AutocmdId)
-> (Int -> AutocmdId)
-> (AutocmdId -> Int)
-> (AutocmdId -> [AutocmdId])
-> (AutocmdId -> AutocmdId -> [AutocmdId])
-> (AutocmdId -> AutocmdId -> [AutocmdId])
-> (AutocmdId -> AutocmdId -> AutocmdId -> [AutocmdId])
-> Enum AutocmdId
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: AutocmdId -> AutocmdId -> AutocmdId -> [AutocmdId]
$cenumFromThenTo :: AutocmdId -> AutocmdId -> AutocmdId -> [AutocmdId]
enumFromTo :: AutocmdId -> AutocmdId -> [AutocmdId]
$cenumFromTo :: AutocmdId -> AutocmdId -> [AutocmdId]
enumFromThen :: AutocmdId -> AutocmdId -> [AutocmdId]
$cenumFromThen :: AutocmdId -> AutocmdId -> [AutocmdId]
enumFrom :: AutocmdId -> [AutocmdId]
$cenumFrom :: AutocmdId -> [AutocmdId]
fromEnum :: AutocmdId -> Int
$cfromEnum :: AutocmdId -> Int
toEnum :: Int -> AutocmdId
$ctoEnum :: Int -> AutocmdId
pred :: AutocmdId -> AutocmdId
$cpred :: AutocmdId -> AutocmdId
succ :: AutocmdId -> AutocmdId
$csucc :: AutocmdId -> AutocmdId
Enum, Enum AutocmdId
Real AutocmdId
Real AutocmdId
-> Enum AutocmdId
-> (AutocmdId -> AutocmdId -> AutocmdId)
-> (AutocmdId -> AutocmdId -> AutocmdId)
-> (AutocmdId -> AutocmdId -> AutocmdId)
-> (AutocmdId -> AutocmdId -> AutocmdId)
-> (AutocmdId -> AutocmdId -> (AutocmdId, AutocmdId))
-> (AutocmdId -> AutocmdId -> (AutocmdId, AutocmdId))
-> (AutocmdId -> Integer)
-> Integral AutocmdId
AutocmdId -> Integer
AutocmdId -> AutocmdId -> (AutocmdId, AutocmdId)
AutocmdId -> AutocmdId -> AutocmdId
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: AutocmdId -> Integer
$ctoInteger :: AutocmdId -> Integer
divMod :: AutocmdId -> AutocmdId -> (AutocmdId, AutocmdId)
$cdivMod :: AutocmdId -> AutocmdId -> (AutocmdId, AutocmdId)
quotRem :: AutocmdId -> AutocmdId -> (AutocmdId, AutocmdId)
$cquotRem :: AutocmdId -> AutocmdId -> (AutocmdId, AutocmdId)
mod :: AutocmdId -> AutocmdId -> AutocmdId
$cmod :: AutocmdId -> AutocmdId -> AutocmdId
div :: AutocmdId -> AutocmdId -> AutocmdId
$cdiv :: AutocmdId -> AutocmdId -> AutocmdId
rem :: AutocmdId -> AutocmdId -> AutocmdId
$crem :: AutocmdId -> AutocmdId -> AutocmdId
quot :: AutocmdId -> AutocmdId -> AutocmdId
$cquot :: AutocmdId -> AutocmdId -> AutocmdId
Integral, Eq AutocmdId
Eq AutocmdId
-> (AutocmdId -> AutocmdId -> Ordering)
-> (AutocmdId -> AutocmdId -> Bool)
-> (AutocmdId -> AutocmdId -> Bool)
-> (AutocmdId -> AutocmdId -> Bool)
-> (AutocmdId -> AutocmdId -> Bool)
-> (AutocmdId -> AutocmdId -> AutocmdId)
-> (AutocmdId -> AutocmdId -> AutocmdId)
-> Ord AutocmdId
AutocmdId -> AutocmdId -> Bool
AutocmdId -> AutocmdId -> Ordering
AutocmdId -> AutocmdId -> AutocmdId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AutocmdId -> AutocmdId -> AutocmdId
$cmin :: AutocmdId -> AutocmdId -> AutocmdId
max :: AutocmdId -> AutocmdId -> AutocmdId
$cmax :: AutocmdId -> AutocmdId -> AutocmdId
>= :: AutocmdId -> AutocmdId -> Bool
$c>= :: AutocmdId -> AutocmdId -> Bool
> :: AutocmdId -> AutocmdId -> Bool
$c> :: AutocmdId -> AutocmdId -> Bool
<= :: AutocmdId -> AutocmdId -> Bool
$c<= :: AutocmdId -> AutocmdId -> Bool
< :: AutocmdId -> AutocmdId -> Bool
$c< :: AutocmdId -> AutocmdId -> Bool
compare :: AutocmdId -> AutocmdId -> Ordering
$ccompare :: AutocmdId -> AutocmdId -> Ordering
Ord, Object -> Either DecodeError AutocmdId
(Object -> Either DecodeError AutocmdId) -> MsgpackDecode AutocmdId
forall a. (Object -> Either DecodeError a) -> MsgpackDecode a
fromMsgpack :: Object -> Either DecodeError AutocmdId
$cfromMsgpack :: Object -> Either DecodeError AutocmdId
MsgpackDecode, AutocmdId -> Object
(AutocmdId -> Object) -> MsgpackEncode AutocmdId
forall a. (a -> Object) -> MsgpackEncode a
toMsgpack :: AutocmdId -> Object
$ctoMsgpack :: AutocmdId -> Object
MsgpackEncode)

-- |Neovim command completion can be designated as returning /all/ items that may be completed regardless of the current
-- word ('CompleteUnfiltered') or only those that match the current word ('CompleteFiltered').
data CompleteStyle =
  -- |Completion returns matching items.
  CompleteFiltered
  |
  -- |Completion returns all items.
  CompleteUnfiltered
  deriving stock (CompleteStyle -> CompleteStyle -> Bool
(CompleteStyle -> CompleteStyle -> Bool)
-> (CompleteStyle -> CompleteStyle -> Bool) -> Eq CompleteStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompleteStyle -> CompleteStyle -> Bool
$c/= :: CompleteStyle -> CompleteStyle -> Bool
== :: CompleteStyle -> CompleteStyle -> Bool
$c== :: CompleteStyle -> CompleteStyle -> Bool
Eq, Int -> CompleteStyle -> ShowS
[CompleteStyle] -> ShowS
CompleteStyle -> String
(Int -> CompleteStyle -> ShowS)
-> (CompleteStyle -> String)
-> ([CompleteStyle] -> ShowS)
-> Show CompleteStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompleteStyle] -> ShowS
$cshowList :: [CompleteStyle] -> ShowS
show :: CompleteStyle -> String
$cshow :: CompleteStyle -> String
showsPrec :: Int -> CompleteStyle -> ShowS
$cshowsPrec :: Int -> CompleteStyle -> ShowS
Show)

-- |The completion to use for a command.
data CommandCompletion =
  -- |Complete with one of the builtin completions, see @:help :command-completion@.
  CompleteBuiltin Text
  |
  -- |Complete with an RPC handler defined by a plugin.
  CompleteHandler CompleteStyle RpcName
  deriving stock (CommandCompletion -> CommandCompletion -> Bool
(CommandCompletion -> CommandCompletion -> Bool)
-> (CommandCompletion -> CommandCompletion -> Bool)
-> Eq CommandCompletion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommandCompletion -> CommandCompletion -> Bool
$c/= :: CommandCompletion -> CommandCompletion -> Bool
== :: CommandCompletion -> CommandCompletion -> Bool
$c== :: CommandCompletion -> CommandCompletion -> Bool
Eq, Int -> CommandCompletion -> ShowS
[CommandCompletion] -> ShowS
CommandCompletion -> String
(Int -> CommandCompletion -> ShowS)
-> (CommandCompletion -> String)
-> ([CommandCompletion] -> ShowS)
-> Show CommandCompletion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommandCompletion] -> ShowS
$cshowList :: [CommandCompletion] -> ShowS
show :: CommandCompletion -> String
$cshow :: CommandCompletion -> String
showsPrec :: Int -> CommandCompletion -> ShowS
$cshowsPrec :: Int -> CommandCompletion -> ShowS
Show)

-- |Generate a name for the completion handler of a handler by prefixing its name with @Complete_@.
completionName ::
  RpcName ->
  RpcName
completionName :: RpcName -> RpcName
completionName (RpcName Text
n) =
  Text -> RpcName
RpcName [exon|Complete_#{n}|]

-- |Render a 'CommandCompletion' as the value to the @-complete=@ option for a command definition.
completionValue :: CommandCompletion -> Text
completionValue :: CommandCompletion -> Text
completionValue = \case
  CompleteBuiltin Text
completer ->
    Text
completer
  CompleteHandler CompleteStyle
CompleteFiltered RpcName
func ->
    [exon|customlist,#{unRpcName (completionName func)}|]
  CompleteHandler CompleteStyle
CompleteUnfiltered RpcName
func ->
    [exon|custom,#{unRpcName (completionName func)}|]

-- |Render a 'CommandCompletion' as the @-complete=@ option for a command definition.
completionOption :: CommandCompletion -> Text
completionOption :: CommandCompletion -> Text
completionOption CommandCompletion
cc =
  [exon|-complete=#{completionValue cc}|]

-- |Options for an RPC command on the Neovim side, consisting of the options described at @:help :command-attributes@
-- and an optional completion handler.
data CommandOptions =
  CommandOptions {
    CommandOptions -> Map Text Object
basic :: Map Text Object,
    CommandOptions -> Maybe CommandCompletion
completion :: Maybe CommandCompletion
  }
  deriving stock (Int -> CommandOptions -> ShowS
[CommandOptions] -> ShowS
CommandOptions -> String
(Int -> CommandOptions -> ShowS)
-> (CommandOptions -> String)
-> ([CommandOptions] -> ShowS)
-> Show CommandOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommandOptions] -> ShowS
$cshowList :: [CommandOptions] -> ShowS
show :: CommandOptions -> String
$cshow :: CommandOptions -> String
showsPrec :: Int -> CommandOptions -> ShowS
$cshowsPrec :: Int -> CommandOptions -> ShowS
Show)

-- |The special arguments passed to an RPC call on the Neovim side that correspond to the declared 'CommandOptions'.
newtype CommandArgs =
  CommandArgs { CommandArgs -> [Text]
unCommandArgs :: [Text] }
  deriving stock (CommandArgs -> CommandArgs -> Bool
(CommandArgs -> CommandArgs -> Bool)
-> (CommandArgs -> CommandArgs -> Bool) -> Eq CommandArgs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommandArgs -> CommandArgs -> Bool
$c/= :: CommandArgs -> CommandArgs -> Bool
== :: CommandArgs -> CommandArgs -> Bool
$c== :: CommandArgs -> CommandArgs -> Bool
Eq, Int -> CommandArgs -> ShowS
[CommandArgs] -> ShowS
CommandArgs -> String
(Int -> CommandArgs -> ShowS)
-> (CommandArgs -> String)
-> ([CommandArgs] -> ShowS)
-> Show CommandArgs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommandArgs] -> ShowS
$cshowList :: [CommandArgs] -> ShowS
show :: CommandArgs -> String
$cshow :: CommandArgs -> String
showsPrec :: Int -> CommandArgs -> ShowS
$cshowsPrec :: Int -> CommandArgs -> ShowS
Show)

-- |The type of RPC handler and its options.
data RpcType =
  Function
  |
  Command CommandOptions CommandArgs
  |
  Autocmd AutocmdEvents AutocmdOptions
  deriving stock (Int -> RpcType -> ShowS
[RpcType] -> ShowS
RpcType -> String
(Int -> RpcType -> ShowS)
-> (RpcType -> String) -> ([RpcType] -> ShowS) -> Show RpcType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RpcType] -> ShowS
$cshowList :: [RpcType] -> ShowS
show :: RpcType -> String
$cshow :: RpcType -> String
showsPrec :: Int -> RpcType -> ShowS
$cshowsPrec :: Int -> RpcType -> ShowS
Show, (forall x. RpcType -> Rep RpcType x)
-> (forall x. Rep RpcType x -> RpcType) -> Generic RpcType
forall x. Rep RpcType x -> RpcType
forall x. RpcType -> Rep RpcType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RpcType x -> RpcType
$cfrom :: forall x. RpcType -> Rep RpcType x
Generic)

-- |The prefix for the method name used to identify an RPC handler.
methodPrefix :: RpcType -> Text
methodPrefix :: RpcType -> Text
methodPrefix = \case
  RpcType
Function -> Text
"function"
  Command CommandOptions
_ CommandArgs
_ -> Text
"command"
  Autocmd AutocmdEvents
_ AutocmdOptions
_ -> Text
"autocmd"