From f2b4e89f6a78ee0ee933612955b8d36c985c9e70 Mon Sep 17 00:00:00 2001
From: defanor <defanor@uberspace.net>
Date: Tue, 26 Dec 2017 06:07:57 +0300
Subject: Use Haskeline

The code is slightly cleaner with it, and it would be useful for
completion.
---
 Pancake.hs | 27 +++++++++------------------
 1 file changed, 9 insertions(+), 18 deletions(-)

(limited to 'Pancake.hs')

diff --git a/Pancake.hs b/Pancake.hs
index a5988f8..a29f921 100644
--- a/Pancake.hs
+++ b/Pancake.hs
@@ -47,13 +47,11 @@ import System.Directory
 import System.Exit
 import Control.Exception
 import Data.Char
-import System.IO.Error
 import Control.Applicative
 import Data.Version
 import System.Console.GetOpt
-import System.Posix.Signals
-import Control.Concurrent
 import Text.Regex.TDFA
+import qualified System.Console.Haskeline as HL
 
 import Pancake.Common
 import Pancake.Configuration
@@ -86,7 +84,7 @@ data LoopState = LS { history :: Sliding HistoryEntry
                     }
 
 -- | Main event loop's type.
-type Pancake a = forall m. MonadIO m => StateT LoopState m a
+type Pancake a = forall m. HL.MonadException m => StateT LoopState (HL.InputT m) a
 
 -- | Renders a parsed document.
 printDoc :: URI -> P.Pandoc -> Pancake ()
@@ -376,20 +374,13 @@ command Redisplay = do
 eventLoop :: Pancake ()
 eventLoop = do
   st <- get
-  c <- liftIO $ catches (parseCommand (conf st) <$> getLine)
-       [Handler handleIO, Handler handleAsync]
+  c <- lift $ HL.handleInterrupt (pure Interrupt) $
+    maybe Quit (parseCommand (conf st))
+    <$> HL.withInterrupt (HL.getInputLine "")
   unless (c == Interrupt && interrupted st) $ do
     command c
     modify $ \s -> s { interrupted = c == Interrupt }
     when (c /= Quit) eventLoop
-  where
-    handleIO :: IOException -> IO Command
-    handleIO e = unless (isEOFError e)
-                 (putErrLn ("Unexpected error: " ++ show e))
-                 >> pure Quit
-    handleAsync :: AsyncException -> IO Command
-    handleAsync UserInterrupt = pure Interrupt
-    handleAsync other = throw other
 
 -- | Command-line options.
 data Option = OVersion
@@ -416,9 +407,6 @@ options = [ Option [] ["version"] (NoArg OVersion)
 main :: IO ()
 main = do
   args <- getArgs
-  -- A hack to receive SIGINT reliably.
-  tid <- myThreadId
-  _ <- installHandler sigINT (Catch (throwTo tid UserInterrupt)) Nothing
   let (opts, cmd, errors) = getOpt Permute options args
       run
         | OVersion `elem` opts = putStrLn $ "pancake " ++ showVersion version
@@ -433,7 +421,10 @@ main = do
                   then pure ()
                   else get
                        >>= \st -> command (parseCommand (conf st) (unwords cmd))
-            _ <- runStateT
+            dir <- getXdgDirectory XdgConfig "pancake"
+            let hfn = dir </> "command_history"
+            _ <- HL.runInputT HL.defaultSettings {HL.historyFile = Just hfn} $
+                 runStateT
                  (updateConfig (findConf opts) >> maybeCommand >> eventLoop)
                  LS { history = ([],[])
                     , position = 0
-- 
cgit v1.2.3