summaryrefslogtreecommitdiff
path: root/Pancake.hs
diff options
context:
space:
mode:
authordefanor <defanor@uberspace.net>2017-11-02 16:30:05 +0300
committerdefanor <defanor@uberspace.net>2017-11-02 16:30:05 +0300
commitdf79c998b82f4f2aa372128e2aa9fbf175f7a917 (patch)
tree4cb9ac529ea167c1f446e6ab95788b35e689ee5c /Pancake.hs
parentb02d13d7084ad93d1432b6106ea9031b763a761a (diff)
Quit on EOF
Diffstat (limited to 'Pancake.hs')
-rw-r--r--Pancake.hs43
1 files changed, 24 insertions, 19 deletions
diff --git a/Pancake.hs b/Pancake.hs
index 20e8c43..6c845d5 100644
--- a/Pancake.hs
+++ b/Pancake.hs
@@ -43,6 +43,7 @@ import qualified System.IO as SIO
import Data.Char
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8')
+import System.IO.Error
-- | Prints a line into stderr.
@@ -811,26 +812,30 @@ command Quit = liftIO $ do
-- | Reads commands, runs them.
eventLoop :: MonadIO m => StateT LoopState m ()
eventLoop = do
- cmd <- liftIO $ getLine
+ cmd' <- liftIO $ try getLine
+ let onErr e = unless (isEOFError e)
+ (putErrLn ("Unexpected error: " ++ show e))
+ >> pure Quit
st <- get
- let c = case cmd of
- "q" -> Quit
- "b" -> Back
- "f" -> Forward
- "r" -> Reload
- "re" -> ReloadConfig
- "h" -> Help
- "?" -> ShowCurrent
- _ -> case reads cmd of
- [(n, "")] -> Follow n
- [(n, "?")] -> Show n
- _ -> case words cmd of
- [] -> More
- (s:q) -> case M.lookup s (shortcuts (conf st)) of
- Just u -> Shortcut u $ unwords q
- Nothing -> case parseURIReference cmd of
- Just uri -> GoTo uri
- Nothing -> Help
+ c <- flip (either onErr) cmd' $ \cmd -> pure $
+ case cmd of
+ "q" -> Quit
+ "b" -> Back
+ "f" -> Forward
+ "r" -> Reload
+ "re" -> ReloadConfig
+ "h" -> Help
+ "?" -> ShowCurrent
+ _ -> case reads cmd of
+ [(n, "")] -> Follow n
+ [(n, "?")] -> Show n
+ _ -> case words cmd of
+ [] -> More
+ (s:q) -> case M.lookup s (shortcuts (conf st)) of
+ Just u -> Shortcut u $ unwords q
+ Nothing -> case parseURIReference cmd of
+ Just uri -> GoTo uri
+ Nothing -> Help
command c
when (c /= Quit) eventLoop