    {- |
    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