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 +++++++++------------------
 README             |  2 +-
 deb/DEBIAN/control |  1 -
 pancake.cabal      |  1 +
 4 files changed, 11 insertions(+), 20 deletions(-)

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
diff --git a/README b/README
index 9cfa437..76e58d6 100644
--- a/README
+++ b/README
@@ -11,7 +11,7 @@ configuration.
 
 User interaction capabilities are rather basic, as it is intended to
 be combined with software that provides better user interfaces – such
-as emacs, rlwrap, tmux, screen.
+as emacs, tmux, screen.
 
 
 Installation
diff --git a/deb/DEBIAN/control b/deb/DEBIAN/control
index ee79b07..66bce91 100644
--- a/deb/DEBIAN/control
+++ b/deb/DEBIAN/control
@@ -12,4 +12,3 @@ Priority: extra
 Homepage: https://defanor.uberspace.net/projects/pancake/
 Depends: libtinfo5, zlib1g, libc6, libgmp10, libffi6
 Recommends: curl
-Suggests: rlwrap
diff --git a/pancake.cabal b/pancake.cabal
index c6ad6fb..425bb50 100644
--- a/pancake.cabal
+++ b/pancake.cabal
@@ -63,6 +63,7 @@ executable pancake
                      , text >= 1.2.2.2 && < 2
                      , unix >= 2.7.2.0 && < 3
                      , yaml >= 0.8.23.3 && < 1
+                     , haskeline >= 0.7 && < 1
   -- hs-source-dirs:
   default-language:    Haskell2010
   ghc-options:         -Wall
-- 
cgit v1.2.3