HaRe-0.6: refactorer/EditorCommands.hs
module EditorCommands where
import MT(MT(..))
import System(system,getArgs)
import IO(hPutStrLn
,hGetLine
,hClose
,hSetBuffering
,BufferMode(..)
,IOMode(..)
,Handle
,stdin
,stderr)
import Control.OldException as Exception
import Foreign
import Foreign.C
import Network hiding (listenOn,connectTo,accept)
import Network.BSD(getProtocolNumber
,getHostByName
,getHostByAddr
,hostAddress
,HostEntry(..))
import Network.Socket(Family(..)
,SocketType(..)
,SockAddr(..)
,SocketOption(..)
,socket
,sClose
,setSocketOption
,bindSocket
,listen
,connect
,socketToHandle
,iNADDR_ANY
,maxListenQueue
,inet_ntoa
,recv
,send
)
import qualified Network.Socket as Socket(accept)
data EditorCmds = EditorCmds
{ getEditorCmd :: IO String
, sendEditorMsg :: Bool -> String -> IO () -- False: just log,
-- True: make visible
, sendEditorModified :: String -> IO ()
}
-- default, useful for testing
commandlineCmds =
EditorCmds{getEditorCmd={- hSetBuffering stdin LineBuffering >> -} getLine
,sendEditorModified= \f->hPutStrLn stderr $ "modified: "++f
,sendEditorMsg= \d m-> if d then hPutStrLn stderr $ "message: "++m
else hPutStrLn stderr m}
-- refactorer is asynchronous subprocess of emacs,
-- which controls refactorers stdin and stdout;
-- seems to be relatively portable; emacs side will
-- need to interpret backchannel as editor-commands
emacsCmds =
EditorCmds{getEditorCmd=getLine
,sendEditorModified= \f->hPutStrLn stderr $ "modified: "++f
,sendEditorMsg= \d m-> if d then hPutStrLn stderr $ "message: "++m
else hPutStrLn stderr m}
-- refactorer is independent process started from vim;
-- we listen on socket for commands from vim (via refactoring
-- client), and answer with direct editor-commands, using
-- vim's clientserver functionality
mkVimCmds vimPath vimServerName = lift $ withSocketsDo $ do
s <- listenOn $ PortNumber 9000
return EditorCmds{
getEditorCmd=getInput s
,sendEditorModified= \f-> do
let cmd = vim_remote $
"call Haskell_refac_modified("++squote f++")"
hPutStrLn stderr cmd
system cmd
return ()
,sendEditorMsg= \b s-> do
let dialog = if b then "1" else "0"
cmd = vim_remote $
"call Haskell_refac_msg("++dialog++","++dquote s++")"
hPutStrLn stderr cmd
system cmd
return ()
}
where
-- which vim to call?? the caller will tell us,
-- but in case it's a gvim, we need to avoid pop-up dialogs
vim_remote cmd = vimPath++" --servername "++vimServerName
++" --remote-send \":silent "++cmd++" | silent redraw <cr>\""
squote s = "'"++concatMap del_quotes s++"'" -- no quotes or special chars in single quotes..:-((
dquote s = "'"++concatMap del_quotes s++"'" -- vim remote in win98 reads any " as comment start:-(
del_quotes c | c `elem` "'\"" = " "
| c == '\n' = "\\n"
| otherwise = [c]
getInput s = do
(h,host,portnr) <- accept s
hSetBuffering h LineBuffering
l <- hGetLine h
hPutStrLn h "<ack>"
putStrLn $ "SERVER: '"++l++"'"
-- hClose h
return l
clientCmd :: IO ()
clientCmd = withSocketsDo $ do
args <- getArgs
h <- connectTo "localhost" $ PortNumber 9000
hSetBuffering h LineBuffering
hPutStrLn stderr $ "(stderr) CLIENT SEND: "++unwords args
putStrLn $ "(stdout) CLIENT SEND: "++unwords args
hPutStrLn h $ unwords args
hGetLine h -- wait for acknowledgement
return ()
-- | Creates the server side socket which has been bound to the
-- specified port.
--
-- NOTE: To avoid the \"Address already in use\"
-- problems popped up several times on the GHC-Users mailing list we
-- set the 'ReuseAddr' socket option on the listening socket. If you
-- don't want this behaviour, please use the lower level
-- 'Network.Socket.listen' instead.
{-
foreign import stdcall unsafe "WSAGetLastError"
c_getLastError :: IO CInt
foreign import ccall unsafe "getWSErrorDescr"
c_getWSError :: CInt -> IO (Ptr CChar)
-}
listenOn :: PortID -- ^ Port Identifier
-> IO Socket -- ^ Connected Socket
listenOn (PortNumber port) = do
-- proto <- getProtocolNumber "tcp"
-- putStrLn $ "tcp: "++show proto
let proto = 6 -- bug in ghc's getProtocolNumber..
EditorCommands.bracketOnError
(Exception.catch (socket AF_INET Stream proto)
(\e-> do
-- errCode <- c_getLastError
-- perr <- c_getWSError errCode
-- err <- peekCString perr
-- putStrLn $ "WSAGetLastError: "++show errCode
throw e))
(sClose)
(\sock -> do
setSocketOption sock ReuseAddr 1
bindSocket sock (SockAddrInet port iNADDR_ANY)
listen sock maxListenQueue
return sock
)
bracketOnError
:: IO a -- ^ computation to run first (\"acquire resource\")
-> (a -> IO b) -- ^ computation to run last (\"release resource\")
-> (a -> IO c) -- ^ computation to run in-between
-> IO c -- returns the value from the in-between computation
bracketOnError before after thing =
block (do
a <- before
r <- Exception.catch
(unblock (thing a))
(\e -> do { after a; throw e })
return r
)
-- | Calling 'connectTo' creates a client side socket which is
-- connected to the given host and port. The Protocol and socket type is
-- derived from the given port identifier. If a port number is given
-- then the result is always an internet family 'Stream' socket.
connectTo :: HostName -- Hostname
-> PortID -- Port Identifier
-> IO Handle -- Connected Socket
connectTo hostname (PortNumber port) = do
-- proto <- getProtocolNumber "tcp"
-- putStrLn $ "tcp: "++show proto
let proto = 6 -- bug in ghc's getProtocolNumber..
EditorCommands.bracketOnError
(Exception.catch (socket AF_INET Stream proto)
(\e-> do
-- errCode <- c_getLastError
-- putStrLn $ "WSAGetLastError: "++show errCode
throw e))
(sClose) -- only done if there's an error
(\sock -> do
he <- getHostByName hostname
connect sock (SockAddrInet port (hostAddress he))
socketToHandle sock ReadWriteMode
)
-- -----------------------------------------------------------------------------
-- accept
-- | Accept a connection on a socket created by 'listenOn'. Normal
-- I\/O opertaions (see "System.IO") can be used on the 'Handle'
-- returned to communicate with the client.
-- Notice that although you can pass any Socket to Network.accept, only
-- sockets of either AF_UNIX or AF_INET will work (this shouldn't be a problem,
-- though). When using AF_UNIX, HostName will be set to the path of the socket
-- and PortNumber to -1.
--
accept :: Socket -- ^ Listening Socket
-> IO (Handle, -- Socket, -- should be: Handle,
HostName,
PortNumber) -- ^ Triple of: read\/write 'Handle' for
-- communicating with the client,
-- the 'HostName' of the peer socket, and
-- the 'PortNumber' of the remote connection.
accept sock {- @(MkSocket _ AF_INET _ _ _) -} = do
~(sock', (SockAddrInet port haddr)) <- Socket.accept sock
peer <- Exception.catchJust ioErrors
(do
(HostEntry peer _ _ _) <- getHostByAddr AF_INET haddr
return peer
)
(\e -> inet_ntoa haddr)
-- if getHostByName fails, we fall back to the IP address
-- return (sock', peer, port)
handle <- socketToHandle sock' ReadWriteMode
return (handle, peer, port)