{-# LANGUAGE RankNTypes #-}
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.Time
import Network.Socket as N hiding (SocketType)
import System.Environment (getEnv)
import System.IO (BufferMode (..), Handle, IOMode(ReadWriteMode),
hClose, hSetBuffering)
import System.Log.Logger
import Prelude
data RPCConfig = RPCConfig
{ recipients :: TVar (Map Int64 (UTCTime, TMVar (Either Object Object)))
, nextMessageId :: TVar Int64
}
newRPCConfig :: (Applicative io, MonadIO io) => io RPCConfig
newRPCConfig = RPCConfig
<$> liftIO (newTVarIO mempty)
<*> liftIO (newTVarIO 1)
data SocketType = Stdout Handle
| Environment
| UnixSocket FilePath
| TCP Int String
createHandle :: (Functor io, MonadIO io)
=> SocketType
-> io Handle
createHandle = \case
Stdout h -> do
liftIO $ hSetBuffering h (BlockBuffering Nothing)
return h
UnixSocket f ->
createHandle . Stdout =<< createUnixSocketHandle f
TCP p h ->
createHandle . Stdout =<< createTCPSocketHandle p h
Environment ->
createHandle . Stdout =<< createSocketHandleFromEnvironment
where
createUnixSocketHandle :: (MonadIO io) => FilePath -> io Handle
createUnixSocketHandle f =
liftIO $ getSocketUnix f >>= flip socketToHandle ReadWriteMode
createTCPSocketHandle :: (MonadIO io) => Int -> String -> io Handle
createTCPSocketHandle p h = liftIO $ getSocketTCP (fromString h) p
>>= flip socketToHandle ReadWriteMode . fst
createSocketHandleFromEnvironment = do
listenAddress <- liftIO (getEnv "NVIM_LISTEN_ADDRESS")
case words listenAddress of
[unixSocket] -> createHandle (UnixSocket unixSocket)
[h,p] -> createHandle (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."