content: {-# LANGUAGE GADTs #-}
  {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE OverloadedStrings #-}
  
  {- |
  Module      :  Neovim.Plugin
  Description :  Plugin and functionality registration code
  Copyright   :  (c) Sebastian Witte
  License     :  Apache-2.0
  
  Maintainer  :  woozletoff@gmail.com
  Stability   :  experimental
  Portability :  GHC
  -}
  module Neovim.Plugin (
      startPluginThreads,
      wrapPlugin,
      NeovimPlugin,
      Plugin (..),
      Synchronous (..),
      CommandOption (..),
      addAutocmd,
      registerPlugin,
      registerFunctionality,
      getProviderName,
  ) where
  
  import Neovim.API.String
      ( nvim_err_writeln, nvim_get_api_info, vim_call_function )
  import Neovim.Classes
      ( (<+>),
        Doc,
        AnsiStyle,
        Pretty(pretty),
        NvimObject(toObject, fromObject),
        Dictionary,
        (+:) )
  import Neovim.Context
      ( MonadIO(liftIO),
        NeovimException,
        newUniqueFunctionName,
        runNeovim,
        FunctionMapEntry,
        Neovim,
        err )
  import Neovim.Context.Internal (
      FunctionType (..),
      runNeovimInternal,
   )
  import qualified Neovim.Context.Internal as Internal
  import Neovim.Plugin.Classes
      ( HasFunctionName(nvimMethod),
        FunctionName(..),
        NeovimEventId(NeovimEventId),
        Synchronous(..),
        CommandOption(..),
        CommandOptions(getCommandOptions),
        AutocmdOptions(AutocmdOptions),
        FunctionalityDescription(..),
        NvimMethod(..) )
  import Neovim.Plugin.IPC.Classes
      ( Notification(Notification),
        Request(Request),
        Message(fromMessage),
        SomeMessage,
        readSomeMessage )
  import Neovim.Plugin.Internal
      ( NeovimPlugin(..),
        Plugin(..),
        getDescription,
        getFunction,
        wrapPlugin )
  import Neovim.RPC.FunctionCall ( respond )
  
  import Control.Monad (foldM, void)
  import Data.Foldable (forM_)
  import Data.Map (Map)
  import qualified Data.Map as Map
  import Data.Either (rights)
  import Data.MessagePack ( Object )
  import Data.Text (Text)
  import Data.Traversable (forM)
  import System.Log.Logger ( debugM, errorM )
  import UnliftIO.Async (Async, async, race)
  import UnliftIO.Concurrent (threadDelay)
  import UnliftIO.Exception (SomeException, catch, try)
  import UnliftIO.STM
      ( TVar,
        putTMVar,
        takeTMVar,
        tryReadTMVar,
        modifyTVar,
        TQueue,
        atomically,
        newTQueueIO,
        newTVarIO,
        readTVarIO )
  
  import Prelude
  
  logger :: String
  logger = "Neovim.Plugin"
  
  startPluginThreads ::
      Internal.Config () ->
      [Neovim () NeovimPlugin] ->
      IO (Either (Doc AnsiStyle) ([FunctionMapEntry], [Async ()]))
  startPluginThreads cfg = runNeovimInternal return cfg . foldM go ([], [])
    where
      go ::
          ([FunctionMapEntry], [Async ()]) ->
          Neovim () NeovimPlugin ->
          Neovim () ([FunctionMapEntry], [Async ()])
      go (es, tids) iop = do
          NeovimPlugin p <- iop
          (es', tid) <- registerStatefulFunctionality p
  
          return (es ++ es', tid : tids)
  
  {- | Call the vimL functions to define a function, command or autocmd on the
   neovim side. Returns 'True' if registration was successful.
  
   Note that this does not have any effect on the side of /nvim-hs/.
  -}
  registerWithNeovim :: FunctionalityDescription -> Neovim anyEnv Bool
  registerWithNeovim = \case
      func@(Function (F functionName) s) -> do
          pName <- getProviderName
          let (defineFunction, host) =
                  either
                      (\n -> ("remote#define#FunctionOnHost", toObject n))
                      (\c -> ("remote#define#FunctionOnChannel", toObject c))
                      pName
              reportError (e :: NeovimException) = do
                  liftIO . errorM logger $
                      "Failed to register function: " ++ show functionName ++ show e
                  return False
              logSuccess = do
                  liftIO . debugM logger $
                      "Registered function: " ++ show functionName
                  return True
  
          flip catch reportError $ do
              void $
                  vim_call_function defineFunction $
                      host +: nvimMethodName (nvimMethod func) +: s +: functionName +: (Map.empty :: Dictionary) +: []
              logSuccess
      cmd@(Command (F functionName) copts) -> do
          let sync = case getCommandOptions copts of
                  -- This works because CommandOptions are sorted and CmdSync is
                  -- the smallest element in the sorting
                  (CmdSync s : _) -> s
                  _ -> Sync
  
          pName <- getProviderName
          let (defineFunction, host) =
                  either
                      (\n -> ("remote#define#CommandOnHost", toObject n))
                      (\c -> ("remote#define#CommandOnChannel", toObject c))
                      pName
              reportError (e :: NeovimException) = do
                  liftIO . errorM logger $
                      "Failed to register command: " ++ show functionName ++ show e
                  return False
              logSuccess = do
                  liftIO . debugM logger $
                      "Registered command: " ++ show functionName
                  return True
          flip catch reportError $ do
              void $
                  vim_call_function defineFunction $
                      host +: nvimMethodName (nvimMethod cmd) +: sync +: functionName +: copts +: []
              logSuccess
      Autocmd acmdType (F functionName) sync opts -> do
          pName <- getProviderName
          let (defineFunction, host) =
                  either
                      (\n -> ("remote#define#AutocmdOnHost", toObject n))
                      (\c -> ("remote#define#AutocmdOnChannel", toObject c))
                      pName
              reportError (e :: NeovimException) = do
                  liftIO . errorM logger $
                      "Failed to register autocmd: " ++ show functionName ++ show e
                  return False
              logSuccess = do
                  liftIO . debugM logger $
                      "Registered autocmd: " ++ show functionName
                  return True
          flip catch reportError $ do
              void $
                  vim_call_function defineFunction $
                      host +: functionName +: sync +: acmdType +: opts +: []
              logSuccess
  
  {- | Return or retrive the provider name that the current instance is associated
   with on the neovim side.
  -}
  getProviderName :: Neovim env (Either String Int)
  getProviderName = do
      mp <- Internal.asks' Internal.providerName
      (liftIO . atomically . tryReadTMVar) mp >>= \case
          Just p ->
              return p
          Nothing -> do
              api <- nvim_get_api_info
              case api of
                  [] -> err "empty nvim_get_api_info"
                  (i : _) -> do
                      case fromObject i :: Either (Doc AnsiStyle) Int of
                          Left _ ->
                              err $
                                  "Expected an integral value as the first"
                                      <+> "argument of nvim_get_api_info"
                          Right channelId -> do
                              liftIO . atomically . putTMVar mp . Right $ fromIntegral channelId
                              return . Right $ fromIntegral channelId
  
  registerFunctionality ::
      FunctionalityDescription ->
      ([Object] -> Neovim env Object) ->
      Neovim env (Either (Doc AnsiStyle) FunctionMapEntry)
  registerFunctionality d f = do
      Internal.asks' Internal.pluginSettings >>= \case
          Nothing -> do
              let msg = "Cannot register functionality in this context."
              liftIO $ errorM logger msg
              return $ Left $ pretty msg
          Just (Internal.StatefulSettings reg q m) ->
              reg d f q m >>= \case
                  Just e -> do
                      pure $ Right e
                  Nothing ->
                      pure $ Left ""
  
  registerInGlobalFunctionMap :: FunctionMapEntry -> Neovim env ()
  registerInGlobalFunctionMap e = do
      liftIO . debugM logger $ "Adding function to global function map." ++ show (fst e)
      funMap <- Internal.asks' Internal.globalFunctionMap
      liftIO . atomically $ do
          m <- takeTMVar funMap
          putTMVar funMap $ Map.insert ((nvimMethod . fst) e) e m
      liftIO . debugM logger $ "Added function to global function map." ++ show (fst e)
  
  registerPlugin ::
      (FunctionMapEntry -> Neovim env ()) ->
      FunctionalityDescription ->
      ([Object] -> Neovim env Object) ->
      TQueue SomeMessage ->
      TVar (Map NvimMethod ([Object] -> Neovim env Object)) ->
      Neovim env (Maybe FunctionMapEntry)
  registerPlugin reg d f q tm =
      registerWithNeovim d >>= \case
          True -> do
              let n = nvimMethod d
                  e = (d, Stateful q)
              liftIO . atomically . modifyTVar tm $ Map.insert n f
              reg e
              return (Just e)
          False ->
              return Nothing
  
  {- | Register an autocmd in the current context. This means that, if you are
   currently in a stateful plugin, the function will be called in the current
   thread and has access to the configuration and state of this thread. .
  
   Note that the function you pass must be fully applied.
  -}
  addAutocmd ::
      -- | The event to register to (e.g. BufWritePost)
      Text ->
      Synchronous ->
      AutocmdOptions ->
      -- | Fully applied function to register
      Neovim env () ->
      -- | A 'ReleaseKey' if the registration worked
      Neovim env (Either (Doc AnsiStyle) FunctionMapEntry)
  addAutocmd event s opts@AutocmdOptions{} f = do
      n <- newUniqueFunctionName
      registerFunctionality (Autocmd event n s opts) (\_ -> toObject <$> f)
  
  {- | Create a listening thread for events and add update the 'FunctionMap' with
   the corresponding 'TQueue's (i.e. communication channels).
  -}
  registerStatefulFunctionality ::
      Plugin env ->
      Neovim anyEnv ([FunctionMapEntry], Async ())
  registerStatefulFunctionality (Plugin{environment = env, exports = fs}) = do
      messageQueue <- liftIO newTQueueIO
      route <- liftIO $ newTVarIO Map.empty
      subscribers <- liftIO $ newTVarIO []
  
      cfg <- Internal.ask'
  
      let startupConfig =
              cfg
                  { Internal.customConfig = env
                  , Internal.pluginSettings =
                      Just $
                          Internal.StatefulSettings
                              (registerPlugin (\_ -> return ()))
                              messageQueue
                              route
                  }
      res <- liftIO . runNeovimInternal return startupConfig . forM fs $ \f ->
          registerFunctionality (getDescription f) (getFunction f)
      es <- case res of
          Left e -> err e
          Right a -> return $ rights a
  
      let pluginThreadConfig =
              cfg
                  { Internal.customConfig = env
                  , Internal.pluginSettings =
                      Just $
                          Internal.StatefulSettings
                              (registerPlugin registerInGlobalFunctionMap)
                              messageQueue
                              route
                  }
  
      tid <- liftIO . async . void . runNeovim pluginThreadConfig $ do
          listeningThread messageQueue route subscribers
  
      return (es, tid) -- NB: dropping release functions/keys here
    where
      executeFunction ::
          ([Object] -> Neovim env Object) ->
          [Object] ->
          Neovim env (Either String Object)
      executeFunction f args =
          try (f args) >>= \case
              Left e -> return . Left $ show (e :: SomeException)
              Right res -> return $ Right res
  
      killAfterSeconds :: Word -> Neovim anyEnv ()
      killAfterSeconds seconds = threadDelay (fromIntegral seconds * 1000 * 1000)
  
      timeoutAndLog :: Word -> FunctionName -> Neovim anyEnv String
      timeoutAndLog seconds functionName = do
          killAfterSeconds seconds
          return . show $
              pretty functionName <+> "has been aborted after"
                  <+> pretty seconds
                  <+> "seconds"
  
      listeningThread ::
          TQueue SomeMessage ->
          TVar (Map NvimMethod ([Object] -> Neovim env Object)) ->
          TVar [Notification -> Neovim env ()] ->
          Neovim env ()
      listeningThread q route subscribers = do
          msg <- readSomeMessage q
  
          forM_ (fromMessage msg) $ \req@(Request fun@(F methodName) _ args) -> do
              let method = NvimMethod methodName
              route' <- liftIO $ readTVarIO route
              forM_ (Map.lookup method route') $ \f -> do
                  respond req . either Left id
                      =<< race
                          (timeoutAndLog 10 fun)
                          (executeFunction f args)
  
          forM_ (fromMessage msg) $ \notification@(Notification (NeovimEventId methodName) args) -> do
              let method = NvimMethod methodName
              route' <- liftIO $ readTVarIO route
              forM_ (Map.lookup method route') $ \f ->
                  void . async $ do
                      result <- either Left id <$> race
                          (timeoutAndLog 600 (F methodName))
                          (executeFunction f args)
                      case result of
                        Left message ->
                            nvim_err_writeln message
                        Right _ ->
                            return ()
  
              subscribers' <- liftIO $ readTVarIO subscribers
              forM_ subscribers' $ \subscriber ->
                  async $ void $ race (subscriber notification) (killAfterSeconds 10)
  
          listeningThread q route subscribers
  