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 = Seq String -> String
forall a. Show a => a -> String
show (Seq String -> String)
-> (History -> Seq String) -> History -> String
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 Seq String
forall a. Seq a
Seq.empty Maybe Int
forall a. Maybe a
Nothing
historyLines :: History -> [String]
historyLines :: History -> [String]
historyLines = Seq String -> [String]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq String -> [String])
-> (History -> Seq String) -> History -> [String]
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 = (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
Bool
exists <- String -> IO Bool
doesFileExist String
file
String
contents <- if Bool
exists
then String -> IO String
readUTF8File String
file
else String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
Int
_ <- Int -> IO Int
forall a. a -> IO a
evaluate (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
contents)
History -> IO History
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return History {histLines :: Seq String
histLines = [String] -> Seq String
forall a. [a] -> Seq a
Seq.fromList ([String] -> Seq String) -> [String] -> Seq String
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
contents,
stifleAmt :: Maybe Int
stifleAmt = Maybe Int
forall a. Maybe a
Nothing}
writeHistory :: FilePath -> History -> IO ()
writeHistory :: String -> History -> IO ()
writeHistory String
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
. String -> String -> IO ()
writeUTF8File String
file
(String -> IO ()) -> (History -> String) -> History -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> String) -> (History -> [String]) -> History -> String
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 = Maybe Int
forall a. Maybe a
Nothing}
stifleHistory a :: Maybe Int
a@(Just Int
n) History
hist = History {histLines :: Seq String
histLines = Seq String -> Seq String
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Seq String -> Int
forall a. Seq a -> Int
Seq.length (History -> Seq String
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 :: String -> History -> History
addHistory String
s History
h = History
h {histLines :: Seq String
histLines = Maybe Int -> Seq String -> Seq String
forall a. Maybe Int -> Seq a -> Seq a
maybeDropLast (History -> Maybe Int
stifleAmt History
h) (String
s String -> Seq String -> Seq String
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 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
addHistoryUnlessConsecutiveDupe :: String -> History -> History
addHistoryUnlessConsecutiveDupe :: String -> History -> History
addHistoryUnlessConsecutiveDupe String
h History
hs = case Seq String -> ViewL String
forall a. Seq a -> ViewL a
viewl (History -> Seq String
histLines History
hs) of
String
h1 :< Seq String
_ | String
hString -> String -> Bool
forall 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 = [String] -> Seq String
forall a. [a] -> Seq a
Seq.fromList ([String] -> Seq String) -> [String] -> Seq String
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
h) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Seq String -> [String]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq String -> [String]) -> Seq String -> [String]
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 (TextEncoding -> IO ()) -> TextEncoding -> IO ()
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
_ <- Int -> IO Int
forall a. a -> IO a
evaluate (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
contents)
Handle -> IO ()
IO.hClose Handle
h
String -> IO String
forall a. a -> IO a
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