{-# LANGUAGE ExistentialQuantification #-}

{- |
Module      :  Neovim.Plugin.Internal
Description :  Split module that can import Neovim.Context without creating import circles
Copyright   :  (c) Sebastian Witte
License     :  Apache-2.0

Maintainer  :  woozletoff@gmail.com
Stability   :  experimental
Portability :  GHC
-}
module Neovim.Plugin.Internal (
    ExportedFunctionality (..),
    getFunction,
    getDescription,
    NeovimPlugin (..),
    Plugin (..),
    wrapPlugin,
) where

import Neovim.Context (Neovim)
import Neovim.Plugin.Classes (
    FunctionalityDescription,
    HasFunctionName (..),
 )

import Data.MessagePack (Object)

{- | This data type is used in the plugin registration to properly register the
 functions.
-}
newtype ExportedFunctionality env
    = EF (FunctionalityDescription, [Object] -> Neovim env Object)

-- | Extract the description of an 'ExportedFunctionality'.
getDescription :: ExportedFunctionality env -> FunctionalityDescription
getDescription :: forall env. ExportedFunctionality env -> FunctionalityDescription
getDescription (EF (FunctionalityDescription
d, [Object] -> Neovim env Object
_)) = FunctionalityDescription
d

-- | Extract the function of an 'ExportedFunctionality'.
getFunction :: ExportedFunctionality env -> [Object] -> Neovim env Object
getFunction :: forall env.
ExportedFunctionality env -> [Object] -> Neovim env Object
getFunction (EF (FunctionalityDescription
_, [Object] -> Neovim env Object
f)) = [Object] -> Neovim env Object
f

instance HasFunctionName (ExportedFunctionality env) where
    name :: ExportedFunctionality env -> FunctionName
name = forall a. HasFunctionName a => a -> FunctionName
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall env. ExportedFunctionality env -> FunctionalityDescription
getDescription
    nvimMethod :: ExportedFunctionality env -> NvimMethod
nvimMethod = forall a. HasFunctionName a => a -> NvimMethod
nvimMethod forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall env. ExportedFunctionality env -> FunctionalityDescription
getDescription

-- | This data type contains meta information for the plugin manager.
data Plugin env = Plugin
    { forall env. Plugin env -> env
environment :: env
    , forall env. Plugin env -> [ExportedFunctionality env]
exports :: [ExportedFunctionality env]
    }

{- | 'Plugin' values are wraped inside this data type via 'wrapPlugin' so that
 we can put plugins in an ordinary list.
-}
data NeovimPlugin = forall env. NeovimPlugin (Plugin env)

{- | Wrap a 'Plugin' in some nice blankets, so that we can put them in a simple
 list.
-}
wrapPlugin :: Applicative m => Plugin env -> m NeovimPlugin
wrapPlugin :: forall (m :: * -> *) env.
Applicative m =>
Plugin env -> m NeovimPlugin
wrapPlugin = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall env. Plugin env -> NeovimPlugin
NeovimPlugin