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}
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
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
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)
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}
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
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))}
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
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
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
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
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