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