{- |
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 String
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 -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. History -> Seq String
histLines

emptyHistory :: History
emptyHistory :: History
emptyHistory = Seq String -> Maybe Int -> History
History forall a. Seq a
Seq.empty forall a. Maybe a
Nothing

-- | The input lines stored in the history (newest first)
historyLines :: History -> [String]
historyLines :: History -> [String]
historyLines = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. History -> Seq String
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 :: String -> IO History
readHistory String
file = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(IOException
_::IOException) -> forall (m :: * -> *) a. Monad m => a -> m a
return History
emptyHistory) forall a b. (a -> b) -> a -> b
$ do
    Bool
exists <- String -> IO Bool
doesFileExist String
file
    String
contents <- if Bool
exists
        then String -> IO String
readUTF8File String
file
        else forall (m :: * -> *) a. Monad m => a -> m a
return String
""
    Int
_ <- forall a. a -> IO a
evaluate (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
contents) -- force file closed
    forall (m :: * -> *) a. Monad m => a -> m a
return History {histLines :: Seq String
histLines = forall a. [a] -> Seq a
Seq.fromList forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
contents,
                    stifleAmt :: Maybe Int
stifleAmt = forall a. Maybe a
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 :: String -> History -> IO ()
writeHistory String
file = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(IOException
_::IOException) -> forall (m :: * -> *) a. Monad m => a -> m a
return ())
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO ()
writeUTF8File String
file
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. History -> [String]
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 :: Maybe Int
stifleAmt = forall a. Maybe a
Nothing}
stifleHistory a :: Maybe Int
a@(Just Int
n) History
hist = History {histLines :: Seq String
histLines = forall {a}. Seq a -> Seq a
stifleFnc (History -> Seq String
histLines History
hist),
                                stifleAmt :: Maybe Int
stifleAmt = Maybe Int
a}
    where
        stifleFnc :: Seq a -> Seq a
stifleFnc = if Int
n forall a. Ord a => a -> a -> Bool
> forall a. Seq a -> Int
Seq.length (History -> Seq String
histLines History
hist)
                        then forall a. a -> a
id
                        else forall a. [a] -> Seq a
Seq.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

addHistory :: String -> History -> History
addHistory :: String -> History -> History
addHistory String
s History
h = History
h {histLines :: Seq String
histLines = forall a. Maybe Int -> Seq a -> Seq a
maybeDropLast (History -> Maybe Int
stifleAmt History
h) (String
s forall a. a -> Seq a -> Seq a
<| (History -> Seq String
histLines History
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 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (forall a. Ord a => a -> a -> Bool
>= 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 :: String -> History -> History
addHistoryUnlessConsecutiveDupe String
h History
hs = case forall a. Seq a -> ViewL a
viewl (History -> Seq String
histLines History
hs) of
    String
h1 :< Seq String
_ | String
hforall a. Eq a => a -> a -> Bool
==String
h1   -> History
hs
    ViewL String
_                   -> String -> History -> History
addHistory String
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 :: String -> History -> History
addHistoryRemovingAllDupes String
h History
hs = String -> History -> History
addHistory String
h History
hs {histLines :: Seq String
histLines = Seq String
filteredHS}
  where
    filteredHS :: Seq String
filteredHS = forall a. [a] -> Seq a
Seq.fromList forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= String
h) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ History -> Seq String
histLines History
hs

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

readUTF8File :: FilePath -> IO String
readUTF8File :: String -> IO String
readUTF8File String
file = do
    Handle
h <- String -> IOMode -> IO Handle
IO.openFile String
file IOMode
IO.ReadMode
    Handle -> TextEncoding -> IO ()
IO.hSetEncoding Handle
h forall a b. (a -> b) -> a -> b
$ TextEncoding -> TextEncoding
transliterateFailure TextEncoding
IO.utf8
    Handle -> NewlineMode -> IO ()
IO.hSetNewlineMode Handle
h NewlineMode
IO.noNewlineTranslation
    String
contents <- Handle -> IO String
IO.hGetContents Handle
h
    Int
_ <- forall a. a -> IO a
evaluate (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
contents)
    Handle -> IO ()
IO.hClose Handle
h
    forall (m :: * -> *) a. Monad m => a -> m a
return String
contents

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