{-# 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
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
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
Ord, Int -> FunctionName -> ShowS
[FunctionName] -> ShowS
FunctionName -> String
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]
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. 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)
    deriving (FunctionName -> ()
forall a. (a -> ()) -> NFData a
rnf :: FunctionName -> ()
$crnf :: FunctionName -> ()
NFData, forall ann. [FunctionName] -> Doc ann
forall ann. FunctionName -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: forall ann. [FunctionName] -> Doc ann
$cprettyList :: forall ann. [FunctionName] -> Doc ann
pretty :: forall ann. FunctionName -> Doc ann
$cpretty :: forall ann. FunctionName -> Doc ann
Pretty) via Text

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

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

newtype SubscriptionId = SubscriptionId Int64
    deriving (SubscriptionId -> SubscriptionId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubscriptionId -> SubscriptionId -> Bool
$c/= :: SubscriptionId -> SubscriptionId -> Bool
== :: SubscriptionId -> SubscriptionId -> Bool
$c== :: SubscriptionId -> SubscriptionId -> Bool
Eq, Eq 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
min :: SubscriptionId -> SubscriptionId -> SubscriptionId
$cmin :: SubscriptionId -> SubscriptionId -> SubscriptionId
max :: SubscriptionId -> SubscriptionId -> SubscriptionId
$cmax :: SubscriptionId -> SubscriptionId -> SubscriptionId
>= :: SubscriptionId -> SubscriptionId -> Bool
$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
compare :: SubscriptionId -> SubscriptionId -> Ordering
$ccompare :: SubscriptionId -> SubscriptionId -> Ordering
Ord, Int -> SubscriptionId -> ShowS
[SubscriptionId] -> ShowS
SubscriptionId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubscriptionId] -> ShowS
$cshowList :: [SubscriptionId] -> ShowS
show :: SubscriptionId -> String
$cshow :: SubscriptionId -> String
showsPrec :: Int -> SubscriptionId -> ShowS
$cshowsPrec :: Int -> SubscriptionId -> ShowS
Show, ReadPrec [SubscriptionId]
ReadPrec SubscriptionId
Int -> ReadS SubscriptionId
ReadS [SubscriptionId]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SubscriptionId]
$creadListPrec :: ReadPrec [SubscriptionId]
readPrec :: ReadPrec SubscriptionId
$creadPrec :: ReadPrec SubscriptionId
readList :: ReadS [SubscriptionId]
$creadList :: ReadS [SubscriptionId]
readsPrec :: Int -> ReadS SubscriptionId
$creadsPrec :: Int -> ReadS SubscriptionId
Read)
    deriving (Int -> SubscriptionId
SubscriptionId -> Int
SubscriptionId -> [SubscriptionId]
SubscriptionId -> SubscriptionId
SubscriptionId -> SubscriptionId -> [SubscriptionId]
SubscriptionId
-> SubscriptionId -> SubscriptionId -> [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
enumFromThenTo :: SubscriptionId
-> SubscriptionId -> SubscriptionId -> [SubscriptionId]
$cenumFromThenTo :: SubscriptionId
-> SubscriptionId -> SubscriptionId -> [SubscriptionId]
enumFromTo :: SubscriptionId -> SubscriptionId -> [SubscriptionId]
$cenumFromTo :: SubscriptionId -> SubscriptionId -> [SubscriptionId]
enumFromThen :: SubscriptionId -> SubscriptionId -> [SubscriptionId]
$cenumFromThen :: SubscriptionId -> SubscriptionId -> [SubscriptionId]
enumFrom :: SubscriptionId -> [SubscriptionId]
$cenumFrom :: SubscriptionId -> [SubscriptionId]
fromEnum :: SubscriptionId -> Int
$cfromEnum :: SubscriptionId -> Int
toEnum :: Int -> SubscriptionId
$ctoEnum :: Int -> SubscriptionId
pred :: SubscriptionId -> SubscriptionId
$cpred :: SubscriptionId -> SubscriptionId
succ :: SubscriptionId -> SubscriptionId
$csucc :: 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
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]
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
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
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
Ord, 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 :: forall ann. FunctionalityDescription -> Doc ann
pretty = \case
        Function FunctionName
fname Synchronous
s ->
            Doc ann
"Function" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Synchronous
s forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty FunctionName
fname
        Command FunctionName
fname CommandOptions
copts ->
            Doc ann
"Command" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty CommandOptions
copts forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty FunctionName
fname
        Autocmd Text
t FunctionName
fname Synchronous
s AutocmdOptions
aopts ->
            Doc ann
"Autocmd"
                forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Text
t
                forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Synchronous
s
                forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty AutocmdOptions
aopts
                forall ann. Doc ann -> Doc ann -> 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
    = -- | 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
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]
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
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
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
Ord, Int -> Synchronous
Synchronous -> Int
Synchronous -> [Synchronous]
Synchronous -> Synchronous
Synchronous -> Synchronous -> [Synchronous]
Synchronous -> Synchronous -> Synchronous -> [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. 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 :: 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
_ -> 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 -> forall o. NvimObject o => o -> Object
toObject Bool
False
        Synchronous
Sync -> forall o. NvimObject o => o -> Object
toObject Bool
True

    fromObject :: Object -> Either (Doc AnsiStyle) Synchronous
fromObject = \case
        ObjectBool Bool
True -> forall (m :: * -> *) a. Monad m => a -> m a
return Synchronous
Sync
        ObjectBool Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return Synchronous
Async
        ObjectInt Int64
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return Synchronous
Async
        Object
_ -> 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
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
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
Ord, Int -> CommandOption -> ShowS
[CommandOption] -> ShowS
CommandOption -> String
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]
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. 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 :: forall ann. CommandOption -> Doc ann
pretty = \case
        CmdSync Synchronous
s ->
            forall a ann. Pretty a => a -> Doc ann
pretty Synchronous
s
        CommandOption
CmdRegister ->
            Doc ann
"\""
        CmdNargs String
n ->
            forall a ann. Pretty a => a -> Doc ann
pretty String
n
        CmdRange RangeSpecification
rs ->
            forall a ann. Pretty a => a -> Doc ann
pretty RangeSpecification
rs
        CmdCount Word
c ->
            forall a ann. Pretty a => a -> Doc ann
pretty Word
c
        CommandOption
CmdBang ->
            Doc ann
"!"
        CmdComplete String
cs ->
            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 (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ds) Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
ds -> RangeSpecification -> CommandOption
CmdRange (forall a. Read a => String -> a
read String
ds)
        String
ds | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ds) Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
ds -> Word -> CommandOption
CmdCount (forall a. Read a => String -> a
read String
ds)
        String
_ -> 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
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
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
Ord, Int -> CommandOptions -> ShowS
[CommandOptions] -> ShowS
CommandOptions -> String
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]
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. 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 :: forall ann. CommandOptions -> Doc ann
pretty (CommandOptions [CommandOption]
os) =
        forall ann. [Doc ann] -> Doc ann
cat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy CommandOption -> CommandOption -> Bool
constructor forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 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) =
        (forall o. NvimObject o => o -> Object
toObject :: Dictionary -> Object) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ 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 -> forall a. a -> Maybe a
Just (ByteString
"range", forall o. NvimObject o => o -> Object
toObject RangeSpecification
r)
            CmdCount Word
n -> forall a. a -> Maybe a
Just (ByteString
"count", forall o. NvimObject o => o -> Object
toObject Word
n)
            CommandOption
CmdBang -> forall a. a -> Maybe a
Just (ByteString
"bang", ByteString -> Object
ObjectBinary ByteString
"")
            CommandOption
CmdRegister -> forall a. a -> Maybe a
Just (ByteString
"register", ByteString -> Object
ObjectBinary ByteString
"")
            CmdNargs String
n -> forall a. a -> Maybe a
Just (ByteString
"nargs", forall o. NvimObject o => o -> Object
toObject String
n)
            CmdComplete String
cs -> forall a. a -> Maybe a
Just (ByteString
"complete", forall o. NvimObject o => o -> Object
toObject String
cs)
            CommandOption
_ -> forall a. Maybe a
Nothing

    fromObject :: Object -> Either (Doc AnsiStyle) CommandOptions
fromObject Object
o =
        forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
            Doc AnsiStyle
"Did not expect to receive a CommandOptions object:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> 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
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
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
Ord, Int -> RangeSpecification -> ShowS
[RangeSpecification] -> ShowS
RangeSpecification -> String
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]
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. 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 :: forall ann. RangeSpecification -> Doc ann
pretty = \case
        RangeSpecification
CurrentLine ->
            forall a. Monoid a => a
mempty
        RangeSpecification
WholeFile ->
            Doc ann
"%"
        RangeCount Int
c ->
            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 -> forall o. NvimObject o => o -> Object
toObject Int
n

    fromObject :: Object -> Either (Doc AnsiStyle) RangeSpecification
fromObject Object
o =
        forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
            Doc AnsiStyle
"Did not expect to receive a RangeSpecification object:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> 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
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
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
Ord, Int -> CommandArguments -> ShowS
[CommandArguments] -> ShowS
CommandArguments -> String
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]
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. 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 :: forall ann. 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
..} =
        forall ann. [Doc ann] -> Doc ann
cat forall a b. (a -> b) -> a -> b
$
            forall a. [Maybe a] -> [a]
catMaybes
                [ (\Bool
b -> if Bool
b then Doc ann
"!" else forall a. Monoid a => a
mempty) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
bang
                , ( \(Int
s, Int
e) ->
                        forall ann. Doc ann
lparen forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Int
s forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
comma
                            forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Int
e forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
rparen
                  )
                    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Int, Int)
range
                , forall a ann. Pretty a => a -> Doc ann
pretty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
count
                , forall a ann. Pretty a => a -> Doc ann
pretty 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 = forall a. Maybe a
Nothing
            , range :: Maybe (Int, Int)
range = forall a. Maybe a
Nothing
            , count :: Maybe Int
count = forall a. Maybe a
Nothing
            , register :: Maybe String
register = 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
..} =
        (forall o. NvimObject o => o -> Object
toObject :: Dictionary -> Object)
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes
            forall a b. (a -> b) -> a -> b
$ [ Maybe Bool
bang forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b -> forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
"bang", forall o. NvimObject o => o -> Object
toObject Bool
b)
              , Maybe (Int, Int)
range forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Int, Int)
r -> forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
"range", forall o. NvimObject o => o -> Object
toObject (Int, Int)
r)
              , Maybe Int
count forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
c -> forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
"count", forall o. NvimObject o => o -> Object
toObject Int
c)
              , Maybe String
register forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
r -> forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
"register", 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 = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject (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 <- forall {b}.
NvimObject b =>
ByteString -> Either (Doc AnsiStyle) (Maybe b)
l ByteString
"bang"
        Maybe (Int, Int)
range <- forall {b}.
NvimObject b =>
ByteString -> Either (Doc AnsiStyle) (Maybe b)
l ByteString
"range"
        Maybe Int
count <- forall {b}.
NvimObject b =>
ByteString -> Either (Doc AnsiStyle) (Maybe b)
l ByteString
"count"
        Maybe String
register <- forall {b}.
NvimObject b =>
ByteString -> Either (Doc AnsiStyle) (Maybe b)
l ByteString
"register"
        forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Default a => a
def
    fromObject Object
o =
        forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
            Doc AnsiStyle
"Expected a map for CommandArguments object, but got: "
                forall ann. Doc ann -> Doc ann -> Doc ann
<+> 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
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]
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
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
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
Ord, 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 :: forall ann. 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
..} =
        forall a ann. Pretty a => a -> Doc ann
pretty String
acmdPattern
            forall ann. Doc ann -> Doc ann -> Doc ann
<+> if Bool
acmdNested
                then Doc ann
"nested"
                else
                    Doc ann
"unnested"
                        forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (\String
g -> forall a. Monoid a => a
mempty forall ann. Doc ann -> Doc ann -> 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 = 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
..} =
        (forall o. NvimObject o => o -> Object
toObject :: Dictionary -> Object) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$
            [ (ByteString
"pattern", forall o. NvimObject o => o -> Object
toObject String
acmdPattern)
            , (ByteString
"nested", forall o. NvimObject o => o -> Object
toObject Bool
acmdNested)
            ]
                forall a. [a] -> [a] -> [a]
++ forall a. [Maybe a] -> [a]
catMaybes
                    [ Maybe String
acmdGroup forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
g -> forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
"group", forall o. NvimObject o => o -> Object
toObject String
g)
                    ]
    fromObject :: Object -> Either (Doc AnsiStyle) AutocmdOptions
fromObject Object
o =
        forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
            Doc AnsiStyle
"Did not expect to receive an AutocmdOptions object: " forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Show a => a -> Doc ann
viaShow Object
o

newtype NvimMethod = NvimMethod {NvimMethod -> Text
nvimMethodName :: Text}
    deriving (NvimMethod -> NvimMethod -> Bool
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
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
Ord, Int -> NvimMethod -> ShowS
[NvimMethod] -> ShowS
NvimMethod -> String
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]
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. 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)
    deriving (forall ann. [NvimMethod] -> Doc ann
forall ann. NvimMethod -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: forall ann. [NvimMethod] -> Doc ann
$cprettyList :: forall ann. [NvimMethod] -> Doc ann
pretty :: forall ann. NvimMethod -> Doc ann
$cpretty :: forall ann. NvimMethod -> Doc ann
Pretty, NvimMethod -> ()
forall a. (a -> ()) -> NFData a
rnf :: NvimMethod -> ()
$crnf :: 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 forall a b. (a -> b) -> a -> b
$ Text
n forall a. Semigroup a => a -> a -> a
<> Text
":function"
        Command (F Text
n) CommandOptions
_ -> Text -> NvimMethod
NvimMethod forall a b. (a -> b) -> a -> b
$ Text
n forall a. Semigroup a => a -> a -> a
<> Text
":command"
        Autocmd Text
_ (F Text
n) Synchronous
_ AutocmdOptions
_ -> Text -> NvimMethod
NvimMethod Text
n