From 76bcedccbdc862bdaf5379d0278fd503e3c598e2 Mon Sep 17 00:00:00 2001 From: Nikita Kartashov Date: Tue, 2 Feb 2016 13:09:29 +0300 Subject: [PATCH 1/2] Support flushing command history Previously command history was only flushed after the end of session, this commit adds flushHistory function which performs the flushing and a flag to enforce flushing after every command. --- System/Console/Haskeline.hs | 10 ++++++++-- System/Console/Haskeline/InputT.hs | 15 ++++++++++++++- 2 files changed, 22 insertions(+), 3 deletions(-) diff --git a/System/Console/Haskeline.hs b/System/Console/Haskeline.hs index 058ad8bc..c9a03380 100644 --- a/System/Console/Haskeline.hs +++ b/System/Console/Haskeline.hs @@ -67,6 +67,7 @@ module System.Console.Haskeline( getHistory, putHistory, modifyHistory, + flushHistory, -- * Ctrl-C handling withInterrupt, Interrupt(..), @@ -92,6 +93,7 @@ import System.Console.Haskeline.RunCommand import System.IO import Data.Char (isSpace, isPrint) +import Control.Monad (when) -- | A useful default. In particular: @@ -106,7 +108,8 @@ import Data.Char (isSpace, isPrint) defaultSettings :: MonadIO m => Settings m defaultSettings = Settings {complete = completeFilename, historyFile = Nothing, - autoAddHistory = True} + autoAddHistory = True, + flushEveryCommand = False} {- $outputfncs The following functions enable cross-platform output of text that may contain @@ -188,7 +191,10 @@ maybeAddHistory result = do AlwaysAdd -> addHistory IgnoreConsecutive -> addHistoryUnlessConsecutiveDupe IgnoreAll -> addHistoryRemovingAllDupes - in modifyHistory (adder line) + in do + modifyHistory (adder line) + when (flushEveryCommand settings) + flushHistory _ -> return () ---------- diff --git a/System/Console/Haskeline/InputT.hs b/System/Console/Haskeline/InputT.hs index c1ee55ed..a3ad7508 100644 --- a/System/Console/Haskeline/InputT.hs +++ b/System/Console/Haskeline/InputT.hs @@ -23,8 +23,10 @@ data Settings m = Settings {complete :: CompletionFunc m, -- ^ Custom tab comple historyFile :: Maybe FilePath, -- ^ Where to read/write the history at the -- start and end of each -- line input session. - autoAddHistory :: Bool -- ^ If 'True', each nonblank line returned by + autoAddHistory :: Bool, -- ^ If 'True', each nonblank line returned by -- @getInputLine@ will be automatically added to the history. + flushEveryCommand :: Bool -- ^ If 'True' and @historyFile@ not 'Nothing' + -- flushed command history after every command } @@ -64,6 +66,17 @@ getHistory = InputT get putHistory :: MonadIO m => History -> InputT m () putHistory = InputT . put +-- | Flush history if @historyFile@ is not 'Nothing' +flushHistory :: forall m . MonadIO m => InputT m () +flushHistory = do + settings :: Settings m <- InputT ask + getHistory >>= maybeFlushHistory (historyFile settings) + +-- | Flushes history if given filepath is not 'Nothing' +maybeFlushHistory :: MonadIO m => Maybe FilePath -> History -> InputT m () +maybeFlushHistory Nothing _ = return () +maybeFlushHistory (Just f) hist = liftIO $ writeHistory f hist + -- | Change the current line input history. modifyHistory :: MonadIO m => (History -> History) -> InputT m () modifyHistory = InputT . modify From 44a26bc2a5fa696d9f6c2fe88fdfa09322ad18fb Mon Sep 17 00:00:00 2001 From: Nikita Kartashov Date: Tue, 2 Feb 2016 13:09:29 +0300 Subject: [PATCH 2/2] Support flushing command history Previously command history was only flushed after the end of session, this commit adds flushHistory function which performs the flushing and a flag to Prefs to enforce flushing after every command. --- System/Console/Haskeline.hs | 7 +++---- System/Console/Haskeline/InputT.hs | 9 +++------ System/Console/Haskeline/Prefs.hs | 10 +++++++--- 3 files changed, 13 insertions(+), 13 deletions(-) diff --git a/System/Console/Haskeline.hs b/System/Console/Haskeline.hs index c9a03380..45d02c13 100644 --- a/System/Console/Haskeline.hs +++ b/System/Console/Haskeline.hs @@ -108,8 +108,7 @@ import Control.Monad (when) defaultSettings :: MonadIO m => Settings m defaultSettings = Settings {complete = completeFilename, historyFile = Nothing, - autoAddHistory = True, - flushEveryCommand = False} + autoAddHistory = True} {- $outputfncs The following functions enable cross-platform output of text that may contain @@ -185,6 +184,7 @@ maybeAddHistory :: forall m . MonadIO m => Maybe String -> InputT m () maybeAddHistory result = do settings :: Settings m <- InputT ask histDupes <- InputT $ asks historyDuplicates + doFlush <- InputT $ asks flushEveryCommand case result of Just line | autoAddHistory settings && not (all isSpace line) -> let adder = case histDupes of @@ -193,8 +193,7 @@ maybeAddHistory result = do IgnoreAll -> addHistoryRemovingAllDupes in do modifyHistory (adder line) - when (flushEveryCommand settings) - flushHistory + when doFlush flushHistory _ -> return () ---------- diff --git a/System/Console/Haskeline/InputT.hs b/System/Console/Haskeline/InputT.hs index a3ad7508..2212640e 100644 --- a/System/Console/Haskeline/InputT.hs +++ b/System/Console/Haskeline/InputT.hs @@ -23,12 +23,9 @@ data Settings m = Settings {complete :: CompletionFunc m, -- ^ Custom tab comple historyFile :: Maybe FilePath, -- ^ Where to read/write the history at the -- start and end of each -- line input session. - autoAddHistory :: Bool, -- ^ If 'True', each nonblank line returned by + autoAddHistory :: Bool -- ^ If 'True', each nonblank line returned by -- @getInputLine@ will be automatically added to the history. - flushEveryCommand :: Bool -- ^ If 'True' and @historyFile@ not 'Nothing' - -- flushed command history after every command - - } + } -- | Because 'complete' is the only field of 'Settings' depending on @m@, -- the expression @defaultSettings {completionFunc = f}@ leads to a type error @@ -66,7 +63,7 @@ getHistory = InputT get putHistory :: MonadIO m => History -> InputT m () putHistory = InputT . put --- | Flush history if @historyFile@ is not 'Nothing' +-- | Writes command history to file if 'historyFile' is not 'Nothing' flushHistory :: forall m . MonadIO m => InputT m () flushHistory = do settings :: Settings m <- InputT ask diff --git a/System/Console/Haskeline/Prefs.hs b/System/Console/Haskeline/Prefs.hs index 6d511be7..5397c829 100644 --- a/System/Console/Haskeline/Prefs.hs +++ b/System/Console/Haskeline/Prefs.hs @@ -47,7 +47,10 @@ data Prefs = Prefs { bellStyle :: !BellStyle, -- presses @TAB@ again. customBindings :: Map.Map Key [Key], -- (termName, keysequence, key) - customKeySequences :: [(Maybe String, String,Key)] + customKeySequences :: [(Maybe String, String,Key)], + flushEveryCommand :: Bool + -- ^ If 'True' and @historyFile@ not 'Nothing' + -- flushes command history after every command } deriving Show @@ -76,8 +79,9 @@ defaultPrefs = Prefs {bellStyle = AudibleBell, listCompletionsImmediately = True, historyDuplicates = AlwaysAdd, customBindings = Map.empty, - customKeySequences = [] - } + customKeySequences = [], + flushEveryCommand = False + } mkSettor :: Read a => (a -> Prefs -> Prefs) -> String -> Prefs -> Prefs mkSettor f str = maybe id f (readMaybe str)