{-# LANGUAGE TemplateHaskell #-}

{- |
Module      :  Neovim.Ghcid
Description :  Ghcid plugin
Copyright   :  (c) Sebastian Witte
License     :  Apache-2.0

Maintainer  :  woozletoff@gmail.com
Stability   :  experimental
Portability :  GHC
-}
module Neovim.Ghcid where

import Neovim
import Neovim.API.String

import Neovim.Ghcid.Plugin

plugin :: Neovim () NeovimPlugin
plugin :: Neovim () NeovimPlugin
plugin = do
    ()
_ <- [Char] -> forall env. Neovim env ()
vim_command [Char]
"sign define GhcidWarn text=>> texthl=Search"
    ()
_ <- [Char] -> forall env. Neovim env ()
vim_command [Char]
"sign define GhcidErr text=!! texthl=ErrorMsg"
    GhcidEnv
env <- forall (m :: * -> *). MonadIO m => m GhcidEnv
initGhcidEnv
    forall (m :: * -> *) env.
Applicative m =>
Plugin env -> m NeovimPlugin
wrapPlugin
        Plugin
            { environment :: GhcidEnv
environment = GhcidEnv
env
            , exports :: [ExportedFunctionality GhcidEnv]
exports =
                [ $(command' 'ghcidStart) [CommandOption
"async", CommandOption
"!"]
                , $(command' 'ghcidStop) [CommandOption
"async"]
                , $(command' 'ghcidRestart) [CommandOption
"async"]
                ]
            }