{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

{- |
Module      :  Neovim.Plugin.Classes
Description :  Classes and data types related to plugins
Copyright   :  (c) Sebastian Witte
License     :  Apache-2.0

Maintainer  :  woozletoff@gmail.com
Stability   :  experimental
Portability :  GHC
-}
module Neovim.Plugin.Classes (
    FunctionalityDescription (..),
    FunctionName (..),
    NeovimEventId (..),
    SubscriptionId (..),
    Subscription (..),
    NvimMethod (..),
    Synchronous (..),
    CommandOption (..),
    CommandOptions,
    RangeSpecification (..),
    CommandArguments (..),
    getCommandOptions,
    mkCommandOptions,
    AutocmdOptions (..),
    HasFunctionName (..),
) where

import Neovim.Classes

import Control.Monad.Error.Class (MonadError (throwError))
import Data.Char (isDigit)
import Data.Default (Default (..))
import Data.List (groupBy, sort)
import qualified Data.Map as Map
import Data.Maybe (catMaybes, mapMaybe)
import Data.MessagePack (Object (..))
import Data.String (IsString (..))
import Data.Text (Text)
import Prettyprinter (cat, comma, lparen, rparen, viaShow)

import Prelude hiding (sequence)

-- | Essentially just a string.
newtype FunctionName = F Text
    deriving (FunctionName -> FunctionName -> Bool
(FunctionName -> FunctionName -> Bool)
-> (FunctionName -> FunctionName -> Bool) -> Eq FunctionName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FunctionName -> FunctionName -> Bool
== :: FunctionName -> FunctionName -> Bool
$c/= :: FunctionName -> FunctionName -> Bool
/= :: FunctionName -> FunctionName -> Bool
Eq, Eq FunctionName
Eq FunctionName =>
(FunctionName -> FunctionName -> Ordering)
-> (FunctionName -> FunctionName -> Bool)
-> (FunctionName -> FunctionName -> Bool)
-> (FunctionName -> FunctionName -> Bool)
-> (FunctionName -> FunctionName -> Bool)
-> (FunctionName -> FunctionName -> FunctionName)
-> (FunctionName -> FunctionName -> FunctionName)
-> Ord FunctionName
FunctionName -> FunctionName -> Bool
FunctionName -> FunctionName -> Ordering
FunctionName -> FunctionName -> FunctionName
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
$ccompare :: FunctionName -> FunctionName -> Ordering
compare :: FunctionName -> FunctionName -> Ordering
$c< :: FunctionName -> FunctionName -> Bool
< :: FunctionName -> FunctionName -> Bool
$c<= :: FunctionName -> FunctionName -> Bool
<= :: FunctionName -> FunctionName -> Bool
$c> :: FunctionName -> FunctionName -> Bool
> :: FunctionName -> FunctionName -> Bool
$c>= :: FunctionName -> FunctionName -> Bool
>= :: FunctionName -> FunctionName -> Bool
$cmax :: FunctionName -> FunctionName -> FunctionName
max :: FunctionName -> FunctionName -> FunctionName
$cmin :: FunctionName -> FunctionName -> FunctionName
min :: FunctionName -> FunctionName -> FunctionName
Ord, Int -> FunctionName -> ShowS
[FunctionName] -> ShowS
FunctionName -> String
(Int -> FunctionName -> ShowS)
-> (FunctionName -> String)
-> ([FunctionName] -> ShowS)
-> Show FunctionName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FunctionName -> ShowS
showsPrec :: Int -> FunctionName -> ShowS
$cshow :: FunctionName -> String
show :: FunctionName -> String
$cshowList :: [FunctionName] -> ShowS
showList :: [FunctionName] -> ShowS
Show, ReadPrec [FunctionName]
ReadPrec FunctionName
Int -> ReadS FunctionName
ReadS [FunctionName]
(Int -> ReadS FunctionName)
-> ReadS [FunctionName]
-> ReadPrec FunctionName
-> ReadPrec [FunctionName]
-> Read FunctionName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS FunctionName
readsPrec :: Int -> ReadS FunctionName
$creadList :: ReadS [FunctionName]
readList :: ReadS [FunctionName]
$creadPrec :: ReadPrec FunctionName
readPrec :: ReadPrec FunctionName
$creadListPrec :: ReadPrec [FunctionName]
readListPrec :: ReadPrec [FunctionName]
Read, (forall x. FunctionName -> Rep FunctionName x)
-> (forall x. Rep FunctionName x -> FunctionName)
-> Generic FunctionName
forall x. Rep FunctionName x -> FunctionName
forall x. FunctionName -> Rep FunctionName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FunctionName -> Rep FunctionName x
from :: forall x. FunctionName -> Rep FunctionName x
$cto :: forall x. Rep FunctionName x -> FunctionName
to :: forall x. Rep FunctionName x -> FunctionName
Generic)
    deriving (FunctionName -> ()
(FunctionName -> ()) -> NFData FunctionName
forall a. (a -> ()) -> NFData a
$crnf :: FunctionName -> ()
rnf :: FunctionName -> ()
NFData, (forall ann. FunctionName -> Doc ann)
-> (forall ann. [FunctionName] -> Doc ann) -> Pretty FunctionName
forall ann. [FunctionName] -> Doc ann
forall ann. FunctionName -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
$cpretty :: forall ann. FunctionName -> Doc ann
pretty :: forall ann. FunctionName -> Doc ann
$cprettyList :: forall ann. [FunctionName] -> Doc ann
prettyList :: forall ann. [FunctionName] -> Doc ann
Pretty) via Text

newtype NeovimEventId = NeovimEventId Text
    deriving (NeovimEventId -> NeovimEventId -> Bool
(NeovimEventId -> NeovimEventId -> Bool)
-> (NeovimEventId -> NeovimEventId -> Bool) -> Eq NeovimEventId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NeovimEventId -> NeovimEventId -> Bool
== :: NeovimEventId -> NeovimEventId -> Bool
$c/= :: NeovimEventId -> NeovimEventId -> Bool
/= :: NeovimEventId -> NeovimEventId -> Bool
Eq, Eq NeovimEventId
Eq NeovimEventId =>
(NeovimEventId -> NeovimEventId -> Ordering)
-> (NeovimEventId -> NeovimEventId -> Bool)
-> (NeovimEventId -> NeovimEventId -> Bool)
-> (NeovimEventId -> NeovimEventId -> Bool)
-> (NeovimEventId -> NeovimEventId -> Bool)
-> (NeovimEventId -> NeovimEventId -> NeovimEventId)
-> (NeovimEventId -> NeovimEventId -> NeovimEventId)
-> Ord NeovimEventId
NeovimEventId -> NeovimEventId -> Bool
NeovimEventId -> NeovimEventId -> Ordering
NeovimEventId -> NeovimEventId -> NeovimEventId
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
$ccompare :: NeovimEventId -> NeovimEventId -> Ordering
compare :: NeovimEventId -> NeovimEventId -> Ordering
$c< :: NeovimEventId -> NeovimEventId -> Bool
< :: NeovimEventId -> NeovimEventId -> Bool
$c<= :: NeovimEventId -> NeovimEventId -> Bool
<= :: NeovimEventId -> NeovimEventId -> Bool
$c> :: NeovimEventId -> NeovimEventId -> Bool
> :: NeovimEventId -> NeovimEventId -> Bool
$c>= :: NeovimEventId -> NeovimEventId -> Bool
>= :: NeovimEventId -> NeovimEventId -> Bool
$cmax :: NeovimEventId -> NeovimEventId -> NeovimEventId
max :: NeovimEventId -> NeovimEventId -> NeovimEventId
$cmin :: NeovimEventId -> NeovimEventId -> NeovimEventId
min :: NeovimEventId -> NeovimEventId -> NeovimEventId
Ord, Int -> NeovimEventId -> ShowS
[NeovimEventId] -> ShowS
NeovimEventId -> String
(Int -> NeovimEventId -> ShowS)
-> (NeovimEventId -> String)
-> ([NeovimEventId] -> ShowS)
-> Show NeovimEventId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NeovimEventId -> ShowS
showsPrec :: Int -> NeovimEventId -> ShowS
$cshow :: NeovimEventId -> String
show :: NeovimEventId -> String
$cshowList :: [NeovimEventId] -> ShowS
showList :: [NeovimEventId] -> ShowS
Show, ReadPrec [NeovimEventId]
ReadPrec NeovimEventId
Int -> ReadS NeovimEventId
ReadS [NeovimEventId]
(Int -> ReadS NeovimEventId)
-> ReadS [NeovimEventId]
-> ReadPrec NeovimEventId
-> ReadPrec [NeovimEventId]
-> Read NeovimEventId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS NeovimEventId
readsPrec :: Int -> ReadS NeovimEventId
$creadList :: ReadS [NeovimEventId]
readList :: ReadS [NeovimEventId]
$creadPrec :: ReadPrec NeovimEventId
readPrec :: ReadPrec NeovimEventId
$creadListPrec :: ReadPrec [NeovimEventId]
readListPrec :: ReadPrec [NeovimEventId]
Read, (forall x. NeovimEventId -> Rep NeovimEventId x)
-> (forall x. Rep NeovimEventId x -> NeovimEventId)
-> Generic NeovimEventId
forall x. Rep NeovimEventId x -> NeovimEventId
forall x. NeovimEventId -> Rep NeovimEventId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NeovimEventId -> Rep NeovimEventId x
from :: forall x. NeovimEventId -> Rep NeovimEventId x
$cto :: forall x. Rep NeovimEventId x -> NeovimEventId
to :: forall x. Rep NeovimEventId x -> NeovimEventId
Generic)
    deriving ((forall ann. NeovimEventId -> Doc ann)
-> (forall ann. [NeovimEventId] -> Doc ann) -> Pretty NeovimEventId
forall ann. [NeovimEventId] -> Doc ann
forall ann. NeovimEventId -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
$cpretty :: forall ann. NeovimEventId -> Doc ann
pretty :: forall ann. NeovimEventId -> Doc ann
$cprettyList :: forall ann. [NeovimEventId] -> Doc ann
prettyList :: forall ann. [NeovimEventId] -> Doc ann
Pretty) via Text
    deriving (NeovimEventId -> ()
(NeovimEventId -> ()) -> NFData NeovimEventId
forall a. (a -> ()) -> NFData a
$crnf :: NeovimEventId -> ()
rnf :: NeovimEventId -> ()
NFData) via Text

instance NvimObject NeovimEventId where
    toObject :: NeovimEventId -> Object
toObject (NeovimEventId Text
e) = Text -> Object
forall o. NvimObject o => o -> Object
toObject Text
e
    fromObject :: Object -> Either (Doc AnsiStyle) NeovimEventId
fromObject Object
o = Text -> NeovimEventId
NeovimEventId (Text -> NeovimEventId)
-> Either (Doc AnsiStyle) Text
-> Either (Doc AnsiStyle) NeovimEventId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Either (Doc AnsiStyle) Text
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o

newtype SubscriptionId = SubscriptionId Int64
    deriving (SubscriptionId -> SubscriptionId -> Bool
(SubscriptionId -> SubscriptionId -> Bool)
-> (SubscriptionId -> SubscriptionId -> Bool) -> Eq SubscriptionId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SubscriptionId -> SubscriptionId -> Bool
== :: SubscriptionId -> SubscriptionId -> Bool
$c/= :: SubscriptionId -> SubscriptionId -> Bool
/= :: SubscriptionId -> SubscriptionId -> Bool
Eq, Eq SubscriptionId
Eq SubscriptionId =>
(SubscriptionId -> SubscriptionId -> Ordering)
-> (SubscriptionId -> SubscriptionId -> Bool)
-> (SubscriptionId -> SubscriptionId -> Bool)
-> (SubscriptionId -> SubscriptionId -> Bool)
-> (SubscriptionId -> SubscriptionId -> Bool)
-> (SubscriptionId -> SubscriptionId -> SubscriptionId)
-> (SubscriptionId -> SubscriptionId -> SubscriptionId)
-> Ord SubscriptionId
SubscriptionId -> SubscriptionId -> Bool
SubscriptionId -> SubscriptionId -> Ordering
SubscriptionId -> SubscriptionId -> SubscriptionId
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
$ccompare :: SubscriptionId -> SubscriptionId -> Ordering
compare :: SubscriptionId -> SubscriptionId -> Ordering
$c< :: SubscriptionId -> SubscriptionId -> Bool
< :: SubscriptionId -> SubscriptionId -> Bool
$c<= :: SubscriptionId -> SubscriptionId -> Bool
<= :: SubscriptionId -> SubscriptionId -> Bool
$c> :: SubscriptionId -> SubscriptionId -> Bool
> :: SubscriptionId -> SubscriptionId -> Bool
$c>= :: SubscriptionId -> SubscriptionId -> Bool
>= :: SubscriptionId -> SubscriptionId -> Bool
$cmax :: SubscriptionId -> SubscriptionId -> SubscriptionId
max :: SubscriptionId -> SubscriptionId -> SubscriptionId
$cmin :: SubscriptionId -> SubscriptionId -> SubscriptionId
min :: SubscriptionId -> SubscriptionId -> SubscriptionId
Ord, Int -> SubscriptionId -> ShowS
[SubscriptionId] -> ShowS
SubscriptionId -> String
(Int -> SubscriptionId -> ShowS)
-> (SubscriptionId -> String)
-> ([SubscriptionId] -> ShowS)
-> Show SubscriptionId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubscriptionId -> ShowS
showsPrec :: Int -> SubscriptionId -> ShowS
$cshow :: SubscriptionId -> String
show :: SubscriptionId -> String
$cshowList :: [SubscriptionId] -> ShowS
showList :: [SubscriptionId] -> ShowS
Show, ReadPrec [SubscriptionId]
ReadPrec SubscriptionId
Int -> ReadS SubscriptionId
ReadS [SubscriptionId]
(Int -> ReadS SubscriptionId)
-> ReadS [SubscriptionId]
-> ReadPrec SubscriptionId
-> ReadPrec [SubscriptionId]
-> Read SubscriptionId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SubscriptionId
readsPrec :: Int -> ReadS SubscriptionId
$creadList :: ReadS [SubscriptionId]
readList :: ReadS [SubscriptionId]
$creadPrec :: ReadPrec SubscriptionId
readPrec :: ReadPrec SubscriptionId
$creadListPrec :: ReadPrec [SubscriptionId]
readListPrec :: ReadPrec [SubscriptionId]
Read)
    deriving (Int -> SubscriptionId
SubscriptionId -> Int
SubscriptionId -> [SubscriptionId]
SubscriptionId -> SubscriptionId
SubscriptionId -> SubscriptionId -> [SubscriptionId]
SubscriptionId
-> SubscriptionId -> SubscriptionId -> [SubscriptionId]
(SubscriptionId -> SubscriptionId)
-> (SubscriptionId -> SubscriptionId)
-> (Int -> SubscriptionId)
-> (SubscriptionId -> Int)
-> (SubscriptionId -> [SubscriptionId])
-> (SubscriptionId -> SubscriptionId -> [SubscriptionId])
-> (SubscriptionId -> SubscriptionId -> [SubscriptionId])
-> (SubscriptionId
    -> SubscriptionId -> SubscriptionId -> [SubscriptionId])
-> Enum SubscriptionId
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SubscriptionId -> SubscriptionId
succ :: SubscriptionId -> SubscriptionId
$cpred :: SubscriptionId -> SubscriptionId
pred :: SubscriptionId -> SubscriptionId
$ctoEnum :: Int -> SubscriptionId
toEnum :: Int -> SubscriptionId
$cfromEnum :: SubscriptionId -> Int
fromEnum :: SubscriptionId -> Int
$cenumFrom :: SubscriptionId -> [SubscriptionId]
enumFrom :: SubscriptionId -> [SubscriptionId]
$cenumFromThen :: SubscriptionId -> SubscriptionId -> [SubscriptionId]
enumFromThen :: SubscriptionId -> SubscriptionId -> [SubscriptionId]
$cenumFromTo :: SubscriptionId -> SubscriptionId -> [SubscriptionId]
enumFromTo :: SubscriptionId -> SubscriptionId -> [SubscriptionId]
$cenumFromThenTo :: SubscriptionId
-> SubscriptionId -> SubscriptionId -> [SubscriptionId]
enumFromThenTo :: SubscriptionId
-> SubscriptionId -> SubscriptionId -> [SubscriptionId]
Enum) via Int64

data Subscription = Subscription
    { Subscription -> SubscriptionId
subId :: SubscriptionId
    , Subscription -> NeovimEventId
subEventId :: NeovimEventId
    , Subscription -> [Object] -> IO ()
subAction :: [Object] -> IO ()
    }

{- | Functionality specific functional description entries.

 All fields which are directly specified in these constructors are not
 optional, but can partialy be generated via the Template Haskell functions.
 The last field is a data type that contains all relevant options with
 sensible defaults, hence 'def' can be used as an argument.
-}
data FunctionalityDescription
    = -- | Exported function. Callable via @call name(arg1,arg2)@.
      --
      -- * Name of the function (must start with an uppercase letter)
      -- * Option to indicate how neovim should behave when calling this function
      Function FunctionName Synchronous
    | -- | Exported Command. Callable via @:Name arg1 arg2@.
      --
      -- * Name of the command (must start with an uppercase letter)
      -- * Options to configure neovim's behavior for calling the command
      Command FunctionName CommandOptions
    | -- | Exported autocommand. Will call the given function if the type and
      -- filter match.
      --
      -- NB: Since we are registering this on the Haskell side of things, the
      -- number of accepted arguments should be 0.
      --
      -- * Type of the autocmd (e.g. \"BufWritePost\")
      -- * Name for the function to call
      -- * Whether to use rpcrequest or rpcnotify
      -- * Options for the autocmd (use 'def' here if you don't want to change anything)
      Autocmd Text FunctionName Synchronous AutocmdOptions
    deriving (Int -> FunctionalityDescription -> ShowS
[FunctionalityDescription] -> ShowS
FunctionalityDescription -> String
(Int -> FunctionalityDescription -> ShowS)
-> (FunctionalityDescription -> String)
-> ([FunctionalityDescription] -> ShowS)
-> Show FunctionalityDescription
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FunctionalityDescription -> ShowS
showsPrec :: Int -> FunctionalityDescription -> ShowS
$cshow :: FunctionalityDescription -> String
show :: FunctionalityDescription -> String
$cshowList :: [FunctionalityDescription] -> ShowS
showList :: [FunctionalityDescription] -> ShowS
Show, ReadPrec [FunctionalityDescription]
ReadPrec FunctionalityDescription
Int -> ReadS FunctionalityDescription
ReadS [FunctionalityDescription]
(Int -> ReadS FunctionalityDescription)
-> ReadS [FunctionalityDescription]
-> ReadPrec FunctionalityDescription
-> ReadPrec [FunctionalityDescription]
-> Read FunctionalityDescription
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS FunctionalityDescription
readsPrec :: Int -> ReadS FunctionalityDescription
$creadList :: ReadS [FunctionalityDescription]
readList :: ReadS [FunctionalityDescription]
$creadPrec :: ReadPrec FunctionalityDescription
readPrec :: ReadPrec FunctionalityDescription
$creadListPrec :: ReadPrec [FunctionalityDescription]
readListPrec :: ReadPrec [FunctionalityDescription]
Read, FunctionalityDescription -> FunctionalityDescription -> Bool
(FunctionalityDescription -> FunctionalityDescription -> Bool)
-> (FunctionalityDescription -> FunctionalityDescription -> Bool)
-> Eq FunctionalityDescription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FunctionalityDescription -> FunctionalityDescription -> Bool
== :: FunctionalityDescription -> FunctionalityDescription -> Bool
$c/= :: FunctionalityDescription -> FunctionalityDescription -> Bool
/= :: FunctionalityDescription -> FunctionalityDescription -> Bool
Eq, Eq FunctionalityDescription
Eq FunctionalityDescription =>
(FunctionalityDescription -> FunctionalityDescription -> Ordering)
-> (FunctionalityDescription -> FunctionalityDescription -> Bool)
-> (FunctionalityDescription -> FunctionalityDescription -> Bool)
-> (FunctionalityDescription -> FunctionalityDescription -> Bool)
-> (FunctionalityDescription -> FunctionalityDescription -> Bool)
-> (FunctionalityDescription
    -> FunctionalityDescription -> FunctionalityDescription)
-> (FunctionalityDescription
    -> FunctionalityDescription -> FunctionalityDescription)
-> Ord FunctionalityDescription
FunctionalityDescription -> FunctionalityDescription -> Bool
FunctionalityDescription -> FunctionalityDescription -> Ordering
FunctionalityDescription
-> FunctionalityDescription -> FunctionalityDescription
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
$ccompare :: FunctionalityDescription -> FunctionalityDescription -> Ordering
compare :: FunctionalityDescription -> FunctionalityDescription -> Ordering
$c< :: FunctionalityDescription -> FunctionalityDescription -> Bool
< :: FunctionalityDescription -> FunctionalityDescription -> Bool
$c<= :: FunctionalityDescription -> FunctionalityDescription -> Bool
<= :: FunctionalityDescription -> FunctionalityDescription -> Bool
$c> :: FunctionalityDescription -> FunctionalityDescription -> Bool
> :: FunctionalityDescription -> FunctionalityDescription -> Bool
$c>= :: FunctionalityDescription -> FunctionalityDescription -> Bool
>= :: FunctionalityDescription -> FunctionalityDescription -> Bool
$cmax :: FunctionalityDescription
-> FunctionalityDescription -> FunctionalityDescription
max :: FunctionalityDescription
-> FunctionalityDescription -> FunctionalityDescription
$cmin :: FunctionalityDescription
-> FunctionalityDescription -> FunctionalityDescription
min :: FunctionalityDescription
-> FunctionalityDescription -> FunctionalityDescription
Ord, (forall x.
 FunctionalityDescription -> Rep FunctionalityDescription x)
-> (forall x.
    Rep FunctionalityDescription x -> FunctionalityDescription)
-> Generic FunctionalityDescription
forall x.
Rep FunctionalityDescription x -> FunctionalityDescription
forall x.
FunctionalityDescription -> Rep FunctionalityDescription x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
FunctionalityDescription -> Rep FunctionalityDescription x
from :: forall x.
FunctionalityDescription -> Rep FunctionalityDescription x
$cto :: forall x.
Rep FunctionalityDescription x -> FunctionalityDescription
to :: forall x.
Rep FunctionalityDescription x -> FunctionalityDescription
Generic)

instance NFData FunctionalityDescription

instance Pretty FunctionalityDescription where
    pretty :: forall ann. FunctionalityDescription -> Doc ann
pretty = \case
        Function FunctionName
fname Synchronous
s ->
            Doc ann
"Function" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Synchronous -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Synchronous -> Doc ann
pretty Synchronous
s Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> FunctionName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. FunctionName -> Doc ann
pretty FunctionName
fname
        Command FunctionName
fname CommandOptions
copts ->
            Doc ann
"Command" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> CommandOptions -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. CommandOptions -> Doc ann
pretty CommandOptions
copts Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> FunctionName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. FunctionName -> Doc ann
pretty FunctionName
fname
        Autocmd Text
t FunctionName
fname Synchronous
s AutocmdOptions
aopts ->
            Doc ann
"Autocmd"
                Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
t
                Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Synchronous -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Synchronous -> Doc ann
pretty Synchronous
s
                Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> AutocmdOptions -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. AutocmdOptions -> Doc ann
pretty AutocmdOptions
aopts
                Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> FunctionName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. FunctionName -> Doc ann
pretty FunctionName
fname

{- | This option detemines how neovim should behave when calling some
 functionality on a remote host.
-}
data Synchronous
    = -- | Call the functionality entirely for its side effects and do not wait
      -- for it to finish. Calling a functionality with this flag set is
      -- completely asynchronous and nothing is really expected to happen. This
      -- is why a call like this is called notification on the neovim side of
      -- things.
      Async
    | -- | Call the function and wait for its result. This is only synchronous on
      -- the neovim side. This means that the GUI will (probably) not
      -- allow any user input until a reult is received.
      Sync
    deriving (Int -> Synchronous -> ShowS
[Synchronous] -> ShowS
Synchronous -> String
(Int -> Synchronous -> ShowS)
-> (Synchronous -> String)
-> ([Synchronous] -> ShowS)
-> Show Synchronous
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Synchronous -> ShowS
showsPrec :: Int -> Synchronous -> ShowS
$cshow :: Synchronous -> String
show :: Synchronous -> String
$cshowList :: [Synchronous] -> ShowS
showList :: [Synchronous] -> ShowS
Show, ReadPrec [Synchronous]
ReadPrec Synchronous
Int -> ReadS Synchronous
ReadS [Synchronous]
(Int -> ReadS Synchronous)
-> ReadS [Synchronous]
-> ReadPrec Synchronous
-> ReadPrec [Synchronous]
-> Read Synchronous
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Synchronous
readsPrec :: Int -> ReadS Synchronous
$creadList :: ReadS [Synchronous]
readList :: ReadS [Synchronous]
$creadPrec :: ReadPrec Synchronous
readPrec :: ReadPrec Synchronous
$creadListPrec :: ReadPrec [Synchronous]
readListPrec :: ReadPrec [Synchronous]
Read, Synchronous -> Synchronous -> Bool
(Synchronous -> Synchronous -> Bool)
-> (Synchronous -> Synchronous -> Bool) -> Eq Synchronous
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Synchronous -> Synchronous -> Bool
== :: Synchronous -> Synchronous -> Bool
$c/= :: Synchronous -> Synchronous -> Bool
/= :: Synchronous -> Synchronous -> Bool
Eq, Eq Synchronous
Eq Synchronous =>
(Synchronous -> Synchronous -> Ordering)
-> (Synchronous -> Synchronous -> Bool)
-> (Synchronous -> Synchronous -> Bool)
-> (Synchronous -> Synchronous -> Bool)
-> (Synchronous -> Synchronous -> Bool)
-> (Synchronous -> Synchronous -> Synchronous)
-> (Synchronous -> Synchronous -> Synchronous)
-> Ord Synchronous
Synchronous -> Synchronous -> Bool
Synchronous -> Synchronous -> Ordering
Synchronous -> Synchronous -> Synchronous
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
$ccompare :: Synchronous -> Synchronous -> Ordering
compare :: Synchronous -> Synchronous -> Ordering
$c< :: Synchronous -> Synchronous -> Bool
< :: Synchronous -> Synchronous -> Bool
$c<= :: Synchronous -> Synchronous -> Bool
<= :: Synchronous -> Synchronous -> Bool
$c> :: Synchronous -> Synchronous -> Bool
> :: Synchronous -> Synchronous -> Bool
$c>= :: Synchronous -> Synchronous -> Bool
>= :: Synchronous -> Synchronous -> Bool
$cmax :: Synchronous -> Synchronous -> Synchronous
max :: Synchronous -> Synchronous -> Synchronous
$cmin :: Synchronous -> Synchronous -> Synchronous
min :: Synchronous -> Synchronous -> Synchronous
Ord, Int -> Synchronous
Synchronous -> Int
Synchronous -> [Synchronous]
Synchronous -> Synchronous
Synchronous -> Synchronous -> [Synchronous]
Synchronous -> Synchronous -> Synchronous -> [Synchronous]
(Synchronous -> Synchronous)
-> (Synchronous -> Synchronous)
-> (Int -> Synchronous)
-> (Synchronous -> Int)
-> (Synchronous -> [Synchronous])
-> (Synchronous -> Synchronous -> [Synchronous])
-> (Synchronous -> Synchronous -> [Synchronous])
-> (Synchronous -> Synchronous -> Synchronous -> [Synchronous])
-> Enum Synchronous
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Synchronous -> Synchronous
succ :: Synchronous -> Synchronous
$cpred :: Synchronous -> Synchronous
pred :: Synchronous -> Synchronous
$ctoEnum :: Int -> Synchronous
toEnum :: Int -> Synchronous
$cfromEnum :: Synchronous -> Int
fromEnum :: Synchronous -> Int
$cenumFrom :: Synchronous -> [Synchronous]
enumFrom :: Synchronous -> [Synchronous]
$cenumFromThen :: Synchronous -> Synchronous -> [Synchronous]
enumFromThen :: Synchronous -> Synchronous -> [Synchronous]
$cenumFromTo :: Synchronous -> Synchronous -> [Synchronous]
enumFromTo :: Synchronous -> Synchronous -> [Synchronous]
$cenumFromThenTo :: Synchronous -> Synchronous -> Synchronous -> [Synchronous]
enumFromThenTo :: Synchronous -> Synchronous -> Synchronous -> [Synchronous]
Enum, (forall x. Synchronous -> Rep Synchronous x)
-> (forall x. Rep Synchronous x -> Synchronous)
-> Generic Synchronous
forall x. Rep Synchronous x -> Synchronous
forall x. Synchronous -> Rep Synchronous x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Synchronous -> Rep Synchronous x
from :: forall x. Synchronous -> Rep Synchronous x
$cto :: forall x. Rep Synchronous x -> Synchronous
to :: forall x. Rep Synchronous x -> Synchronous
Generic)

instance NFData Synchronous

instance Pretty Synchronous where
    pretty :: forall ann. Synchronous -> Doc ann
pretty = \case
        Synchronous
Async -> Doc ann
"async"
        Synchronous
Sync -> Doc ann
"sync"

instance IsString Synchronous where
    fromString :: String -> Synchronous
fromString = \case
        String
"sync" -> Synchronous
Sync
        String
"async" -> Synchronous
Async
        String
_ -> String -> Synchronous
forall a. HasCallStack => String -> a
error String
"Only \"sync\" and \"async\" are valid string representations"

instance NvimObject Synchronous where
    toObject :: Synchronous -> Object
toObject = \case
        Synchronous
Async -> Bool -> Object
forall o. NvimObject o => o -> Object
toObject Bool
False
        Synchronous
Sync -> Bool -> Object
forall o. NvimObject o => o -> Object
toObject Bool
True

    fromObject :: Object -> Either (Doc AnsiStyle) Synchronous
fromObject = \case
        ObjectBool Bool
True -> Synchronous -> Either (Doc AnsiStyle) Synchronous
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return Synchronous
Sync
        ObjectBool Bool
False -> Synchronous -> Either (Doc AnsiStyle) Synchronous
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return Synchronous
Async
        ObjectInt Int64
0 -> Synchronous -> Either (Doc AnsiStyle) Synchronous
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return Synchronous
Async
        Object
_ -> Synchronous -> Either (Doc AnsiStyle) Synchronous
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return Synchronous
Sync

{- | Options for commands.

 Some command can also be described by using the OverloadedString extensions.
 This means that you can write a literal 'String' inside your source file in
 place for a 'CommandOption' value. See the documentation for each value on
 how these strings should look like (Both versions are compile time checked.)
-}
data CommandOption
    = -- | Stringliteral "sync" or "async"
      CmdSync Synchronous
    | -- | Register passed to the command.
      --
      -- Stringliteral: @\"\\\"\"@
      CmdRegister
    | -- | Command takes a specific amount of arguments
      --
      -- Automatically set via template haskell functions. You
      -- really shouldn't use this option yourself unless you have
      -- to.
      CmdNargs String
    | -- | Determines how neovim passes the range.
      --
      -- Stringliterals: \"%\" for 'WholeFile', \",\" for line
      --                 and \",123\" for 123 lines.
      CmdRange RangeSpecification
    | -- | Command handles a count. The argument defines the
      -- default count.
      --
      -- Stringliteral: string of numbers (e.g. "132")
      CmdCount Word
    | -- | Command handles a bang
      --
      -- Stringliteral: \"!\"
      CmdBang
    | -- | Verbatim string passed to the @-complete=@ command attribute
      CmdComplete String
    deriving (CommandOption -> CommandOption -> Bool
(CommandOption -> CommandOption -> Bool)
-> (CommandOption -> CommandOption -> Bool) -> Eq CommandOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommandOption -> CommandOption -> Bool
== :: CommandOption -> CommandOption -> Bool
$c/= :: CommandOption -> CommandOption -> Bool
/= :: CommandOption -> CommandOption -> Bool
Eq, Eq CommandOption
Eq CommandOption =>
(CommandOption -> CommandOption -> Ordering)
-> (CommandOption -> CommandOption -> Bool)
-> (CommandOption -> CommandOption -> Bool)
-> (CommandOption -> CommandOption -> Bool)
-> (CommandOption -> CommandOption -> Bool)
-> (CommandOption -> CommandOption -> CommandOption)
-> (CommandOption -> CommandOption -> CommandOption)
-> Ord CommandOption
CommandOption -> CommandOption -> Bool
CommandOption -> CommandOption -> Ordering
CommandOption -> CommandOption -> CommandOption
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
$ccompare :: CommandOption -> CommandOption -> Ordering
compare :: CommandOption -> CommandOption -> Ordering
$c< :: CommandOption -> CommandOption -> Bool
< :: CommandOption -> CommandOption -> Bool
$c<= :: CommandOption -> CommandOption -> Bool
<= :: CommandOption -> CommandOption -> Bool
$c> :: CommandOption -> CommandOption -> Bool
> :: CommandOption -> CommandOption -> Bool
$c>= :: CommandOption -> CommandOption -> Bool
>= :: CommandOption -> CommandOption -> Bool
$cmax :: CommandOption -> CommandOption -> CommandOption
max :: CommandOption -> CommandOption -> CommandOption
$cmin :: CommandOption -> CommandOption -> CommandOption
min :: CommandOption -> CommandOption -> CommandOption
Ord, Int -> CommandOption -> ShowS
[CommandOption] -> ShowS
CommandOption -> String
(Int -> CommandOption -> ShowS)
-> (CommandOption -> String)
-> ([CommandOption] -> ShowS)
-> Show CommandOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommandOption -> ShowS
showsPrec :: Int -> CommandOption -> ShowS
$cshow :: CommandOption -> String
show :: CommandOption -> String
$cshowList :: [CommandOption] -> ShowS
showList :: [CommandOption] -> ShowS
Show, ReadPrec [CommandOption]
ReadPrec CommandOption
Int -> ReadS CommandOption
ReadS [CommandOption]
(Int -> ReadS CommandOption)
-> ReadS [CommandOption]
-> ReadPrec CommandOption
-> ReadPrec [CommandOption]
-> Read CommandOption
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CommandOption
readsPrec :: Int -> ReadS CommandOption
$creadList :: ReadS [CommandOption]
readList :: ReadS [CommandOption]
$creadPrec :: ReadPrec CommandOption
readPrec :: ReadPrec CommandOption
$creadListPrec :: ReadPrec [CommandOption]
readListPrec :: ReadPrec [CommandOption]
Read, (forall x. CommandOption -> Rep CommandOption x)
-> (forall x. Rep CommandOption x -> CommandOption)
-> Generic CommandOption
forall x. Rep CommandOption x -> CommandOption
forall x. CommandOption -> Rep CommandOption x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CommandOption -> Rep CommandOption x
from :: forall x. CommandOption -> Rep CommandOption x
$cto :: forall x. Rep CommandOption x -> CommandOption
to :: forall x. Rep CommandOption x -> CommandOption
Generic)

instance NFData CommandOption

instance Pretty CommandOption where
    pretty :: forall ann. CommandOption -> Doc ann
pretty = \case
        CmdSync Synchronous
s ->
            Synchronous -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Synchronous -> Doc ann
pretty Synchronous
s
        CommandOption
CmdRegister ->
            Doc ann
"\""
        CmdNargs String
n ->
            String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
n
        CmdRange RangeSpecification
rs ->
            RangeSpecification -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. RangeSpecification -> Doc ann
pretty RangeSpecification
rs
        CmdCount Word
c ->
            Word -> Doc ann
forall ann. Word -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Word
c
        CommandOption
CmdBang ->
            Doc ann
"!"
        CmdComplete String
cs ->
            String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
cs

instance IsString CommandOption where
    fromString :: String -> CommandOption
fromString = \case
        String
"%" -> RangeSpecification -> CommandOption
CmdRange RangeSpecification
WholeFile
        String
"\"" -> CommandOption
CmdRegister
        String
"!" -> CommandOption
CmdBang
        String
"sync" -> Synchronous -> CommandOption
CmdSync Synchronous
Sync
        String
"async" -> Synchronous -> CommandOption
CmdSync Synchronous
Async
        String
"," -> RangeSpecification -> CommandOption
CmdRange RangeSpecification
CurrentLine
        Char
',' : String
ds | Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ds) Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
ds -> RangeSpecification -> CommandOption
CmdRange (String -> RangeSpecification
forall a. Read a => String -> a
read String
ds)
        String
ds | Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ds) Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
ds -> Word -> CommandOption
CmdCount (String -> Word
forall a. Read a => String -> a
read String
ds)
        String
_ -> String -> CommandOption
forall a. HasCallStack => String -> a
error String
"Not a valid string for a CommandOptions. Check the docs!"

{- | Newtype wrapper for a list of 'CommandOption'. Any properly constructed
 object of this type is sorted and only contains zero or one object for each
 possible option.
-}
newtype CommandOptions = CommandOptions {CommandOptions -> [CommandOption]
getCommandOptions :: [CommandOption]}
    deriving (CommandOptions -> CommandOptions -> Bool
(CommandOptions -> CommandOptions -> Bool)
-> (CommandOptions -> CommandOptions -> Bool) -> Eq CommandOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommandOptions -> CommandOptions -> Bool
== :: CommandOptions -> CommandOptions -> Bool
$c/= :: CommandOptions -> CommandOptions -> Bool
/= :: CommandOptions -> CommandOptions -> Bool
Eq, Eq CommandOptions
Eq CommandOptions =>
(CommandOptions -> CommandOptions -> Ordering)
-> (CommandOptions -> CommandOptions -> Bool)
-> (CommandOptions -> CommandOptions -> Bool)
-> (CommandOptions -> CommandOptions -> Bool)
-> (CommandOptions -> CommandOptions -> Bool)
-> (CommandOptions -> CommandOptions -> CommandOptions)
-> (CommandOptions -> CommandOptions -> CommandOptions)
-> Ord CommandOptions
CommandOptions -> CommandOptions -> Bool
CommandOptions -> CommandOptions -> Ordering
CommandOptions -> CommandOptions -> CommandOptions
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
$ccompare :: CommandOptions -> CommandOptions -> Ordering
compare :: CommandOptions -> CommandOptions -> Ordering
$c< :: CommandOptions -> CommandOptions -> Bool
< :: CommandOptions -> CommandOptions -> Bool
$c<= :: CommandOptions -> CommandOptions -> Bool
<= :: CommandOptions -> CommandOptions -> Bool
$c> :: CommandOptions -> CommandOptions -> Bool
> :: CommandOptions -> CommandOptions -> Bool
$c>= :: CommandOptions -> CommandOptions -> Bool
>= :: CommandOptions -> CommandOptions -> Bool
$cmax :: CommandOptions -> CommandOptions -> CommandOptions
max :: CommandOptions -> CommandOptions -> CommandOptions
$cmin :: CommandOptions -> CommandOptions -> CommandOptions
min :: CommandOptions -> CommandOptions -> CommandOptions
Ord, 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
$cshowsPrec :: Int -> CommandOptions -> ShowS
showsPrec :: Int -> CommandOptions -> ShowS
$cshow :: CommandOptions -> String
show :: CommandOptions -> String
$cshowList :: [CommandOptions] -> ShowS
showList :: [CommandOptions] -> ShowS
Show, ReadPrec [CommandOptions]
ReadPrec CommandOptions
Int -> ReadS CommandOptions
ReadS [CommandOptions]
(Int -> ReadS CommandOptions)
-> ReadS [CommandOptions]
-> ReadPrec CommandOptions
-> ReadPrec [CommandOptions]
-> Read CommandOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CommandOptions
readsPrec :: Int -> ReadS CommandOptions
$creadList :: ReadS [CommandOptions]
readList :: ReadS [CommandOptions]
$creadPrec :: ReadPrec CommandOptions
readPrec :: ReadPrec CommandOptions
$creadListPrec :: ReadPrec [CommandOptions]
readListPrec :: ReadPrec [CommandOptions]
Read, (forall x. CommandOptions -> Rep CommandOptions x)
-> (forall x. Rep CommandOptions x -> CommandOptions)
-> Generic CommandOptions
forall x. Rep CommandOptions x -> CommandOptions
forall x. CommandOptions -> Rep CommandOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CommandOptions -> Rep CommandOptions x
from :: forall x. CommandOptions -> Rep CommandOptions x
$cto :: forall x. Rep CommandOptions x -> CommandOptions
to :: forall x. Rep CommandOptions x -> CommandOptions
Generic)

instance NFData CommandOptions

instance Pretty CommandOptions where
    pretty :: forall ann. CommandOptions -> Doc ann
pretty (CommandOptions [CommandOption]
os) =
        [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
cat ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (CommandOption -> Doc ann) -> [CommandOption] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map CommandOption -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. CommandOption -> Doc ann
pretty [CommandOption]
os

{- | Smart constructor for 'CommandOptions'. This sorts the command options and
 removes duplicate entries for semantically the same thing. Note that the
 smallest option stays for whatever ordering is defined. It is best to simply
 not define the same thing multiple times.
-}
mkCommandOptions :: [CommandOption] -> CommandOptions
mkCommandOptions :: [CommandOption] -> CommandOptions
mkCommandOptions = [CommandOption] -> CommandOptions
CommandOptions ([CommandOption] -> CommandOptions)
-> ([CommandOption] -> [CommandOption])
-> [CommandOption]
-> CommandOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([CommandOption] -> CommandOption)
-> [[CommandOption]] -> [CommandOption]
forall a b. (a -> b) -> [a] -> [b]
map [CommandOption] -> CommandOption
forall a. HasCallStack => [a] -> a
head ([[CommandOption]] -> [CommandOption])
-> ([CommandOption] -> [[CommandOption]])
-> [CommandOption]
-> [CommandOption]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CommandOption -> CommandOption -> Bool)
-> [CommandOption] -> [[CommandOption]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy CommandOption -> CommandOption -> Bool
constructor ([CommandOption] -> [[CommandOption]])
-> ([CommandOption] -> [CommandOption])
-> [CommandOption]
-> [[CommandOption]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CommandOption] -> [CommandOption]
forall a. Ord a => [a] -> [a]
sort
  where
    constructor :: CommandOption -> CommandOption -> Bool
constructor CommandOption
a CommandOption
b = case (CommandOption
a, CommandOption
b) of
        (CommandOption, CommandOption)
_ | CommandOption
a CommandOption -> CommandOption -> Bool
forall a. Eq a => a -> a -> Bool
== CommandOption
b -> Bool
True
        -- Only CmdSync and CmdNargs may fail for the equality check,
        -- so we just have to check those.
        (CmdSync Synchronous
_, CmdSync Synchronous
_) -> Bool
True
        (CmdRange RangeSpecification
_, CmdRange RangeSpecification
_) -> Bool
True
        -- Range and conut are mutually recursive.
        -- XXX Actually '-range=N' and '-count=N' are, but the code in
        --     remote#define#CommandOnChannel treats it exclusive as a whole.
        --     (see :h :command-range)
        (CmdRange RangeSpecification
_, CmdCount Word
_) -> Bool
True
        (CmdNargs String
_, CmdNargs String
_) -> Bool
True
        (CommandOption, CommandOption)
_ -> Bool
False

instance NvimObject CommandOptions where
    toObject :: CommandOptions -> Object
toObject (CommandOptions [CommandOption]
opts) =
        (Dictionary -> Object
forall o. NvimObject o => o -> Object
toObject :: Dictionary -> Object) (Dictionary -> Object)
-> ([(ByteString, Object)] -> Dictionary)
-> [(ByteString, Object)]
-> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ByteString, Object)] -> Dictionary
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ByteString, Object)] -> Object)
-> [(ByteString, Object)] -> Object
forall a b. (a -> b) -> a -> b
$ (CommandOption -> Maybe (ByteString, Object))
-> [CommandOption] -> [(ByteString, Object)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe CommandOption -> Maybe (ByteString, Object)
addOption [CommandOption]
opts
      where
        addOption :: CommandOption -> Maybe (ByteString, Object)
addOption = \case
            CmdRange RangeSpecification
r -> (ByteString, Object) -> Maybe (ByteString, Object)
forall a. a -> Maybe a
Just (ByteString
"range", RangeSpecification -> Object
forall o. NvimObject o => o -> Object
toObject RangeSpecification
r)
            CmdCount Word
n -> (ByteString, Object) -> Maybe (ByteString, Object)
forall a. a -> Maybe a
Just (ByteString
"count", Word -> Object
forall o. NvimObject o => o -> Object
toObject Word
n)
            CommandOption
CmdBang -> (ByteString, Object) -> Maybe (ByteString, Object)
forall a. a -> Maybe a
Just (ByteString
"bang", ByteString -> Object
ObjectBinary ByteString
"")
            CommandOption
CmdRegister -> (ByteString, Object) -> Maybe (ByteString, Object)
forall a. a -> Maybe a
Just (ByteString
"register", ByteString -> Object
ObjectBinary ByteString
"")
            CmdNargs String
n -> (ByteString, Object) -> Maybe (ByteString, Object)
forall a. a -> Maybe a
Just (ByteString
"nargs", String -> Object
forall o. NvimObject o => o -> Object
toObject String
n)
            CmdComplete String
cs -> (ByteString, Object) -> Maybe (ByteString, Object)
forall a. a -> Maybe a
Just (ByteString
"complete", String -> Object
forall o. NvimObject o => o -> Object
toObject String
cs)
            CommandOption
_ -> Maybe (ByteString, Object)
forall a. Maybe a
Nothing

    fromObject :: Object -> Either (Doc AnsiStyle) CommandOptions
fromObject Object
o =
        Doc AnsiStyle -> Either (Doc AnsiStyle) CommandOptions
forall a. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle -> Either (Doc AnsiStyle) CommandOptions)
-> Doc AnsiStyle -> Either (Doc AnsiStyle) CommandOptions
forall a b. (a -> b) -> a -> b
$
            Doc AnsiStyle
"Did not expect to receive a CommandOptions object:" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Object -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow Object
o

-- | Specification of a range that acommand can operate on.
data RangeSpecification
    = -- | The line the cursor is at when the command is invoked.
      CurrentLine
    | -- | Let the command operate on every line of the file.
      WholeFile
    | -- | Let the command operate on each line in the given range.
      RangeCount Int
    deriving (RangeSpecification -> RangeSpecification -> Bool
(RangeSpecification -> RangeSpecification -> Bool)
-> (RangeSpecification -> RangeSpecification -> Bool)
-> Eq RangeSpecification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RangeSpecification -> RangeSpecification -> Bool
== :: RangeSpecification -> RangeSpecification -> Bool
$c/= :: RangeSpecification -> RangeSpecification -> Bool
/= :: RangeSpecification -> RangeSpecification -> Bool
Eq, Eq RangeSpecification
Eq RangeSpecification =>
(RangeSpecification -> RangeSpecification -> Ordering)
-> (RangeSpecification -> RangeSpecification -> Bool)
-> (RangeSpecification -> RangeSpecification -> Bool)
-> (RangeSpecification -> RangeSpecification -> Bool)
-> (RangeSpecification -> RangeSpecification -> Bool)
-> (RangeSpecification -> RangeSpecification -> RangeSpecification)
-> (RangeSpecification -> RangeSpecification -> RangeSpecification)
-> Ord RangeSpecification
RangeSpecification -> RangeSpecification -> Bool
RangeSpecification -> RangeSpecification -> Ordering
RangeSpecification -> RangeSpecification -> RangeSpecification
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
$ccompare :: RangeSpecification -> RangeSpecification -> Ordering
compare :: RangeSpecification -> RangeSpecification -> Ordering
$c< :: RangeSpecification -> RangeSpecification -> Bool
< :: RangeSpecification -> RangeSpecification -> Bool
$c<= :: RangeSpecification -> RangeSpecification -> Bool
<= :: RangeSpecification -> RangeSpecification -> Bool
$c> :: RangeSpecification -> RangeSpecification -> Bool
> :: RangeSpecification -> RangeSpecification -> Bool
$c>= :: RangeSpecification -> RangeSpecification -> Bool
>= :: RangeSpecification -> RangeSpecification -> Bool
$cmax :: RangeSpecification -> RangeSpecification -> RangeSpecification
max :: RangeSpecification -> RangeSpecification -> RangeSpecification
$cmin :: RangeSpecification -> RangeSpecification -> RangeSpecification
min :: RangeSpecification -> RangeSpecification -> RangeSpecification
Ord, Int -> RangeSpecification -> ShowS
[RangeSpecification] -> ShowS
RangeSpecification -> String
(Int -> RangeSpecification -> ShowS)
-> (RangeSpecification -> String)
-> ([RangeSpecification] -> ShowS)
-> Show RangeSpecification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RangeSpecification -> ShowS
showsPrec :: Int -> RangeSpecification -> ShowS
$cshow :: RangeSpecification -> String
show :: RangeSpecification -> String
$cshowList :: [RangeSpecification] -> ShowS
showList :: [RangeSpecification] -> ShowS
Show, ReadPrec [RangeSpecification]
ReadPrec RangeSpecification
Int -> ReadS RangeSpecification
ReadS [RangeSpecification]
(Int -> ReadS RangeSpecification)
-> ReadS [RangeSpecification]
-> ReadPrec RangeSpecification
-> ReadPrec [RangeSpecification]
-> Read RangeSpecification
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS RangeSpecification
readsPrec :: Int -> ReadS RangeSpecification
$creadList :: ReadS [RangeSpecification]
readList :: ReadS [RangeSpecification]
$creadPrec :: ReadPrec RangeSpecification
readPrec :: ReadPrec RangeSpecification
$creadListPrec :: ReadPrec [RangeSpecification]
readListPrec :: ReadPrec [RangeSpecification]
Read, (forall x. RangeSpecification -> Rep RangeSpecification x)
-> (forall x. Rep RangeSpecification x -> RangeSpecification)
-> Generic RangeSpecification
forall x. Rep RangeSpecification x -> RangeSpecification
forall x. RangeSpecification -> Rep RangeSpecification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RangeSpecification -> Rep RangeSpecification x
from :: forall x. RangeSpecification -> Rep RangeSpecification x
$cto :: forall x. Rep RangeSpecification x -> RangeSpecification
to :: forall x. Rep RangeSpecification x -> RangeSpecification
Generic)

instance NFData RangeSpecification

instance Pretty RangeSpecification where
    pretty :: forall ann. RangeSpecification -> Doc ann
pretty = \case
        RangeSpecification
CurrentLine ->
            Doc ann
forall a. Monoid a => a
mempty
        RangeSpecification
WholeFile ->
            Doc ann
"%"
        RangeCount Int
c ->
            Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
c

instance NvimObject RangeSpecification where
    toObject :: RangeSpecification -> Object
toObject = \case
        RangeSpecification
CurrentLine -> ByteString -> Object
ObjectBinary ByteString
""
        RangeSpecification
WholeFile -> ByteString -> Object
ObjectBinary ByteString
"%"
        RangeCount Int
n -> Int -> Object
forall o. NvimObject o => o -> Object
toObject Int
n

    fromObject :: Object -> Either (Doc AnsiStyle) RangeSpecification
fromObject Object
o =
        Doc AnsiStyle -> Either (Doc AnsiStyle) RangeSpecification
forall a. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle -> Either (Doc AnsiStyle) RangeSpecification)
-> Doc AnsiStyle -> Either (Doc AnsiStyle) RangeSpecification
forall a b. (a -> b) -> a -> b
$
            Doc AnsiStyle
"Did not expect to receive a RangeSpecification object:" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Object -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow Object
o

{- | You can use this type as the first argument for a function which is
 intended to be exported as a command. It holds information about the special
 attributes a command can take.
-}
data CommandArguments = CommandArguments
    { CommandArguments -> Maybe Bool
bang :: Maybe Bool
    -- ^ 'Nothing' means that the function was not defined to handle a bang,
    -- otherwise it means that the bang was passed (@'Just' 'True'@) or that it
    -- was not passed when called (@'Just' 'False'@).
    , CommandArguments -> Maybe (Int, Int)
range :: Maybe (Int, Int)
    -- ^ Range passed from neovim. Only set if 'CmdRange' was used in the export
    -- declaration of the command.
    --
    -- Example:
    --
    -- * @Just (1,12)@
    , CommandArguments -> Maybe Int
count :: Maybe Int
    -- ^ Count passed by neovim. Only set if 'CmdCount' was used in the export
    -- declaration of the command.
    , CommandArguments -> Maybe String
register :: Maybe String
    -- ^ Register that the command can\/should\/must use.
    }
    deriving (CommandArguments -> CommandArguments -> Bool
(CommandArguments -> CommandArguments -> Bool)
-> (CommandArguments -> CommandArguments -> Bool)
-> Eq CommandArguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommandArguments -> CommandArguments -> Bool
== :: CommandArguments -> CommandArguments -> Bool
$c/= :: CommandArguments -> CommandArguments -> Bool
/= :: CommandArguments -> CommandArguments -> Bool
Eq, Eq CommandArguments
Eq CommandArguments =>
(CommandArguments -> CommandArguments -> Ordering)
-> (CommandArguments -> CommandArguments -> Bool)
-> (CommandArguments -> CommandArguments -> Bool)
-> (CommandArguments -> CommandArguments -> Bool)
-> (CommandArguments -> CommandArguments -> Bool)
-> (CommandArguments -> CommandArguments -> CommandArguments)
-> (CommandArguments -> CommandArguments -> CommandArguments)
-> Ord CommandArguments
CommandArguments -> CommandArguments -> Bool
CommandArguments -> CommandArguments -> Ordering
CommandArguments -> CommandArguments -> CommandArguments
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
$ccompare :: CommandArguments -> CommandArguments -> Ordering
compare :: CommandArguments -> CommandArguments -> Ordering
$c< :: CommandArguments -> CommandArguments -> Bool
< :: CommandArguments -> CommandArguments -> Bool
$c<= :: CommandArguments -> CommandArguments -> Bool
<= :: CommandArguments -> CommandArguments -> Bool
$c> :: CommandArguments -> CommandArguments -> Bool
> :: CommandArguments -> CommandArguments -> Bool
$c>= :: CommandArguments -> CommandArguments -> Bool
>= :: CommandArguments -> CommandArguments -> Bool
$cmax :: CommandArguments -> CommandArguments -> CommandArguments
max :: CommandArguments -> CommandArguments -> CommandArguments
$cmin :: CommandArguments -> CommandArguments -> CommandArguments
min :: CommandArguments -> CommandArguments -> CommandArguments
Ord, Int -> CommandArguments -> ShowS
[CommandArguments] -> ShowS
CommandArguments -> String
(Int -> CommandArguments -> ShowS)
-> (CommandArguments -> String)
-> ([CommandArguments] -> ShowS)
-> Show CommandArguments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommandArguments -> ShowS
showsPrec :: Int -> CommandArguments -> ShowS
$cshow :: CommandArguments -> String
show :: CommandArguments -> String
$cshowList :: [CommandArguments] -> ShowS
showList :: [CommandArguments] -> ShowS
Show, ReadPrec [CommandArguments]
ReadPrec CommandArguments
Int -> ReadS CommandArguments
ReadS [CommandArguments]
(Int -> ReadS CommandArguments)
-> ReadS [CommandArguments]
-> ReadPrec CommandArguments
-> ReadPrec [CommandArguments]
-> Read CommandArguments
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CommandArguments
readsPrec :: Int -> ReadS CommandArguments
$creadList :: ReadS [CommandArguments]
readList :: ReadS [CommandArguments]
$creadPrec :: ReadPrec CommandArguments
readPrec :: ReadPrec CommandArguments
$creadListPrec :: ReadPrec [CommandArguments]
readListPrec :: ReadPrec [CommandArguments]
Read, (forall x. CommandArguments -> Rep CommandArguments x)
-> (forall x. Rep CommandArguments x -> CommandArguments)
-> Generic CommandArguments
forall x. Rep CommandArguments x -> CommandArguments
forall x. CommandArguments -> Rep CommandArguments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CommandArguments -> Rep CommandArguments x
from :: forall x. CommandArguments -> Rep CommandArguments x
$cto :: forall x. Rep CommandArguments x -> CommandArguments
to :: forall x. Rep CommandArguments x -> CommandArguments
Generic)

instance NFData CommandArguments

instance Pretty CommandArguments where
    pretty :: forall ann. CommandArguments -> Doc ann
pretty CommandArguments{Maybe Bool
Maybe Int
Maybe String
Maybe (Int, Int)
bang :: CommandArguments -> Maybe Bool
range :: CommandArguments -> Maybe (Int, Int)
count :: CommandArguments -> Maybe Int
register :: CommandArguments -> Maybe String
bang :: Maybe Bool
range :: Maybe (Int, Int)
count :: Maybe Int
register :: Maybe String
..} =
        [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
cat ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$
            [Maybe (Doc ann)] -> [Doc ann]
forall a. [Maybe a] -> [a]
catMaybes
                [ (\Bool
b -> if Bool
b then Doc ann
"!" else Doc ann
forall a. Monoid a => a
mempty) (Bool -> Doc ann) -> Maybe Bool -> Maybe (Doc ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
bang
                , ( \(Int
s, Int
e) ->
                        Doc ann
forall ann. Doc ann
lparen Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
s Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
comma
                            Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
e Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
rparen
                  )
                    ((Int, Int) -> Doc ann) -> Maybe (Int, Int) -> Maybe (Doc ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Int, Int)
range
                , Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Int -> Doc ann) -> Maybe Int -> Maybe (Doc ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
count
                , String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc ann) -> Maybe String -> Maybe (Doc ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
register
                ]

instance Default CommandArguments where
    def :: CommandArguments
def =
        CommandArguments
            { bang :: Maybe Bool
bang = Maybe Bool
forall a. Maybe a
Nothing
            , range :: Maybe (Int, Int)
range = Maybe (Int, Int)
forall a. Maybe a
Nothing
            , count :: Maybe Int
count = Maybe Int
forall a. Maybe a
Nothing
            , register :: Maybe String
register = Maybe String
forall a. Maybe a
Nothing
            }

-- XXX This instance is used as a bit of a hack, so that I don't have to write
--     special code handling in the code generator and "Neovim.RPC.SocketReader".
instance NvimObject CommandArguments where
    toObject :: CommandArguments -> Object
toObject CommandArguments{Maybe Bool
Maybe Int
Maybe String
Maybe (Int, Int)
bang :: CommandArguments -> Maybe Bool
range :: CommandArguments -> Maybe (Int, Int)
count :: CommandArguments -> Maybe Int
register :: CommandArguments -> Maybe String
bang :: Maybe Bool
range :: Maybe (Int, Int)
count :: Maybe Int
register :: Maybe String
..} =
        (Dictionary -> Object
forall o. NvimObject o => o -> Object
toObject :: Dictionary -> Object)
            (Dictionary -> Object)
-> ([Maybe (ByteString, Object)] -> Dictionary)
-> [Maybe (ByteString, Object)]
-> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ByteString, Object)] -> Dictionary
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
            ([(ByteString, Object)] -> Dictionary)
-> ([Maybe (ByteString, Object)] -> [(ByteString, Object)])
-> [Maybe (ByteString, Object)]
-> Dictionary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (ByteString, Object)] -> [(ByteString, Object)]
forall a. [Maybe a] -> [a]
catMaybes
            ([Maybe (ByteString, Object)] -> Object)
-> [Maybe (ByteString, Object)] -> Object
forall a b. (a -> b) -> a -> b
$ [ Maybe Bool
bang Maybe Bool
-> (Bool -> Maybe (ByteString, Object))
-> Maybe (ByteString, Object)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b -> (ByteString, Object) -> Maybe (ByteString, Object)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
"bang", Bool -> Object
forall o. NvimObject o => o -> Object
toObject Bool
b)
              , Maybe (Int, Int)
range Maybe (Int, Int)
-> ((Int, Int) -> Maybe (ByteString, Object))
-> Maybe (ByteString, Object)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Int, Int)
r -> (ByteString, Object) -> Maybe (ByteString, Object)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
"range", (Int, Int) -> Object
forall o. NvimObject o => o -> Object
toObject (Int, Int)
r)
              , Maybe Int
count Maybe Int
-> (Int -> Maybe (ByteString, Object))
-> Maybe (ByteString, Object)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
c -> (ByteString, Object) -> Maybe (ByteString, Object)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
"count", Int -> Object
forall o. NvimObject o => o -> Object
toObject Int
c)
              , Maybe String
register Maybe String
-> (String -> Maybe (ByteString, Object))
-> Maybe (ByteString, Object)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
r -> (ByteString, Object) -> Maybe (ByteString, Object)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
"register", String -> Object
forall o. NvimObject o => o -> Object
toObject String
r)
              ]

    fromObject :: Object -> Either (Doc AnsiStyle) CommandArguments
fromObject (ObjectMap Map Object Object
m) = do
        let l :: ByteString -> Either (Doc AnsiStyle) (Maybe b)
l ByteString
key = (Object -> Either (Doc AnsiStyle) b)
-> Maybe Object -> Either (Doc AnsiStyle) (Maybe b)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM Object -> Either (Doc AnsiStyle) b
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject (Object -> Map Object Object -> Maybe Object
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (ByteString -> Object
ObjectBinary ByteString
key) Map Object Object
m)
        Maybe Bool
bang <- ByteString -> Either (Doc AnsiStyle) (Maybe Bool)
forall {b}.
NvimObject b =>
ByteString -> Either (Doc AnsiStyle) (Maybe b)
l ByteString
"bang"
        Maybe (Int, Int)
range <- ByteString -> Either (Doc AnsiStyle) (Maybe (Int, Int))
forall {b}.
NvimObject b =>
ByteString -> Either (Doc AnsiStyle) (Maybe b)
l ByteString
"range"
        Maybe Int
count <- ByteString -> Either (Doc AnsiStyle) (Maybe Int)
forall {b}.
NvimObject b =>
ByteString -> Either (Doc AnsiStyle) (Maybe b)
l ByteString
"count"
        Maybe String
register <- ByteString -> Either (Doc AnsiStyle) (Maybe String)
forall {b}.
NvimObject b =>
ByteString -> Either (Doc AnsiStyle) (Maybe b)
l ByteString
"register"
        CommandArguments -> Either (Doc AnsiStyle) CommandArguments
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return CommandArguments{Maybe Bool
Maybe Int
Maybe String
Maybe (Int, Int)
bang :: Maybe Bool
range :: Maybe (Int, Int)
count :: Maybe Int
register :: Maybe String
bang :: Maybe Bool
range :: Maybe (Int, Int)
count :: Maybe Int
register :: Maybe String
..}
    fromObject Object
ObjectNil = CommandArguments -> Either (Doc AnsiStyle) CommandArguments
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return CommandArguments
forall a. Default a => a
def
    fromObject Object
o =
        Doc AnsiStyle -> Either (Doc AnsiStyle) CommandArguments
forall a. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle -> Either (Doc AnsiStyle) CommandArguments)
-> Doc AnsiStyle -> Either (Doc AnsiStyle) CommandArguments
forall a b. (a -> b) -> a -> b
$
            Doc AnsiStyle
"Expected a map for CommandArguments object, but got: "
                Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Object -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow Object
o

{- | Options that can be used to register an autocmd. See @:h :autocmd@ or any
 referenced neovim help-page from the fields of this data type.
-}
data AutocmdOptions = AutocmdOptions
    { AutocmdOptions -> String
acmdPattern :: String
    -- ^ Pattern to match on. (default: \"*\")
    , AutocmdOptions -> Bool
acmdNested :: Bool
    -- ^ Nested autocmd. (default: False)
    --
    -- See @:h autocmd-nested@
    , AutocmdOptions -> Maybe String
acmdGroup :: Maybe String
    -- ^ Group in which the autocmd should be registered.
    }
    deriving (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
$cshowsPrec :: Int -> AutocmdOptions -> ShowS
showsPrec :: Int -> AutocmdOptions -> ShowS
$cshow :: AutocmdOptions -> String
show :: AutocmdOptions -> String
$cshowList :: [AutocmdOptions] -> ShowS
showList :: [AutocmdOptions] -> ShowS
Show, ReadPrec [AutocmdOptions]
ReadPrec AutocmdOptions
Int -> ReadS AutocmdOptions
ReadS [AutocmdOptions]
(Int -> ReadS AutocmdOptions)
-> ReadS [AutocmdOptions]
-> ReadPrec AutocmdOptions
-> ReadPrec [AutocmdOptions]
-> Read AutocmdOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS AutocmdOptions
readsPrec :: Int -> ReadS AutocmdOptions
$creadList :: ReadS [AutocmdOptions]
readList :: ReadS [AutocmdOptions]
$creadPrec :: ReadPrec AutocmdOptions
readPrec :: ReadPrec AutocmdOptions
$creadListPrec :: ReadPrec [AutocmdOptions]
readListPrec :: ReadPrec [AutocmdOptions]
Read, AutocmdOptions -> AutocmdOptions -> Bool
(AutocmdOptions -> AutocmdOptions -> Bool)
-> (AutocmdOptions -> AutocmdOptions -> Bool) -> Eq AutocmdOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AutocmdOptions -> AutocmdOptions -> Bool
== :: AutocmdOptions -> AutocmdOptions -> Bool
$c/= :: AutocmdOptions -> AutocmdOptions -> Bool
/= :: AutocmdOptions -> AutocmdOptions -> Bool
Eq, Eq AutocmdOptions
Eq AutocmdOptions =>
(AutocmdOptions -> AutocmdOptions -> Ordering)
-> (AutocmdOptions -> AutocmdOptions -> Bool)
-> (AutocmdOptions -> AutocmdOptions -> Bool)
-> (AutocmdOptions -> AutocmdOptions -> Bool)
-> (AutocmdOptions -> AutocmdOptions -> Bool)
-> (AutocmdOptions -> AutocmdOptions -> AutocmdOptions)
-> (AutocmdOptions -> AutocmdOptions -> AutocmdOptions)
-> Ord AutocmdOptions
AutocmdOptions -> AutocmdOptions -> Bool
AutocmdOptions -> AutocmdOptions -> Ordering
AutocmdOptions -> AutocmdOptions -> AutocmdOptions
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
$ccompare :: AutocmdOptions -> AutocmdOptions -> Ordering
compare :: AutocmdOptions -> AutocmdOptions -> Ordering
$c< :: AutocmdOptions -> AutocmdOptions -> Bool
< :: AutocmdOptions -> AutocmdOptions -> Bool
$c<= :: AutocmdOptions -> AutocmdOptions -> Bool
<= :: AutocmdOptions -> AutocmdOptions -> Bool
$c> :: AutocmdOptions -> AutocmdOptions -> Bool
> :: AutocmdOptions -> AutocmdOptions -> Bool
$c>= :: AutocmdOptions -> AutocmdOptions -> Bool
>= :: AutocmdOptions -> AutocmdOptions -> Bool
$cmax :: AutocmdOptions -> AutocmdOptions -> AutocmdOptions
max :: AutocmdOptions -> AutocmdOptions -> AutocmdOptions
$cmin :: AutocmdOptions -> AutocmdOptions -> AutocmdOptions
min :: AutocmdOptions -> AutocmdOptions -> AutocmdOptions
Ord, (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
$cfrom :: forall x. AutocmdOptions -> Rep AutocmdOptions x
from :: forall x. AutocmdOptions -> Rep AutocmdOptions x
$cto :: forall x. Rep AutocmdOptions x -> AutocmdOptions
to :: forall x. Rep AutocmdOptions x -> AutocmdOptions
Generic)

instance NFData AutocmdOptions

instance Pretty AutocmdOptions where
    pretty :: forall ann. AutocmdOptions -> Doc ann
pretty AutocmdOptions{Bool
String
Maybe String
acmdPattern :: AutocmdOptions -> String
acmdNested :: AutocmdOptions -> Bool
acmdGroup :: AutocmdOptions -> Maybe String
acmdPattern :: String
acmdNested :: Bool
acmdGroup :: Maybe String
..} =
        String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
acmdPattern
            Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> if Bool
acmdNested
                then Doc ann
"nested"
                else
                    Doc ann
"unnested"
                        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> (String -> Doc ann) -> Maybe String -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty (\String
g -> Doc ann
forall a. Monoid a => a
mempty Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
g) Maybe String
acmdGroup

instance Default AutocmdOptions where
    def :: AutocmdOptions
def =
        AutocmdOptions
            { acmdPattern :: String
acmdPattern = String
"*"
            , acmdNested :: Bool
acmdNested = Bool
False
            , acmdGroup :: Maybe String
acmdGroup = Maybe String
forall a. Maybe a
Nothing
            }

instance NvimObject AutocmdOptions where
    toObject :: AutocmdOptions -> Object
toObject AutocmdOptions{Bool
String
Maybe String
acmdPattern :: AutocmdOptions -> String
acmdNested :: AutocmdOptions -> Bool
acmdGroup :: AutocmdOptions -> Maybe String
acmdPattern :: String
acmdNested :: Bool
acmdGroup :: Maybe String
..} =
        (Dictionary -> Object
forall o. NvimObject o => o -> Object
toObject :: Dictionary -> Object) (Dictionary -> Object)
-> ([(ByteString, Object)] -> Dictionary)
-> [(ByteString, Object)]
-> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ByteString, Object)] -> Dictionary
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ByteString, Object)] -> Object)
-> [(ByteString, Object)] -> Object
forall a b. (a -> b) -> a -> b
$
            [ (ByteString
"pattern", String -> Object
forall o. NvimObject o => o -> Object
toObject String
acmdPattern)
            , (ByteString
"nested", Bool -> Object
forall o. NvimObject o => o -> Object
toObject Bool
acmdNested)
            ]
                [(ByteString, Object)]
-> [(ByteString, Object)] -> [(ByteString, Object)]
forall a. [a] -> [a] -> [a]
++ [Maybe (ByteString, Object)] -> [(ByteString, Object)]
forall a. [Maybe a] -> [a]
catMaybes
                    [ Maybe String
acmdGroup Maybe String
-> (String -> Maybe (ByteString, Object))
-> Maybe (ByteString, Object)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
g -> (ByteString, Object) -> Maybe (ByteString, Object)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
"group", String -> Object
forall o. NvimObject o => o -> Object
toObject String
g)
                    ]
    fromObject :: Object -> Either (Doc AnsiStyle) AutocmdOptions
fromObject Object
o =
        Doc AnsiStyle -> Either (Doc AnsiStyle) AutocmdOptions
forall a. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle -> Either (Doc AnsiStyle) AutocmdOptions)
-> Doc AnsiStyle -> Either (Doc AnsiStyle) AutocmdOptions
forall a b. (a -> b) -> a -> b
$
            Doc AnsiStyle
"Did not expect to receive an AutocmdOptions object: " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Object -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow Object
o

newtype NvimMethod = NvimMethod {NvimMethod -> Text
nvimMethodName :: Text}
    deriving (NvimMethod -> NvimMethod -> Bool
(NvimMethod -> NvimMethod -> Bool)
-> (NvimMethod -> NvimMethod -> Bool) -> Eq NvimMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NvimMethod -> NvimMethod -> Bool
== :: NvimMethod -> NvimMethod -> Bool
$c/= :: NvimMethod -> NvimMethod -> Bool
/= :: NvimMethod -> NvimMethod -> Bool
Eq, Eq NvimMethod
Eq NvimMethod =>
(NvimMethod -> NvimMethod -> Ordering)
-> (NvimMethod -> NvimMethod -> Bool)
-> (NvimMethod -> NvimMethod -> Bool)
-> (NvimMethod -> NvimMethod -> Bool)
-> (NvimMethod -> NvimMethod -> Bool)
-> (NvimMethod -> NvimMethod -> NvimMethod)
-> (NvimMethod -> NvimMethod -> NvimMethod)
-> Ord NvimMethod
NvimMethod -> NvimMethod -> Bool
NvimMethod -> NvimMethod -> Ordering
NvimMethod -> NvimMethod -> NvimMethod
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
$ccompare :: NvimMethod -> NvimMethod -> Ordering
compare :: NvimMethod -> NvimMethod -> Ordering
$c< :: NvimMethod -> NvimMethod -> Bool
< :: NvimMethod -> NvimMethod -> Bool
$c<= :: NvimMethod -> NvimMethod -> Bool
<= :: NvimMethod -> NvimMethod -> Bool
$c> :: NvimMethod -> NvimMethod -> Bool
> :: NvimMethod -> NvimMethod -> Bool
$c>= :: NvimMethod -> NvimMethod -> Bool
>= :: NvimMethod -> NvimMethod -> Bool
$cmax :: NvimMethod -> NvimMethod -> NvimMethod
max :: NvimMethod -> NvimMethod -> NvimMethod
$cmin :: NvimMethod -> NvimMethod -> NvimMethod
min :: NvimMethod -> NvimMethod -> NvimMethod
Ord, Int -> NvimMethod -> ShowS
[NvimMethod] -> ShowS
NvimMethod -> String
(Int -> NvimMethod -> ShowS)
-> (NvimMethod -> String)
-> ([NvimMethod] -> ShowS)
-> Show NvimMethod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NvimMethod -> ShowS
showsPrec :: Int -> NvimMethod -> ShowS
$cshow :: NvimMethod -> String
show :: NvimMethod -> String
$cshowList :: [NvimMethod] -> ShowS
showList :: [NvimMethod] -> ShowS
Show, ReadPrec [NvimMethod]
ReadPrec NvimMethod
Int -> ReadS NvimMethod
ReadS [NvimMethod]
(Int -> ReadS NvimMethod)
-> ReadS [NvimMethod]
-> ReadPrec NvimMethod
-> ReadPrec [NvimMethod]
-> Read NvimMethod
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS NvimMethod
readsPrec :: Int -> ReadS NvimMethod
$creadList :: ReadS [NvimMethod]
readList :: ReadS [NvimMethod]
$creadPrec :: ReadPrec NvimMethod
readPrec :: ReadPrec NvimMethod
$creadListPrec :: ReadPrec [NvimMethod]
readListPrec :: ReadPrec [NvimMethod]
Read, (forall x. NvimMethod -> Rep NvimMethod x)
-> (forall x. Rep NvimMethod x -> NvimMethod) -> Generic NvimMethod
forall x. Rep NvimMethod x -> NvimMethod
forall x. NvimMethod -> Rep NvimMethod x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NvimMethod -> Rep NvimMethod x
from :: forall x. NvimMethod -> Rep NvimMethod x
$cto :: forall x. Rep NvimMethod x -> NvimMethod
to :: forall x. Rep NvimMethod x -> NvimMethod
Generic)
    deriving ((forall ann. NvimMethod -> Doc ann)
-> (forall ann. [NvimMethod] -> Doc ann) -> Pretty NvimMethod
forall ann. [NvimMethod] -> Doc ann
forall ann. NvimMethod -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
$cpretty :: forall ann. NvimMethod -> Doc ann
pretty :: forall ann. NvimMethod -> Doc ann
$cprettyList :: forall ann. [NvimMethod] -> Doc ann
prettyList :: forall ann. [NvimMethod] -> Doc ann
Pretty, NvimMethod -> ()
(NvimMethod -> ()) -> NFData NvimMethod
forall a. (a -> ()) -> NFData a
$crnf :: NvimMethod -> ()
rnf :: NvimMethod -> ()
NFData) via Text

-- | Conveniennce class to extract a name from some value.
class HasFunctionName a where
    name :: a -> FunctionName
    nvimMethod :: a -> NvimMethod

instance HasFunctionName FunctionalityDescription where
    name :: FunctionalityDescription -> FunctionName
name = \case
        Function FunctionName
n Synchronous
_ -> FunctionName
n
        Command FunctionName
n CommandOptions
_ -> FunctionName
n
        Autocmd Text
_ FunctionName
n Synchronous
_ AutocmdOptions
_ -> FunctionName
n

    nvimMethod :: FunctionalityDescription -> NvimMethod
nvimMethod = \case
        Function (F Text
n) Synchronous
_ -> Text -> NvimMethod
NvimMethod (Text -> NvimMethod) -> Text -> NvimMethod
forall a b. (a -> b) -> a -> b
$ Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":function"
        Command (F Text
n) CommandOptions
_ -> Text -> NvimMethod
NvimMethod (Text -> NvimMethod) -> Text -> NvimMethod
forall a b. (a -> b) -> a -> b
$ Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":command"
        Autocmd Text
_ (F Text
n) Synchronous
_ AutocmdOptions
_ -> Text -> NvimMethod
NvimMethod Text
n