From f619613a17fb554a88e11b4f089c54a023e059bc Mon Sep 17 00:00:00 2001
From: "judah.jacobson" <judah.jacobson@gmail.com>
Date: Fri, 12 Dec 2008 06:49:22 +0000
Subject: [PATCH] Add module System.Console.Haskeline.History.
---
System/Console/Haskeline.hs | 4 +-
System/Console/Haskeline/Command/History.hs | 31 ++-------
System/Console/Haskeline/History.hs | 72 +++++++++++++++++++++
System/Console/Haskeline/InputT.hs | 11 +++-
haskeline.cabal | 1 +
5 files changed, 88 insertions(+), 31 deletions(-)
create mode 100644 System/Console/Haskeline/History.hs
diff --git a/System/Console/Haskeline.hs b/System/Console/Haskeline.hs
index 393395c..7e66b31 100644
--- a/System/Console/Haskeline.hs
+++ b/System/Console/Haskeline.hs
@@ -59,10 +59,10 @@ module System.Console.Haskeline(
import System.Console.Haskeline.LineState
import System.Console.Haskeline.Command
-import System.Console.Haskeline.Command.History
import System.Console.Haskeline.Vi
import System.Console.Haskeline.Emacs
import System.Console.Haskeline.Prefs
+import System.Console.Haskeline.History
import System.Console.Haskeline.Monads
import System.Console.Haskeline.MonadException
import System.Console.Haskeline.InputT
@@ -154,7 +154,7 @@ getInputCmdLine tops prefix = do
repeatTillFinish tops getEvent prefix ls emode
-- Add the line to the history if it's nonempty.
case result of
- Just line | not (all isSpace line) -> addHistory line
+ Just line | not (all isSpace line) -> modify (addHistory line)
_ -> return ()
return result
diff --git a/System/Console/Haskeline/Command/History.hs b/System/Console/Haskeline/Command/History.hs
index 7fc9f10..9442485 100644
--- a/System/Console/Haskeline/Command/History.hs
+++ b/System/Console/Haskeline/Command/History.hs
@@ -7,13 +7,7 @@ import Control.Monad(liftM,mplus)
import System.Console.Haskeline.Monads
import Data.List
import Data.Maybe(fromMaybe)
-import Control.Exception.Extensible(evaluate)
-import qualified Data.ByteString as B
-import qualified Data.ByteString.UTF8 as UTF8
-
-import System.Directory(doesFileExist)
-
-data History = History {historyLines :: [String]} -- stored in reverse
+import System.Console.Haskeline.History
data HistLog = HistLog {pastHistory, futureHistory :: [String]}
deriving Show
@@ -32,28 +26,13 @@ histLog :: History -> HistLog
histLog hist = HistLog {pastHistory = historyLines hist, futureHistory = []}
runHistoryFromFile :: MonadIO m => Maybe FilePath -> Maybe Int -> StateT History m a -> m a
-runHistoryFromFile Nothing _ f = evalStateT' (History []) f
+runHistoryFromFile Nothing _ f = evalStateT' emptyHistory f
runHistoryFromFile (Just file) stifleAmt f = do
- contents <- liftIO $ do
- exists <- doesFileExist file
- if exists
- -- use binary file I/O to avoid Windows CRLF line endings
- -- which cause confusion when switching between systems.
- then fmap UTF8.toString (B.readFile file)
- else return ""
- liftIO $ evaluate (length contents) -- force file closed
- let oldHistory = History (lines contents)
- (x,newHistory) <- runStateT f oldHistory
- let stifle = case stifleAmt of
- Nothing -> id
- Just m -> take m
- liftIO $ B.writeFile file $ UTF8.fromString
- $ unlines $ stifle $ historyLines newHistory
+ oldHistory <- liftIO $ readHistory file
+ (x,newHistory) <- runStateT f (stifleHistory stifleAmt oldHistory)
+ liftIO $ writeHistory file newHistory
return x
-addHistory :: MonadState History m => String -> m ()
-addHistory l = modify $ \(History ls) -> History (l:ls)
-
runHistLog :: Monad m => StateT HistLog m a -> StateT History m a
runHistLog f = do
history <- get
diff --git a/System/Console/Haskeline/History.hs b/System/Console/Haskeline/History.hs
new file mode 100644
index 0000000..0214df6
--- /dev/null
+++ b/System/Console/Haskeline/History.hs
@@ -0,0 +1,72 @@
+module System.Console.Haskeline.History(
+ History(),
+ emptyHistory,
+ addHistory,
+ historyLines,
+ readHistory,
+ writeHistory,
+ stifleHistory
+ ) where
+
+import qualified Data.Sequence as Seq
+import Data.Foldable
+
+import qualified Data.ByteString as B
+import qualified Data.ByteString.UTF8 as UTF8
+import Control.Exception.Extensible(evaluate)
+
+import System.Directory(doesFileExist)
+
+data History = History {histLines :: Seq.Seq String,
+ stifleAmount :: Maybe Int}
+ -- stored in reverse
+
+instance Show History where
+ show = show . histLines
+
+emptyHistory :: History
+emptyHistory = History Seq.empty Nothing
+
+historyLines :: History -> [String]
+historyLines = toList . histLines
+
+-- TODO: am I doing the right thing, error-handling-wise?
+-- should probably just silently catch all errors.
+
+-- | Reads the line input history from the given file. Returns
+-- 'emptyHistory' if the file does not exist.
+readHistory :: FilePath -> IO History
+readHistory file = do
+ exists <- doesFileExist file
+ contents <- if exists
+ -- use binary file I/O to avoid Windows CRLF line endings
+ -- which cause confusion when switching between systems.
+ then fmap UTF8.toString (B.readFile file)
+ else return ""
+ evaluate (length contents) -- force file closed
+ return $ History {histLines = Seq.fromList $ lines contents,
+ stifleAmount = Nothing}
+
+-- | Writes the line history to the given file. If there is an
+-- error when writing the file, ignores it.
+writeHistory :: FilePath -> History -> IO ()
+writeHistory file = B.writeFile file . UTF8.fromString
+ . unlines . historyLines
+
+stifleHistory :: Maybe Int -> History -> History
+stifleHistory Nothing hist = hist {stifleAmount = Nothing}
+stifleHistory a@(Just n) hist = History {histLines = stifleFnc (histLines hist),
+ stifleAmount = a}
+ where
+ stifleFnc = if n > Seq.length (histLines hist)
+ then id
+ else Seq.fromList . take n . toList
+
+addHistory :: String -> History -> History
+addHistory s h = h {histLines = s Seq.<| stifledLines}
+ where
+ stifledLines = if maybe True (> Seq.length (histLines h)) (stifleAmount h)
+ then histLines h
+ else case Seq.viewr (histLines h) of
+ Seq.EmptyR -> histLines h -- shouldn't ever happen
+ ls Seq.:> _ -> ls
diff --git a/System/Console/Haskeline/InputT.hs b/System/Console/Haskeline/InputT.hs
index f516d4c..bdaa121 100644
--- a/System/Console/Haskeline/InputT.hs
+++ b/System/Console/Haskeline/InputT.hs
@@ -1,6 +1,7 @@
module System.Console.Haskeline.InputT where
+import System.Console.Haskeline.History
import System.Console.Haskeline.Command.History
import System.Console.Haskeline.Command.Undo
import System.Console.Haskeline.Monads as Monads
@@ -12,7 +13,7 @@ import System.Console.Haskeline.Term
import System.Directory(getHomeDirectory)
import System.FilePath
import Control.Applicative
-import Control.Monad(liftM, ap)
+import qualified Control.Monad.State as State
-- | Application-specific customizations to the user interface.
data Settings m = Settings {complete :: CompletionFunc m, -- ^ Custom tab completion
@@ -38,11 +39,11 @@ newtype InputT m a = InputT {unInputT :: ReaderT RunTerm
MonadReader RunTerm)
instance Monad m => Functor (InputT m) where
- fmap = liftM
+ fmap = State.liftM
instance Monad m => Applicative (InputT m) where
pure = return
- (<*>) = ap
+ (<*>) = State.ap
instance MonadTrans InputT where
lift = InputT . lift . lift . lift . lift
@@ -52,6 +53,10 @@ instance MonadException m => MonadException (InputT m) where
unblock = InputT . unblock . unInputT
catch f h = InputT $ Monads.catch (unInputT f) (unInputT . h)
+instance Monad m => State.MonadState History (InputT m) where
+ get = get
+ put = put
+
-- for internal use only
type InputCmdT m = ReaderT Layout (UndoT (StateT HistLog
(ReaderT Prefs (ReaderT (Settings m) m))))
diff --git a/haskeline.cabal b/haskeline.cabal
index 8f2d3cb..a0c2b29 100644
--- a/haskeline.cabal
+++ b/haskeline.cabal
@@ -44,6 +44,7 @@ Library
System.Console.Haskeline
System.Console.Haskeline.Completion
System.Console.Haskeline.MonadException
+ System.Console.Haskeline.History
System.Console.Haskeline.IO
Other-Modules:
System.Console.Haskeline.Backend
--
GitLab