Commit 263b22d6 authored by Judah Jacobson's avatar Judah Jacobson
Browse files

temp

parent eef0e9c8
......@@ -187,13 +187,15 @@ maybeAddHistory :: forall m . MonadIO m => Maybe String -> InputT m ()
maybeAddHistory result = do
settings :: Settings m <- InputT ask
histDupes <- InputT $ asks historyDuplicates
histSave <- InputT $ asks historySave
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 case histSave of
WriteAtEnd -> modifyHistory (adder line)
_ -> return ()
----------
......
......@@ -3,7 +3,8 @@ module System.Console.Haskeline.Command.History where
import System.Console.Haskeline.LineState
import System.Console.Haskeline.Command
import System.Console.Haskeline.Key
import Control.Monad(liftM,mplus)
import System.Console.Haskeline.Prefs (HistorySave(..))
import Control.Monad(liftM,mplus, void)
import System.Console.Haskeline.Monads
import Data.List
import Data.Maybe(fromMaybe)
......@@ -28,12 +29,18 @@ histLog :: History -> HistLog
histLog hist = HistLog {pastHistory = map stringToGraphemes $ historyLines hist,
futureHistory = []}
runHistoryFromFile :: (MonadIO m, MonadMask m) => Maybe FilePath -> Maybe Int
-> ReaderT (IORef History) m a -> m a
runHistoryFromFile Nothing _ f = do
-- TODO: this should be modified now that we only want to append...
runHistoryFromFile
:: (MonadIO m, MonadMask m)
=> Maybe FilePath
-> Maybe Int
-> HistorySave
-> ReaderT (IORef History) m a
-> m a
runHistoryFromFile Nothing _ _ f = do
historyRef <- liftIO $ newIORef emptyHistory
runReaderT f historyRef
runHistoryFromFile (Just file) stifleAmt f = do
runHistoryFromFile (Just file) stifleAmt histSave f = do
oldHistory <- liftIO $ readHistory file
historyRef <- liftIO $ newIORef $ stifleHistory stifleAmt oldHistory
-- Run the action and then write the new history, even on an exception.
......@@ -41,8 +48,12 @@ runHistoryFromFile (Just file) stifleAmt f = do
-- the user's previously-entered commands.
-- (Note that this requires using ReaderT (IORef History) instead of StateT.
x <- runReaderT f historyRef
`finally` (liftIO $ readIORef historyRef >>= writeHistory file)
`finally` (liftIO $ readIORef historyRef >>= emit)
return x
where
emit = case histSave of
WriteAtEnd -> writeHistory file
AppendEveryLine -> void . flushHistory file
prevHistory, firstHistory :: Save s => s -> HistLog -> (s, HistLog)
prevHistory s h = let (s',h') = fromMaybe (listSave s,h)
......
......@@ -25,6 +25,7 @@ module System.Console.Haskeline.History(
stifleAmount,
) where
import Control.Exception
import Control.Monad (when)
import Data.Foldable (toList)
......@@ -54,6 +55,10 @@ emptyHistory = History Seq.empty Seq.empty Nothing
historyLines :: History -> [String]
historyLines h = toList $ newLines h Seq.>< oldLines h
-- | The input lines added since this history was created or read from disk (newest first)
newHistoryLines :: History -> [String]
newHistoryLines h = toList $ newLines h
-- | Reads the line input history from the given file. Returns
-- 'emptyHistory' if the file does not exist or could not be read.
readHistory :: FilePath -> IO History
......@@ -103,6 +108,7 @@ flushHistory file hist = do
r <- readHistory file
let hist' = stifleHistory (stifleAmt hist)
r { newLines = newLines hist }
print $ "WRITING: " ++ show hist'
writeHistory file hist'
return hist'
......
......@@ -155,7 +155,10 @@ execInputT :: (MonadIO m, MonadMask m) => Prefs -> Settings m -> RunTerm
execInputT prefs settings run (InputT f)
= runReaderT' settings $ runReaderT' prefs
$ runKillRing
$ runHistoryFromFile (historyFile settings) (maxHistorySize prefs)
$ runHistoryFromFile
(historyFile settings)
(maxHistorySize prefs)
(historySave prefs)
$ runReaderT f run
-- | Map a user interaction by modifying the base monad computation.
......
......@@ -6,6 +6,7 @@ module System.Console.Haskeline.Prefs(
BellStyle(..),
EditMode(..),
HistoryDuplicates(..),
HistorySave(..),
lookupKeyBinding
) where
......@@ -33,7 +34,8 @@ unparseable lines are ignored. For example:
data Prefs = Prefs { bellStyle :: !BellStyle,
editMode :: !EditMode,
maxHistorySize :: !(Maybe Int),
historyDuplicates :: HistoryDuplicates,
historyDuplicates :: !HistoryDuplicates,
historySave :: !HistorySave,
completionType :: !CompletionType,
completionPaging :: !Bool,
-- ^ When listing completion alternatives, only display
......@@ -65,6 +67,9 @@ data EditMode = Vi | Emacs
data HistoryDuplicates = AlwaysAdd | IgnoreConsecutive | IgnoreAll
deriving (Show,Read)
data HistorySave = WriteAtEnd | AppendEveryLine
deriving (Show, Read)
-- | The default preferences which may be overwritten in the
-- @.haskeline@ file.
defaultPrefs :: Prefs
......@@ -77,7 +82,8 @@ defaultPrefs = Prefs {bellStyle = AudibleBell,
listCompletionsImmediately = True,
historyDuplicates = AlwaysAdd,
customBindings = Map.empty,
customKeySequences = []
customKeySequences = [],
historySave = WriteAtEnd
}
mkSettor :: Read a => (a -> Prefs -> Prefs) -> String -> Prefs -> Prefs
......@@ -98,6 +104,7 @@ settors = [("bellstyle", mkSettor $ \x p -> p {bellStyle = x})
,("completionpromptlimit", mkSettor $ \x p -> p {completionPromptLimit = x})
,("listcompletionsimmediately", mkSettor $ \x p -> p {listCompletionsImmediately = x})
,("historyduplicates", mkSettor $ \x p -> p {historyDuplicates = x})
,("historysave", mkSettor $ \x p -> p {historySave = x})
,("bind", addCustomBinding)
,("keyseq", addCustomKeySequence)
]
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment