module Neovim.RPC.Common
where
import Neovim.Context
import Control.Applicative
import Control.Concurrent.STM
import Control.Monad
import Data.Int (Int64)
import Data.Map
import Data.MessagePack
import Data.Monoid
import Data.Streaming.Network
import Data.String
import Data.Text (Text)
import Data.Time
import Neovim.Plugin.IPC
import Network.Socket as N hiding (SocketType)
import System.Environment (getEnv)
import System.IO (BufferMode (..), Handle, IOMode,
hClose, hSetBuffering)
import System.Log.Logger
import Prelude
type FunctionMap =
Map Text FunctionType
data FunctionType
= Stateless ([Object] -> Neovim' Object)
| Stateful (TQueue SomeMessage)
data RPCConfig = RPCConfig
{ recipients :: TVar (Map Int64 (UTCTime, TMVar (Either Object Object)))
, functions :: TMVar FunctionMap
}
newRPCConfig :: (Applicative io, MonadIO io) => io RPCConfig
newRPCConfig = RPCConfig
<$> liftIO (newTVarIO mempty)
<*> liftIO newEmptyTMVarIO
data SocketType = Stdout Handle
| Environment
| UnixSocket FilePath
| TCP Int String
createHandle :: (Functor io, MonadIO io)
=> IOMode
-> SocketType
-> io Handle
createHandle ioMode socketType = case socketType of
Stdout h -> do
liftIO $ hSetBuffering h (BlockBuffering Nothing)
return h
UnixSocket f -> createHandle ioMode . Stdout
=<< createUnixSocketHandle f
TCP p h -> createHandle ioMode . Stdout
=<< createTCPSocketHandle p h
Environment -> createHandle ioMode . Stdout
=<< createSocketHandleFromEnvironment
where
createUnixSocketHandle :: (MonadIO io) => FilePath -> io Handle
createUnixSocketHandle f =
liftIO $ getSocketUnix f >>= flip socketToHandle ioMode
createTCPSocketHandle :: (Functor io, MonadIO io) => Int -> String -> io Handle
createTCPSocketHandle p h = liftIO $ getSocketTCP (fromString h) p
>>= flip socketToHandle ioMode . fst
createSocketHandleFromEnvironment = do
listenAddress <- liftIO (getEnv "NVIM_LISTEN_ADDRESS")
case words listenAddress of
[unixSocket] -> createHandle ioMode (UnixSocket unixSocket)
[h,p] -> createHandle ioMode (TCP (read p) h)
_ -> do
let errMsg = unlines
[ "Unhandled socket type from environment variable: "
, "\t" <> listenAddress
]
liftIO $ errorM "createHandle" errMsg
error errMsg
cleanUpHandle :: (MonadIO io) => Handle -> Bool -> io ()
cleanUpHandle h completed = liftIO $ do
hClose h
unless completed $
warningM "cleanUpHandle" "Cleanup called on uncompleted handle."