1{- | 2This module provides a low-level API to the line history stored in the @InputT@ monad transformer. 3 4 5For most application, it should suffice to instead use the following @Settings@ flags: 6 7 * @autoAddHistory@: add nonblank lines to the command history ('True' by default). 8 9 * @historyFile@: read/write the history to a file before and after the line input session. 10 11If you do want custom history behavior, you may need to disable the above default setting(s). 12 13-} 14module System.Console.Haskeline.History( 15 History(), 16 emptyHistory, 17 addHistory, 18 addHistoryUnlessConsecutiveDupe, 19 addHistoryRemovingAllDupes, 20 historyLines, 21 readHistory, 22 writeHistory, 23 stifleHistory, 24 stifleAmount, 25 ) where 26 27import qualified Data.Sequence as Seq 28import Data.Sequence ( Seq, (<|), ViewL(..), ViewR(..), viewl, viewr ) 29import Data.Foldable (toList) 30 31import Control.Exception 32 33import System.Directory(doesFileExist) 34 35import qualified System.IO as IO 36import System.Console.Haskeline.Recover 37 38data History = History {histLines :: Seq String, 39 stifleAmt :: Maybe Int} 40 -- stored in reverse 41 42-- | The maximum number of lines stored in the history. If 'Nothing', the history storage is unlimited. 43stifleAmount :: History -> Maybe Int 44stifleAmount = stifleAmt 45 46instance Show History where 47 show = show . histLines 48 49emptyHistory :: History 50emptyHistory = History Seq.empty Nothing 51 52-- | The input lines stored in the history (newest first) 53historyLines :: History -> [String] 54historyLines = toList . histLines 55 56-- | Reads the line input history from the given file. Returns 57-- 'emptyHistory' if the file does not exist or could not be read. 58readHistory :: FilePath -> IO History 59readHistory file = handle (\(_::IOException) -> return emptyHistory) $ do 60 exists <- doesFileExist file 61 contents <- if exists 62 then readUTF8File file 63 else return "" 64 _ <- evaluate (length contents) -- force file closed 65 return History {histLines = Seq.fromList $ lines contents, 66 stifleAmt = Nothing} 67 68-- | Writes the line history to the given file. If there is an 69-- error when writing the file, it will be ignored. 70writeHistory :: FilePath -> History -> IO () 71writeHistory file = handle (\(_::IOException) -> return ()) 72 . writeUTF8File file 73 . unlines . historyLines 74 75-- | Limit the number of lines stored in the history. 76stifleHistory :: Maybe Int -> History -> History 77stifleHistory Nothing hist = hist {stifleAmt = Nothing} 78stifleHistory a@(Just n) hist = History {histLines = stifleFnc (histLines hist), 79 stifleAmt = a} 80 where 81 stifleFnc = if n > Seq.length (histLines hist) 82 then id 83 else Seq.fromList . take n . toList 84 85addHistory :: String -> History -> History 86addHistory s h = h {histLines = maybeDropLast (stifleAmt h) (s <| (histLines h))} 87 88-- If the sequence is too big, drop the last entry. 89maybeDropLast :: Maybe Int -> Seq a -> Seq a 90maybeDropLast maxAmt hs 91 | rightSize = hs 92 | otherwise = case viewr hs of 93 EmptyR -> hs 94 hs' :> _ -> hs' 95 where 96 rightSize = maybe True (>= Seq.length hs) maxAmt 97 98-- | Add a line to the history unless it matches the previously recorded line. 99addHistoryUnlessConsecutiveDupe :: String -> History -> History 100addHistoryUnlessConsecutiveDupe h hs = case viewl (histLines hs) of 101 h1 :< _ | h==h1 -> hs 102 _ -> addHistory h hs 103 104-- | Add a line to the history, and remove all previous entries which are the 105-- same as it. 106addHistoryRemovingAllDupes :: String -> History -> History 107addHistoryRemovingAllDupes h hs = addHistory h hs {histLines = filteredHS} 108 where 109 filteredHS = Seq.fromList $ filter (/= h) $ toList $ histLines hs 110 111--------- 112-- UTF-8 file I/O, for old versions of GHC 113 114readUTF8File :: FilePath -> IO String 115readUTF8File file = do 116 h <- IO.openFile file IO.ReadMode 117 IO.hSetEncoding h $ transliterateFailure IO.utf8 118 IO.hSetNewlineMode h IO.noNewlineTranslation 119 contents <- IO.hGetContents h 120 _ <- evaluate (length contents) 121 IO.hClose h 122 return contents 123 124writeUTF8File :: FilePath -> String -> IO () 125writeUTF8File file contents = do 126 h <- IO.openFile file IO.WriteMode 127 IO.hSetEncoding h IO.utf8 128 -- Write a file which is portable between systems. 129 IO.hSetNewlineMode h IO.noNewlineTranslation 130 IO.hPutStr h contents 131 IO.hClose h 132