module Neovim.Plugin.Classes (
FunctionalityDescription(..),
FunctionName(..),
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.ByteString.UTF8 (toString)
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 Text.PrettyPrint.ANSI.Leijen hiding ((<$>))
import Prelude hiding (sequence)
newtype FunctionName = F ByteString
deriving (Eq, Ord, Show, Read, Generic)
instance NFData FunctionName
instance Pretty FunctionName where
pretty (F n) = blue . text $ toString n
data FunctionalityDescription
= Function FunctionName Synchronous
| Command FunctionName CommandOptions
| Autocmd ByteString FunctionName AutocmdOptions
deriving (Show, Read, Eq, Ord, Generic)
instance NFData FunctionalityDescription
instance Pretty FunctionalityDescription where
pretty = \case
Function fname s ->
text "Function" <+> pretty s <+> pretty fname
Command fname copts ->
text "Command" <+> pretty copts <+> pretty fname
Autocmd t fname aopts ->
text "Autocmd" <+> (text . toString) t
<+> pretty aopts
<+> pretty fname
data Synchronous
= Async
| Sync
deriving (Show, Read, Eq, Ord, Enum, Generic)
instance NFData Synchronous
instance Pretty Synchronous where
pretty = \case
Async -> red $ text "async"
Sync -> blue $ text "sync"
instance IsString Synchronous where
fromString = \case
"sync" -> Sync
"async" -> Async
_ -> error "Only \"sync\" and \"async\" are valid string representations"
instance NvimObject Synchronous where
toObject = \case
Async -> toObject False
Sync -> toObject True
fromObject = \case
ObjectBool True -> return Sync
ObjectBool False -> return Async
ObjectInt 0 -> return Async
_ -> return Sync
data CommandOption = CmdSync Synchronous
| CmdRegister
| CmdNargs String
| CmdRange RangeSpecification
| CmdCount Word
| CmdBang
deriving (Eq, Ord, Show, Read, Generic)
instance NFData CommandOption
instance Pretty CommandOption where
pretty = \case
CmdSync s ->
pretty s
CmdRegister ->
text "\""
CmdNargs n ->
text n
CmdRange rs ->
pretty rs
CmdCount c ->
text (show c)
CmdBang ->
text "!"
instance IsString CommandOption where
fromString = \case
"%" -> CmdRange WholeFile
"\"" -> CmdRegister
"!" -> CmdBang
"sync" -> CmdSync Sync
"async" -> CmdSync Async
"," -> CmdRange CurrentLine
',':ds | not (null ds) && all isDigit ds -> CmdRange (read ds)
ds | not (null ds) && all isDigit ds -> CmdCount (read ds)
_ -> error "Not a valid string for a CommandOptions. Check the docs!"
newtype CommandOptions = CommandOptions { getCommandOptions :: [CommandOption] }
deriving (Eq, Ord, Show, Read, Generic)
instance NFData CommandOptions
instance Pretty CommandOptions where
pretty (CommandOptions os) =
cat $ map pretty os
mkCommandOptions :: [CommandOption] -> CommandOptions
mkCommandOptions = CommandOptions . map head . groupBy constructor . sort
where
constructor a b = case (a,b) of
_ | a == b -> True
(CmdSync _, CmdSync _) -> True
(CmdRange _, CmdRange _) -> True
(CmdRange _, CmdCount _) -> True
(CmdNargs _, CmdNargs _) -> True
_ -> False
instance NvimObject CommandOptions where
toObject (CommandOptions opts) =
(toObject :: Dictionary -> Object) . Map.fromList $ mapMaybe addOption opts
where
addOption = \case
CmdRange r -> Just ("range" , toObject r)
CmdCount n -> Just ("count" , toObject n)
CmdBang -> Just ("bang" , ObjectBinary "")
CmdRegister -> Just ("register", ObjectBinary "")
CmdNargs n -> Just ("nargs" , toObject n)
_ -> Nothing
fromObject o = throwError . text $
"Did not expect to receive a CommandOptions object: " ++ show o
data RangeSpecification
= CurrentLine
| WholeFile
| RangeCount Int
deriving (Eq, Ord, Show, Read, Generic)
instance NFData RangeSpecification
instance Pretty RangeSpecification where
pretty = \case
CurrentLine ->
empty
WholeFile ->
text "%"
RangeCount c ->
text $ show c
instance NvimObject RangeSpecification where
toObject = \case
CurrentLine -> ObjectBinary ""
WholeFile -> ObjectBinary "%"
RangeCount n -> toObject n
data CommandArguments = CommandArguments
{ bang :: Maybe Bool
, range :: Maybe (Int, Int)
, count :: Maybe Int
, register :: Maybe String
}
deriving (Eq, Ord, Show, Read, Generic)
instance NFData CommandArguments
instance Pretty CommandArguments where
pretty CommandArguments{..} =
cat $ catMaybes
[ (\b -> if b then (text "!") else empty) <$> bang
, (\(s,e) -> lparen <> (text . show) s <> comma
<+> (text . show) e <> rparen)
<$> range
, (text . show) <$> count
, (text . show) <$> register
]
instance Default CommandArguments where
def = CommandArguments
{ bang = Nothing
, range = Nothing
, count = Nothing
, register = Nothing
}
instance NvimObject CommandArguments where
toObject CommandArguments{..} = (toObject :: Dictionary -> Object)
. Map.fromList . catMaybes $
[ bang >>= \b -> return ("bang", toObject b)
, range >>= \r -> return ("range", toObject r)
, count >>= \c -> return ("count", toObject c)
, register >>= \r -> return ("register", toObject r)
]
fromObject (ObjectMap m) = do
let l key = sequence (fromObject <$> Map.lookup (ObjectBinary key) m)
bang <- l "bang"
range <- l "range"
count <- l "count"
register <- l "register"
return CommandArguments{..}
fromObject ObjectNil = return def
fromObject o =
throwError . text $ "Expected a map for CommandArguments object, but got: " ++ show o
data AutocmdOptions = AutocmdOptions
{ acmdPattern :: String
, acmdNested :: Bool
, acmdGroup :: Maybe String
}
deriving (Show, Read, Eq, Ord, Generic)
instance NFData AutocmdOptions
instance Pretty AutocmdOptions where
pretty AutocmdOptions{..} =
text acmdPattern
<+> text (if acmdNested then "nested" else "unnested")
<> maybe empty (\g -> empty <+> text g) acmdGroup
instance Default AutocmdOptions where
def = AutocmdOptions
{ acmdPattern = "*"
, acmdNested = False
, acmdGroup = Nothing
}
instance NvimObject AutocmdOptions where
toObject (AutocmdOptions{..}) =
(toObject :: Dictionary -> Object) . Map.fromList $
[ ("pattern", toObject acmdPattern)
, ("nested", toObject acmdNested)
] ++ catMaybes
[ acmdGroup >>= \g -> return ("group", toObject g)
]
fromObject o = throwError . text $
"Did not expect to receive an AutocmdOptions object: " ++ show o
class HasFunctionName a where
name :: a -> FunctionName
instance HasFunctionName FunctionalityDescription where
name = \case
Function n _ -> n
Command n _ -> n
Autocmd _ n _ -> n