git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
catches EOF exceptions thrown in acceptCommand
1f8c9edChristoph Hegemann
psc-ide-server/Main.hs+34−21
compare with golang
unifiedsplit
@@ -11,8 +11,9 @@ import Prelude.Compat
11
11
12import Control.Concurrent (forkFinally)
12import Control.Concurrent (forkFinally)
13import Control.Concurrent.STM
13import Control.Concurrent.STM
14−import Control.Exception (bracketOnError)
14+import Control.Exception (bracketOnError, catchJust)
15import Control.Monad
15import Control.Monad
16+import Control.Monad.Error.Class
16import "monad-logger" Control.Monad.Logger
17import "monad-logger" Control.Monad.Logger
17import Control.Monad.Reader
18import Control.Monad.Reader
18import Control.Monad.Trans.Except
19import Control.Monad.Trans.Except
@@ -32,6 +33,7 @@ import Options.Applicative
32import System.Directory
33import System.Directory
33import System.FilePath
34import System.FilePath
34import System.IO
35import System.IO
36+import System.IO.Error (isEOFError)
35
37
36import qualified Paths_purescript as Paths
38import qualified Paths_purescript as Paths
37
39
@@ -101,32 +103,43 @@ startServer port env = withSocketsDo $ do
101
103
102 loop :: (PscIde m, MonadLogger m) => Socket -> m ()
104 loop :: (PscIde m, MonadLogger m) => Socket -> m ()
103 loop sock = do
105 loop sock = do
104− (cmd,h) <- acceptCommand sock
106+ accepted <- runExceptT $ acceptCommand sock
107+ case accepted of
108+ Left err -> $(logDebug) err
109+ Right (cmd, h) -> do
105− case decodeT cmd of
110+ case decodeT cmd of
106− Just cmd' -> do
111+ Just cmd' -> do
107− result <- runExceptT (handleCommand cmd')
112+ result <- runExceptT (handleCommand cmd')
108− $(logDebug) ("Answer was: " <> T.pack (show result))
113+ $(logDebug) ("Answer was: " <> T.pack (show result))
109− liftIO (hFlush stdout)
114+ liftIO (hFlush stdout)
110− case result of
115+ case result of
111− -- What function can I use to clean this up?
116+ -- What function can I use to clean this up?
112− Right r -> liftIO $ T.hPutStrLn h (encodeT r)
117+ Right r -> liftIO $ T.hPutStrLn h (encodeT r)
113− Left err -> liftIO $ T.hPutStrLn h (encodeT err)
118+ Left err -> liftIO $ T.hPutStrLn h (encodeT err)
114− Nothing -> do
119+ Nothing -> do
115− $(logDebug) ("Parsing the command failed. Command: " <> cmd)
120+ $(logDebug) ("Parsing the command failed. Command: " <> cmd)
116− liftIO $ do
121+ liftIO $ do
117− T.hPutStrLn h (encodeT (GeneralError "Error parsing Command."))
122+ T.hPutStrLn h (encodeT (GeneralError "Error parsing Command."))
118− hFlush stdout
123+ hFlush stdout
119− liftIO (hClose h)
124+ liftIO (hClose h)
120
125
121
126
122−acceptCommand :: (Applicative m, MonadIO m, MonadLogger m)
127+acceptCommand :: (Applicative m, MonadIO m, MonadLogger m, MonadError T.Text m)
123 => Socket -> m (T.Text, Handle)
128 => Socket -> m (T.Text, Handle)
124acceptCommand sock = do
129acceptCommand sock = do
125 h <- acceptConnection
130 h <- acceptConnection
126 $(logDebug) "Accepted a connection"
131 $(logDebug) "Accepted a connection"
132+ cmd' <- liftIO (catchJust
133+ -- this means that the connection was
134+ -- terminated without receiving any input
135+ (\e -> if isEOFError e then Just () else Nothing)
127− cmd <- liftIO (T.hGetLine h)
136+ (Just <$> T.hGetLine h)
137+ (const (pure Nothing)))
138+ case cmd' of
139+ Nothing -> throwError "Connection was closed before any input arrived"
140+ Just cmd -> do
128− $(logDebug) cmd
141+ $(logDebug) cmd
129− pure (cmd, h)
142+ pure (cmd, h)
130 where
143 where
131 acceptConnection = liftIO $ do
144 acceptConnection = liftIO $ do
132 (h,_,_) <- accept sock
145 (h,_,_) <- accept sock