@@ -11,8 +11,9 @@ import Prelude.Compat
1111
1212import Control.Concurrent (forkFinally)
1313import Control.Concurrent.STM
14−import Control.Exception (bracketOnError)
14+import Control.Exception (bracketOnError, catchJust)
1515import Control.Monad
16+import Control.Monad.Error.Class
1617import "monad-logger" Control.Monad.Logger
1718import Control.Monad.Reader
1819import Control.Monad.Trans.Except
@@ -32,6 +33,7 @@ import Options.Applicative
3233import System.Directory
3334import System.FilePath
3435import System.IO
36+import System.IO.Error (isEOFError)
3537
3638import qualified Paths_purescript as Paths
3739
@@ -101,32 +103,43 @@ startServer port env = withSocketsDo $ do
101103
102104 loop :: (PscIde m, MonadLogger m) => Socket -> m ()
103105 loop sock = do
104− (cmd,h) <- acceptCommand sock
105− case decodeT cmd of
106− Just cmd' -> do
107− result <- runExceptT (handleCommand cmd')
108− $(logDebug) ("Answer was: " <> T.pack (show result))
109− liftIO (hFlush stdout)
110− case result of
111− -- What function can I use to clean this up?
112− Right r -> liftIO $ T.hPutStrLn h (encodeT r)
113− Left err -> liftIO $ T.hPutStrLn h (encodeT err)
114− Nothing -> do
115− $(logDebug) ("Parsing the command failed. Command: " <> cmd)
116− liftIO $ do
117− T.hPutStrLn h (encodeT (GeneralError "Error parsing Command."))
118− hFlush stdout
119− liftIO (hClose h)
106+ accepted <- runExceptT $ acceptCommand sock
107+ case accepted of
108+ Left err -> $(logDebug) err
109+ Right (cmd, h) -> do
110+ case decodeT cmd of
111+ Just cmd' -> do
112+ result <- runExceptT (handleCommand cmd')
113+ $(logDebug) ("Answer was: " <> T.pack (show result))
114+ liftIO (hFlush stdout)
115+ case result of
116+ -- What function can I use to clean this up?
117+ Right r -> liftIO $ T.hPutStrLn h (encodeT r)
118+ Left err -> liftIO $ T.hPutStrLn h (encodeT err)
119+ Nothing -> do
120+ $(logDebug) ("Parsing the command failed. Command: " <> cmd)
121+ liftIO $ do
122+ T.hPutStrLn h (encodeT (GeneralError "Error parsing Command."))
123+ hFlush stdout
124+ liftIO (hClose h)
120125
121126
122−acceptCommand :: (Applicative m, MonadIO m, MonadLogger m)
127+acceptCommand :: (Applicative m, MonadIO m, MonadLogger m, MonadError T.Text m)
123128 => Socket -> m (T.Text, Handle)
124129acceptCommand sock = do
125130 h <- acceptConnection
126131 $(logDebug) "Accepted a connection"
127− cmd <- liftIO (T.hGetLine h)
128− $(logDebug) cmd
129− pure (cmd, h)
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)
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
141+ $(logDebug) cmd
142+ pure (cmd, h)
130143 where
131144 acceptConnection = liftIO $ do
132145 (h,_,_) <- accept sock