{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE DeriveGeneric     #-}
{- |
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(..),
    NvimMethod(..),
    Synchronous(..),
    CommandOption(..),
    CommandOptions,
    RangeSpecification(..),
    CommandArguments(..),
    getCommandOptions,
    mkCommandOptions,
    AutocmdOptions(..),
    HasFunctionName(..),
    ) where

import           Neovim.Classes

import           Control.Applicative          hiding (empty)
import           Control.Monad.Error.Class
import           Data.ByteString              (ByteString)
import           Data.Char                    (isDigit)
import           Data.Default
import           Data.List                    (groupBy, sort)
import qualified Data.Map                     as Map
import           Data.Maybe
import           Data.MessagePack
import           Data.String
import           Data.Traversable             (sequence)
import           Data.Text.Encoding           (decodeUtf8)

import Data.Text.Prettyprint.Doc

import           Prelude                      hiding (sequence)


-- | Essentially just a string.
newtype FunctionName = F ByteString
    deriving (FunctionName -> FunctionName -> Bool
(FunctionName -> FunctionName -> Bool)
-> (FunctionName -> FunctionName -> Bool) -> Eq FunctionName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FunctionName -> FunctionName -> Bool
$c/= :: FunctionName -> FunctionName -> Bool
== :: FunctionName -> FunctionName -> Bool
$c== :: 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
min :: FunctionName -> FunctionName -> FunctionName
$cmin :: FunctionName -> FunctionName -> FunctionName
max :: FunctionName -> FunctionName -> FunctionName
$cmax :: FunctionName -> FunctionName -> FunctionName
>= :: FunctionName -> FunctionName -> Bool
$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
compare :: FunctionName -> FunctionName -> Ordering
$ccompare :: FunctionName -> FunctionName -> Ordering
$cp1Ord :: Eq 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
showList :: [FunctionName] -> ShowS
$cshowList :: [FunctionName] -> ShowS
show :: FunctionName -> String
$cshow :: FunctionName -> String
showsPrec :: Int -> FunctionName -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [FunctionName]
$creadListPrec :: ReadPrec [FunctionName]
readPrec :: ReadPrec FunctionName
$creadPrec :: ReadPrec FunctionName
readList :: ReadS [FunctionName]
$creadList :: ReadS [FunctionName]
readsPrec :: Int -> ReadS FunctionName
$creadsPrec :: Int -> ReadS 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
$cto :: forall x. Rep FunctionName x -> FunctionName
$cfrom :: forall x. FunctionName -> Rep FunctionName x
Generic)


instance NFData FunctionName


instance Pretty FunctionName where
    pretty :: FunctionName -> Doc ann
pretty (F ByteString
n) = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc ann) -> Text -> Doc ann
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 ByteString
n


-- | 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
    = Function FunctionName Synchronous
    -- ^ 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

    | Command FunctionName CommandOptions
    -- ^ 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

    | Autocmd ByteString FunctionName Synchronous AutocmdOptions
    -- ^ 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)

    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
showList :: [FunctionalityDescription] -> ShowS
$cshowList :: [FunctionalityDescription] -> ShowS
show :: FunctionalityDescription -> String
$cshow :: FunctionalityDescription -> String
showsPrec :: Int -> FunctionalityDescription -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [FunctionalityDescription]
$creadListPrec :: ReadPrec [FunctionalityDescription]
readPrec :: ReadPrec FunctionalityDescription
$creadPrec :: ReadPrec FunctionalityDescription
readList :: ReadS [FunctionalityDescription]
$creadList :: ReadS [FunctionalityDescription]
readsPrec :: Int -> ReadS FunctionalityDescription
$creadsPrec :: Int -> ReadS FunctionalityDescription
Read, FunctionalityDescription -> FunctionalityDescription -> Bool
(FunctionalityDescription -> FunctionalityDescription -> Bool)
-> (FunctionalityDescription -> FunctionalityDescription -> Bool)
-> Eq FunctionalityDescription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FunctionalityDescription -> FunctionalityDescription -> Bool
$c/= :: FunctionalityDescription -> FunctionalityDescription -> Bool
== :: FunctionalityDescription -> FunctionalityDescription -> Bool
$c== :: 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
min :: FunctionalityDescription
-> FunctionalityDescription -> FunctionalityDescription
$cmin :: FunctionalityDescription
-> FunctionalityDescription -> FunctionalityDescription
max :: FunctionalityDescription
-> FunctionalityDescription -> FunctionalityDescription
$cmax :: FunctionalityDescription
-> FunctionalityDescription -> FunctionalityDescription
>= :: FunctionalityDescription -> FunctionalityDescription -> Bool
$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
compare :: FunctionalityDescription -> FunctionalityDescription -> Ordering
$ccompare :: FunctionalityDescription -> FunctionalityDescription -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x.
Rep FunctionalityDescription x -> FunctionalityDescription
$cfrom :: forall x.
FunctionalityDescription -> Rep FunctionalityDescription x
Generic)


instance NFData FunctionalityDescription


instance Pretty FunctionalityDescription where
    pretty :: 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
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
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
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
pretty FunctionName
fname

        Autocmd ByteString
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 a ann. Pretty a => a -> Doc ann
pretty (ByteString -> Text
decodeUtf8 ByteString
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
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
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
pretty FunctionName
fname


-- | This option detemines how neovim should behave when calling some
-- functionality on a remote host.
data Synchronous
    = Async
    -- ^ 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.

    | Sync
    -- ^ 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.
    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
showList :: [Synchronous] -> ShowS
$cshowList :: [Synchronous] -> ShowS
show :: Synchronous -> String
$cshow :: Synchronous -> String
showsPrec :: Int -> Synchronous -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [Synchronous]
$creadListPrec :: ReadPrec [Synchronous]
readPrec :: ReadPrec Synchronous
$creadPrec :: ReadPrec Synchronous
readList :: ReadS [Synchronous]
$creadList :: ReadS [Synchronous]
readsPrec :: Int -> ReadS Synchronous
$creadsPrec :: Int -> ReadS Synchronous
Read, Synchronous -> Synchronous -> Bool
(Synchronous -> Synchronous -> Bool)
-> (Synchronous -> Synchronous -> Bool) -> Eq Synchronous
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Synchronous -> Synchronous -> Bool
$c/= :: Synchronous -> Synchronous -> Bool
== :: Synchronous -> Synchronous -> Bool
$c== :: 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
min :: Synchronous -> Synchronous -> Synchronous
$cmin :: Synchronous -> Synchronous -> Synchronous
max :: Synchronous -> Synchronous -> Synchronous
$cmax :: Synchronous -> Synchronous -> Synchronous
>= :: Synchronous -> Synchronous -> Bool
$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
compare :: Synchronous -> Synchronous -> Ordering
$ccompare :: Synchronous -> Synchronous -> Ordering
$cp1Ord :: Eq 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
enumFromThenTo :: Synchronous -> Synchronous -> Synchronous -> [Synchronous]
$cenumFromThenTo :: Synchronous -> Synchronous -> Synchronous -> [Synchronous]
enumFromTo :: Synchronous -> Synchronous -> [Synchronous]
$cenumFromTo :: Synchronous -> Synchronous -> [Synchronous]
enumFromThen :: Synchronous -> Synchronous -> [Synchronous]
$cenumFromThen :: Synchronous -> Synchronous -> [Synchronous]
enumFrom :: Synchronous -> [Synchronous]
$cenumFrom :: Synchronous -> [Synchronous]
fromEnum :: Synchronous -> Int
$cfromEnum :: Synchronous -> Int
toEnum :: Int -> Synchronous
$ctoEnum :: Int -> Synchronous
pred :: Synchronous -> Synchronous
$cpred :: Synchronous -> Synchronous
succ :: Synchronous -> Synchronous
$csucc :: 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
$cto :: forall x. Rep Synchronous x -> Synchronous
$cfrom :: forall x. Synchronous -> Rep Synchronous x
Generic)

instance NFData Synchronous

instance Pretty Synchronous where
    pretty :: 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 (m :: * -> *) a. Monad m => a -> m a
return Synchronous
Sync
        ObjectBool Bool
False -> Synchronous -> Either (Doc AnsiStyle) Synchronous
forall (m :: * -> *) a. Monad m => a -> m a
return Synchronous
Async
        ObjectInt Int64
0      -> Synchronous -> Either (Doc AnsiStyle) Synchronous
forall (m :: * -> *) a. Monad m => a -> m a
return Synchronous
Async
        Object
_                -> Synchronous -> Either (Doc AnsiStyle) Synchronous
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 = CmdSync Synchronous
                   -- ^ Stringliteral "sync" or "async"

                   | CmdRegister
                   -- ^ Register passed to the command.
                   --
                   -- Stringliteral: @\"\\\"\"@

                   | CmdNargs String
                   -- ^ 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.

                   | CmdRange RangeSpecification
                   -- ^ Determines how neovim passes the range.
                   --
                   -- Stringliterals: \"%\" for 'WholeFile', \",\" for line
                   --                 and \",123\" for 123 lines.

                   | CmdCount Word
                   -- ^ Command handles a count. The argument defines the
                   -- default count.
                   --
                   -- Stringliteral: string of numbers (e.g. "132")

                   | CmdBang
                   -- ^ Command handles a bang
                   --
                   -- Stringliteral: \"!\"

                   | CmdComplete String
                   -- ^ Verbatim string passed to the @-complete=@ command attribute
    deriving (CommandOption -> CommandOption -> Bool
(CommandOption -> CommandOption -> Bool)
-> (CommandOption -> CommandOption -> Bool) -> Eq CommandOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommandOption -> CommandOption -> Bool
$c/= :: CommandOption -> CommandOption -> Bool
== :: CommandOption -> CommandOption -> Bool
$c== :: 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
min :: CommandOption -> CommandOption -> CommandOption
$cmin :: CommandOption -> CommandOption -> CommandOption
max :: CommandOption -> CommandOption -> CommandOption
$cmax :: CommandOption -> CommandOption -> CommandOption
>= :: CommandOption -> CommandOption -> Bool
$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
compare :: CommandOption -> CommandOption -> Ordering
$ccompare :: CommandOption -> CommandOption -> Ordering
$cp1Ord :: Eq 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
showList :: [CommandOption] -> ShowS
$cshowList :: [CommandOption] -> ShowS
show :: CommandOption -> String
$cshow :: CommandOption -> String
showsPrec :: Int -> CommandOption -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [CommandOption]
$creadListPrec :: ReadPrec [CommandOption]
readPrec :: ReadPrec CommandOption
$creadPrec :: ReadPrec CommandOption
readList :: ReadS [CommandOption]
$creadList :: ReadS [CommandOption]
readsPrec :: Int -> ReadS CommandOption
$creadsPrec :: Int -> ReadS 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
$cto :: forall x. Rep CommandOption x -> CommandOption
$cfrom :: forall x. CommandOption -> Rep CommandOption x
Generic)

instance NFData CommandOption


instance Pretty CommandOption where
    pretty :: CommandOption -> Doc ann
pretty = \case
        CmdSync Synchronous
s ->
            Synchronous -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Synchronous
s

        CommandOption
CmdRegister ->
            Doc ann
"\""

        CmdNargs String
n ->
            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
pretty RangeSpecification
rs

        CmdCount Word
c ->
            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 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 (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 (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
/= :: CommandOptions -> CommandOptions -> Bool
$c/= :: CommandOptions -> CommandOptions -> Bool
== :: CommandOptions -> CommandOptions -> Bool
$c== :: 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
min :: CommandOptions -> CommandOptions -> CommandOptions
$cmin :: CommandOptions -> CommandOptions -> CommandOptions
max :: CommandOptions -> CommandOptions -> CommandOptions
$cmax :: CommandOptions -> CommandOptions -> CommandOptions
>= :: CommandOptions -> CommandOptions -> Bool
$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
compare :: CommandOptions -> CommandOptions -> Ordering
$ccompare :: CommandOptions -> CommandOptions -> Ordering
$cp1Ord :: Eq 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
showList :: [CommandOptions] -> ShowS
$cshowList :: [CommandOptions] -> ShowS
show :: CommandOptions -> String
$cshow :: CommandOptions -> String
showsPrec :: Int -> CommandOptions -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [CommandOptions]
$creadListPrec :: ReadPrec [CommandOptions]
readPrec :: ReadPrec CommandOptions
$creadPrec :: ReadPrec CommandOptions
readList :: ReadS [CommandOptions]
$creadList :: ReadS [CommandOptions]
readsPrec :: Int -> ReadS CommandOptions
$creadsPrec :: Int -> ReadS 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
$cto :: forall x. Rep CommandOptions x -> CommandOptions
$cfrom :: forall x. CommandOptions -> Rep CommandOptions x
Generic)

instance NFData CommandOptions

instance Pretty CommandOptions where
    pretty :: 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
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. [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 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
    = CurrentLine
    -- ^ The line the cursor is at when the command is invoked.

    | WholeFile
    -- ^ Let the command operate on every line of the file.

    | RangeCount Int
    -- ^ Let the command operate on each line in the given range.

    deriving (RangeSpecification -> RangeSpecification -> Bool
(RangeSpecification -> RangeSpecification -> Bool)
-> (RangeSpecification -> RangeSpecification -> Bool)
-> Eq RangeSpecification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RangeSpecification -> RangeSpecification -> Bool
$c/= :: RangeSpecification -> RangeSpecification -> Bool
== :: RangeSpecification -> RangeSpecification -> Bool
$c== :: 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
min :: RangeSpecification -> RangeSpecification -> RangeSpecification
$cmin :: RangeSpecification -> RangeSpecification -> RangeSpecification
max :: RangeSpecification -> RangeSpecification -> RangeSpecification
$cmax :: RangeSpecification -> RangeSpecification -> RangeSpecification
>= :: RangeSpecification -> RangeSpecification -> Bool
$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
compare :: RangeSpecification -> RangeSpecification -> Ordering
$ccompare :: RangeSpecification -> RangeSpecification -> Ordering
$cp1Ord :: Eq 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
showList :: [RangeSpecification] -> ShowS
$cshowList :: [RangeSpecification] -> ShowS
show :: RangeSpecification -> String
$cshow :: RangeSpecification -> String
showsPrec :: Int -> RangeSpecification -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [RangeSpecification]
$creadListPrec :: ReadPrec [RangeSpecification]
readPrec :: ReadPrec RangeSpecification
$creadPrec :: ReadPrec RangeSpecification
readList :: ReadS [RangeSpecification]
$creadList :: ReadS [RangeSpecification]
readsPrec :: Int -> ReadS RangeSpecification
$creadsPrec :: Int -> ReadS 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
$cto :: forall x. Rep RangeSpecification x -> RangeSpecification
$cfrom :: forall x. RangeSpecification -> Rep RangeSpecification x
Generic)

instance NFData RangeSpecification

instance Pretty RangeSpecification where
    pretty :: 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 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 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
/= :: CommandArguments -> CommandArguments -> Bool
$c/= :: CommandArguments -> CommandArguments -> Bool
== :: CommandArguments -> CommandArguments -> Bool
$c== :: 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
min :: CommandArguments -> CommandArguments -> CommandArguments
$cmin :: CommandArguments -> CommandArguments -> CommandArguments
max :: CommandArguments -> CommandArguments -> CommandArguments
$cmax :: CommandArguments -> CommandArguments -> CommandArguments
>= :: CommandArguments -> CommandArguments -> Bool
$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
compare :: CommandArguments -> CommandArguments -> Ordering
$ccompare :: CommandArguments -> CommandArguments -> Ordering
$cp1Ord :: Eq 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
showList :: [CommandArguments] -> ShowS
$cshowList :: [CommandArguments] -> ShowS
show :: CommandArguments -> String
$cshow :: CommandArguments -> String
showsPrec :: Int -> CommandArguments -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [CommandArguments]
$creadListPrec :: ReadPrec [CommandArguments]
readPrec :: ReadPrec CommandArguments
$creadPrec :: ReadPrec CommandArguments
readList :: ReadS [CommandArguments]
$creadList :: ReadS [CommandArguments]
readsPrec :: Int -> ReadS CommandArguments
$creadsPrec :: Int -> ReadS 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
$cto :: forall x. Rep CommandArguments x -> CommandArguments
$cfrom :: forall x. CommandArguments -> Rep CommandArguments x
Generic)


instance NFData CommandArguments


instance Pretty CommandArguments where
    pretty :: CommandArguments -> Doc ann
pretty CommandArguments{Maybe Bool
Maybe Int
Maybe String
Maybe (Int, Int)
register :: Maybe String
count :: Maybe Int
range :: Maybe (Int, Int)
bang :: Maybe Bool
register :: CommandArguments -> Maybe String
count :: CommandArguments -> Maybe Int
range :: CommandArguments -> Maybe (Int, Int)
bang :: CommandArguments -> Maybe Bool
..} =
        [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 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 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 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 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 :: Maybe Bool
-> Maybe (Int, Int)
-> Maybe Int
-> Maybe String
-> CommandArguments
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)
register :: Maybe String
count :: Maybe Int
range :: Maybe (Int, Int)
bang :: Maybe Bool
register :: CommandArguments -> Maybe String
count :: CommandArguments -> Maybe Int
range :: CommandArguments -> Maybe (Int, Int)
bang :: CommandArguments -> Maybe Bool
..} = (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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b -> (ByteString, Object) -> Maybe (ByteString, Object)
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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Int, Int)
r -> (ByteString, Object) -> Maybe (ByteString, Object)
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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
c -> (ByteString, Object) -> Maybe (ByteString, Object)
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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
r -> (ByteString, Object) -> Maybe (ByteString, Object)
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 a)
l ByteString
key = Maybe (Either (Doc AnsiStyle) a)
-> Either (Doc AnsiStyle) (Maybe a)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Object -> Either (Doc AnsiStyle) a
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject (Object -> Either (Doc AnsiStyle) a)
-> Maybe Object -> Maybe (Either (Doc AnsiStyle) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 a.
NvimObject a =>
ByteString -> Either (Doc AnsiStyle) (Maybe a)
l ByteString
"bang"
        Maybe (Int, Int)
range <- ByteString -> Either (Doc AnsiStyle) (Maybe (Int, Int))
forall a.
NvimObject a =>
ByteString -> Either (Doc AnsiStyle) (Maybe a)
l ByteString
"range"
        Maybe Int
count <- ByteString -> Either (Doc AnsiStyle) (Maybe Int)
forall a.
NvimObject a =>
ByteString -> Either (Doc AnsiStyle) (Maybe a)
l ByteString
"count"
        Maybe String
register <- ByteString -> Either (Doc AnsiStyle) (Maybe String)
forall a.
NvimObject a =>
ByteString -> Either (Doc AnsiStyle) (Maybe a)
l ByteString
"register"
        CommandArguments -> Either (Doc AnsiStyle) CommandArguments
forall (m :: * -> *) a. Monad m => a -> m a
return CommandArguments :: Maybe Bool
-> Maybe (Int, Int)
-> Maybe Int
-> Maybe String
-> CommandArguments
CommandArguments{Maybe Bool
Maybe Int
Maybe String
Maybe (Int, Int)
register :: Maybe String
count :: Maybe Int
range :: Maybe (Int, Int)
bang :: Maybe Bool
register :: Maybe String
count :: Maybe Int
range :: Maybe (Int, Int)
bang :: Maybe Bool
..}

    fromObject Object
ObjectNil = CommandArguments -> Either (Doc AnsiStyle) CommandArguments
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 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
showList :: [AutocmdOptions] -> ShowS
$cshowList :: [AutocmdOptions] -> ShowS
show :: AutocmdOptions -> String
$cshow :: AutocmdOptions -> String
showsPrec :: Int -> AutocmdOptions -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [AutocmdOptions]
$creadListPrec :: ReadPrec [AutocmdOptions]
readPrec :: ReadPrec AutocmdOptions
$creadPrec :: ReadPrec AutocmdOptions
readList :: ReadS [AutocmdOptions]
$creadList :: ReadS [AutocmdOptions]
readsPrec :: Int -> ReadS AutocmdOptions
$creadsPrec :: Int -> ReadS AutocmdOptions
Read, 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, 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
min :: AutocmdOptions -> AutocmdOptions -> AutocmdOptions
$cmin :: AutocmdOptions -> AutocmdOptions -> AutocmdOptions
max :: AutocmdOptions -> AutocmdOptions -> AutocmdOptions
$cmax :: AutocmdOptions -> AutocmdOptions -> AutocmdOptions
>= :: AutocmdOptions -> AutocmdOptions -> Bool
$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
compare :: AutocmdOptions -> AutocmdOptions -> Ordering
$ccompare :: AutocmdOptions -> AutocmdOptions -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep AutocmdOptions x -> AutocmdOptions
$cfrom :: forall x. AutocmdOptions -> Rep AutocmdOptions x
Generic)


instance NFData AutocmdOptions


instance Pretty AutocmdOptions where
    pretty :: AutocmdOptions -> Doc ann
pretty AutocmdOptions{Bool
String
Maybe String
acmdGroup :: Maybe String
acmdNested :: Bool
acmdPattern :: String
acmdGroup :: AutocmdOptions -> Maybe String
acmdNested :: AutocmdOptions -> Bool
acmdPattern :: AutocmdOptions -> String
..} =
        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 a ann. Pretty a => a -> Doc ann
pretty String
g) Maybe String
acmdGroup


instance Default AutocmdOptions where
    def :: AutocmdOptions
def = AutocmdOptions :: String -> Bool -> Maybe String -> AutocmdOptions
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
acmdGroup :: Maybe String
acmdNested :: Bool
acmdPattern :: String
acmdGroup :: AutocmdOptions -> Maybe String
acmdNested :: AutocmdOptions -> Bool
acmdPattern :: AutocmdOptions -> 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
g -> (ByteString, Object) -> Maybe (ByteString, Object)
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 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 -> ByteString
nvimMethodName :: ByteString }
  deriving (NvimMethod -> NvimMethod -> Bool
(NvimMethod -> NvimMethod -> Bool)
-> (NvimMethod -> NvimMethod -> Bool) -> Eq NvimMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NvimMethod -> NvimMethod -> Bool
$c/= :: NvimMethod -> NvimMethod -> Bool
== :: NvimMethod -> NvimMethod -> Bool
$c== :: 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
min :: NvimMethod -> NvimMethod -> NvimMethod
$cmin :: NvimMethod -> NvimMethod -> NvimMethod
max :: NvimMethod -> NvimMethod -> NvimMethod
$cmax :: NvimMethod -> NvimMethod -> NvimMethod
>= :: NvimMethod -> NvimMethod -> Bool
$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
compare :: NvimMethod -> NvimMethod -> Ordering
$ccompare :: NvimMethod -> NvimMethod -> Ordering
$cp1Ord :: Eq 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
showList :: [NvimMethod] -> ShowS
$cshowList :: [NvimMethod] -> ShowS
show :: NvimMethod -> String
$cshow :: NvimMethod -> String
showsPrec :: Int -> NvimMethod -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [NvimMethod]
$creadListPrec :: ReadPrec [NvimMethod]
readPrec :: ReadPrec NvimMethod
$creadPrec :: ReadPrec NvimMethod
readList :: ReadS [NvimMethod]
$creadList :: ReadS [NvimMethod]
readsPrec :: Int -> ReadS NvimMethod
$creadsPrec :: Int -> ReadS 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
$cto :: forall x. Rep NvimMethod x -> NvimMethod
$cfrom :: forall x. NvimMethod -> Rep NvimMethod x
Generic)


instance NFData NvimMethod


instance Pretty NvimMethod where
    pretty :: NvimMethod -> Doc ann
pretty (NvimMethod ByteString
n) = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc ann) -> Text -> Doc ann
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 ByteString
n


-- | 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 ByteString
_ FunctionName
n Synchronous
_ AutocmdOptions
_ -> FunctionName
n

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