module Neovim.Plugin.Classes (
ExportedFunctionality(..),
getFunction,
getDescription,
FunctionalityDescription(..),
FunctionName(..),
NeovimPlugin(..),
Plugin(..),
wrapPlugin,
Synchronous(..),
CommandOption(..),
RangeSpecification(..),
CommandArguments(..),
getCommandOptions,
mkCommandOptions,
AutocmdOptions(..),
) where
import Neovim.Classes
import Neovim.Context
import Control.Applicative ((<$>))
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.Text (Text)
import Data.Traversable (sequence)
import Prelude hiding (sequence)
newtype ExportedFunctionality r st
= EF (FunctionalityDescription, [Object] -> Neovim r st Object)
getDescription :: ExportedFunctionality r st -> FunctionalityDescription
getDescription (EF (d,_)) = d
getFunction :: ExportedFunctionality r st -> [Object] -> Neovim r st Object
getFunction (EF (_, f)) = f
data FunctionalityDescription
= Function Text Synchronous
| Command Text CommandOptions
| Autocmd Text Text AutocmdOptions
deriving (Show, Read, Eq, Ord)
data Synchronous
= Async
| Sync
deriving (Show, Read, Eq, Ord, Enum)
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 Int
| CmdBang
deriving (Eq, Ord, Show, Read)
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)
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 $
"Did not expect to receive a CommandOptions object: " ++ show o
data RangeSpecification = CurrentLine
| WholeFile
| RangeCount Int
deriving (Eq, Ord, Show, Read)
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)
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 $ "Expected a map for CommandArguments object, but got: " ++ show o
data AutocmdOptions = AutocmdOptions
{ acmdSync :: Synchronous
, acmdPattern :: String
, acmdNested :: Bool
}
deriving (Show, Read, Eq, Ord)
instance Default AutocmdOptions where
def = AutocmdOptions
{ acmdSync = Sync
, acmdPattern = "*"
, acmdNested = False
}
instance NvimObject AutocmdOptions where
toObject (AutocmdOptions{..}) =
(toObject :: Dictionary -> Object) . Map.fromList $
[ ("pattern", toObject acmdPattern)
, ("nested", toObject acmdNested)
]
fromObject o = throwError $
"Did not expect to receive an AutocmdOptions object: " ++ show o
class FunctionName a where
name :: a -> Text
instance FunctionName FunctionalityDescription where
name = \case
Function n _ -> n
Command n _ -> n
Autocmd _ n _ -> n
instance FunctionName (ExportedFunctionality r st) where
name = name . getDescription
data Plugin r st = Plugin
{ exports :: [ExportedFunctionality () ()]
, statefulExports :: [(r, st, [ExportedFunctionality r st])]
}
data NeovimPlugin = forall r st. NeovimPlugin (Plugin r st)
wrapPlugin :: Monad m => Plugin r st -> m NeovimPlugin
wrapPlugin = return . NeovimPlugin