diff --git a/System/Console/Haskeline.hs b/System/Console/Haskeline.hs index 058ad8bc..45d02c13 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: @@ -182,13 +184,16 @@ 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 AlwaysAdd -> addHistory IgnoreConsecutive -> addHistoryUnlessConsecutiveDupe IgnoreAll -> addHistoryRemovingAllDupes - in modifyHistory (adder line) + in do + modifyHistory (adder line) + when doFlush flushHistory _ -> return () ---------- diff --git a/System/Console/Haskeline/InputT.hs b/System/Console/Haskeline/InputT.hs index c1ee55ed..2212640e 100644 --- a/System/Console/Haskeline/InputT.hs +++ b/System/Console/Haskeline/InputT.hs @@ -23,10 +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. - - } + } -- | Because 'complete' is the only field of 'Settings' depending on @m@, -- the expression @defaultSettings {completionFunc = f}@ leads to a type error @@ -64,6 +63,17 @@ getHistory = InputT get putHistory :: MonadIO m => History -> InputT m () putHistory = InputT . put +-- | Writes command history to file 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 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)