{- |
This module provides a low-level API to the line history stored in the @InputT@ monad transformer.


For most application, it should suffice to instead use the following @Settings@ flags:

  * @autoAddHistory@: add nonblank lines to the command history ('True' by default).

  * @historyFile@: read/write the history to a file before and after the line input session.

If you do want custom history behavior, you may need to disable the above default setting(s).

-}
module System.Console.Haskeline.History(
                        History(),
                        emptyHistory,
                        addHistory,
                        addHistoryUnlessConsecutiveDupe,
                        addHistoryRemovingAllDupes,
                        historyLines,
                        readHistory,
                        writeHistory,
                        stifleHistory,
                        stifleAmount,
                        ) where

import qualified Data.Sequence as Seq
import Data.Sequence ( Seq, (<|), ViewL(..), ViewR(..), viewl, viewr )
import Data.Foldable (toList)

import Control.Exception

import System.Directory(doesFileExist)

import qualified System.IO as IO
import System.Console.Haskeline.Recover

data History = History {History -> Seq [Char]
histLines :: Seq String,
                        History -> Maybe Int
stifleAmt :: Maybe Int}
                    -- stored in reverse

-- | The maximum number of lines stored in the history.  If 'Nothing', the history storage is unlimited.
stifleAmount :: History -> Maybe Int
stifleAmount :: History -> Maybe Int
stifleAmount = History -> Maybe Int
stifleAmt

instance Show History where
    show :: History -> [Char]
show = Seq [Char] -> [Char]
forall a. Show a => a -> [Char]
show (Seq [Char] -> [Char])
-> (History -> Seq [Char]) -> History -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. History -> Seq [Char]
histLines

emptyHistory :: History
emptyHistory :: History
emptyHistory = Seq [Char] -> Maybe Int -> History
History Seq [Char]
forall a. Seq a
Seq.empty Maybe Int
forall a. Maybe a
Nothing

-- | The input lines stored in the history (newest first)
historyLines :: History -> [String]
historyLines :: History -> [[Char]]
historyLines = Seq [Char] -> [[Char]]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq [Char] -> [[Char]])
-> (History -> Seq [Char]) -> History -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. History -> Seq [Char]
histLines

-- | 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
readHistory :: [Char] -> IO History
readHistory [Char]
file = (IOException -> IO History) -> IO History -> IO History
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(IOException
_::IOException) -> History -> IO History
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return History
emptyHistory) (IO History -> IO History) -> IO History -> IO History
forall a b. (a -> b) -> a -> b
$ do
    exists <- [Char] -> IO Bool
doesFileExist [Char]
file
    contents <- if exists
        then readUTF8File file
        else return ""
    _ <- evaluate (length contents) -- force file closed
    return History {histLines = Seq.fromList $ lines contents,
                    stifleAmt = Nothing}

-- | Writes the line history to the given file.  If there is an
-- error when writing the file, it will be ignored.
writeHistory :: FilePath -> History -> IO ()
writeHistory :: [Char] -> History -> IO ()
writeHistory [Char]
file = (IOException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(IOException
_::IOException) -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
        (IO () -> IO ()) -> (History -> IO ()) -> History -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> IO ()
writeUTF8File [Char]
file
        ([Char] -> IO ()) -> (History -> [Char]) -> History -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> (History -> [[Char]]) -> History -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. History -> [[Char]]
historyLines 

-- | Limit the number of lines stored in the history.
stifleHistory :: Maybe Int -> History -> History
stifleHistory :: Maybe Int -> History -> History
stifleHistory Maybe Int
Nothing History
hist = History
hist {stifleAmt = Nothing}
stifleHistory a :: Maybe Int
a@(Just Int
n) History
hist = History {histLines :: Seq [Char]
histLines = Seq [Char] -> Seq [Char]
forall {a}. Seq a -> Seq a
stifleFnc (History -> Seq [Char]
histLines History
hist),
                                stifleAmt :: Maybe Int
stifleAmt = Maybe Int
a}
    where
        stifleFnc :: Seq a -> Seq a
stifleFnc = if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Seq [Char] -> Int
forall a. Seq a -> Int
Seq.length (History -> Seq [Char]
histLines History
hist)
                        then Seq a -> Seq a
forall a. a -> a
id
                        else [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList ([a] -> Seq a) -> (Seq a -> [a]) -> Seq a -> Seq a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n ([a] -> [a]) -> (Seq a -> [a]) -> Seq a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq a -> [a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

addHistory :: String -> History -> History
addHistory :: [Char] -> History -> History
addHistory [Char]
s History
h = History
h {histLines = maybeDropLast (stifleAmt h) (s <| (histLines h))}

-- If the sequence is too big, drop the last entry.
maybeDropLast :: Maybe Int -> Seq a -> Seq a
maybeDropLast :: forall a. Maybe Int -> Seq a -> Seq a
maybeDropLast Maybe Int
maxAmt Seq a
hs
    | Bool
rightSize = Seq a
hs
    | Bool
otherwise = case Seq a -> ViewR a
forall a. Seq a -> ViewR a
viewr Seq a
hs of
                    ViewR a
EmptyR -> Seq a
hs
                    Seq a
hs' :> a
_ -> Seq a
hs'
  where
    rightSize :: Bool
rightSize = Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Seq a -> Int
forall a. Seq a -> Int
Seq.length Seq a
hs) Maybe Int
maxAmt

-- | Add a line to the history unless it matches the previously recorded line.
addHistoryUnlessConsecutiveDupe :: String -> History -> History
addHistoryUnlessConsecutiveDupe :: [Char] -> History -> History
addHistoryUnlessConsecutiveDupe [Char]
h History
hs = case Seq [Char] -> ViewL [Char]
forall a. Seq a -> ViewL a
viewl (History -> Seq [Char]
histLines History
hs) of
    [Char]
h1 :< Seq [Char]
_ | [Char]
h[Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
==[Char]
h1   -> History
hs
    ViewL [Char]
_                   -> [Char] -> History -> History
addHistory [Char]
h History
hs

-- | Add a line to the history, and remove all previous entries which are the 
-- same as it.
addHistoryRemovingAllDupes :: String -> History -> History
addHistoryRemovingAllDupes :: [Char] -> History -> History
addHistoryRemovingAllDupes [Char]
h History
hs = [Char] -> History -> History
addHistory [Char]
h History
hs {histLines = filteredHS}
  where
    filteredHS :: Seq [Char]
filteredHS = [[Char]] -> Seq [Char]
forall a. [a] -> Seq a
Seq.fromList ([[Char]] -> Seq [Char]) -> [[Char]] -> Seq [Char]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
h) ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ Seq [Char] -> [[Char]]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq [Char] -> [[Char]]) -> Seq [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ History -> Seq [Char]
histLines History
hs

---------
-- UTF-8 file I/O, for old versions of GHC

readUTF8File :: FilePath -> IO String
readUTF8File :: [Char] -> IO [Char]
readUTF8File [Char]
file = do
    h <- [Char] -> IOMode -> IO Handle
IO.openFile [Char]
file IOMode
IO.ReadMode
    IO.hSetEncoding h $ transliterateFailure IO.utf8
    IO.hSetNewlineMode h IO.noNewlineTranslation
    contents <- IO.hGetContents h
    _ <- evaluate (length contents)
    IO.hClose h
    return contents

writeUTF8File :: FilePath -> String -> IO ()
writeUTF8File :: [Char] -> [Char] -> IO ()
writeUTF8File [Char]
file [Char]
contents = do
    h <- [Char] -> IOMode -> IO Handle
IO.openFile [Char]
file IOMode
IO.WriteMode
    IO.hSetEncoding h IO.utf8
    -- Write a file which is portable between systems.
    IO.hSetNewlineMode h IO.noNewlineTranslation
    IO.hPutStr h contents
    IO.hClose h