module System.Console.Haskeline.Command.History where

import System.Console.Haskeline.LineState
import System.Console.Haskeline.Command
import System.Console.Haskeline.Key
import Control.Monad(liftM,mplus)
import System.Console.Haskeline.Monads
import Data.List (isPrefixOf, unfoldr)
import Data.Maybe(fromMaybe)
import System.Console.Haskeline.History
import Data.IORef
import Control.Monad.Catch

data HistLog = HistLog {HistLog -> [[Grapheme]]
pastHistory, HistLog -> [[Grapheme]]
futureHistory :: [[Grapheme]]}
                    deriving Int -> HistLog -> ShowS
[HistLog] -> ShowS
HistLog -> String
(Int -> HistLog -> ShowS)
-> (HistLog -> String) -> ([HistLog] -> ShowS) -> Show HistLog
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HistLog -> ShowS
showsPrec :: Int -> HistLog -> ShowS
$cshow :: HistLog -> String
show :: HistLog -> String
$cshowList :: [HistLog] -> ShowS
showList :: [HistLog] -> ShowS
Show

prevHistoryM :: [Grapheme] -> HistLog -> Maybe ([Grapheme],HistLog)
prevHistoryM :: [Grapheme] -> HistLog -> Maybe ([Grapheme], HistLog)
prevHistoryM [Grapheme]
_ HistLog {pastHistory :: HistLog -> [[Grapheme]]
pastHistory = []} = Maybe ([Grapheme], HistLog)
forall a. Maybe a
Nothing
prevHistoryM [Grapheme]
s HistLog {pastHistory :: HistLog -> [[Grapheme]]
pastHistory=[Grapheme]
ls:[[Grapheme]]
past, futureHistory :: HistLog -> [[Grapheme]]
futureHistory=[[Grapheme]]
future}
        = ([Grapheme], HistLog) -> Maybe ([Grapheme], HistLog)
forall a. a -> Maybe a
Just ([Grapheme]
ls, 
            HistLog {pastHistory :: [[Grapheme]]
pastHistory=[[Grapheme]]
past, futureHistory :: [[Grapheme]]
futureHistory= [Grapheme]
s[Grapheme] -> [[Grapheme]] -> [[Grapheme]]
forall a. a -> [a] -> [a]
:[[Grapheme]]
future})

prevHistories :: [Grapheme] -> HistLog -> [([Grapheme],HistLog)]
prevHistories :: [Grapheme] -> HistLog -> [([Grapheme], HistLog)]
prevHistories [Grapheme]
s HistLog
h = ((([Grapheme], HistLog)
  -> Maybe (([Grapheme], HistLog), ([Grapheme], HistLog)))
 -> ([Grapheme], HistLog) -> [([Grapheme], HistLog)])
-> ([Grapheme], HistLog)
-> (([Grapheme], HistLog)
    -> Maybe (([Grapheme], HistLog), ([Grapheme], HistLog)))
-> [([Grapheme], HistLog)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([Grapheme], HistLog)
 -> Maybe (([Grapheme], HistLog), ([Grapheme], HistLog)))
-> ([Grapheme], HistLog) -> [([Grapheme], HistLog)]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr ([Grapheme]
s,HistLog
h) ((([Grapheme], HistLog)
  -> Maybe (([Grapheme], HistLog), ([Grapheme], HistLog)))
 -> [([Grapheme], HistLog)])
-> (([Grapheme], HistLog)
    -> Maybe (([Grapheme], HistLog), ([Grapheme], HistLog)))
-> [([Grapheme], HistLog)]
forall a b. (a -> b) -> a -> b
$ \([Grapheme]
s',HistLog
h') -> (([Grapheme], HistLog)
 -> (([Grapheme], HistLog), ([Grapheme], HistLog)))
-> Maybe ([Grapheme], HistLog)
-> Maybe (([Grapheme], HistLog), ([Grapheme], HistLog))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\([Grapheme], HistLog)
r -> (([Grapheme], HistLog)
r,([Grapheme], HistLog)
r))
                    (Maybe ([Grapheme], HistLog)
 -> Maybe (([Grapheme], HistLog), ([Grapheme], HistLog)))
-> Maybe ([Grapheme], HistLog)
-> Maybe (([Grapheme], HistLog), ([Grapheme], HistLog))
forall a b. (a -> b) -> a -> b
$ [Grapheme] -> HistLog -> Maybe ([Grapheme], HistLog)
prevHistoryM [Grapheme]
s' HistLog
h'

histLog :: History -> HistLog
histLog :: History -> HistLog
histLog History
hist = HistLog {pastHistory :: [[Grapheme]]
pastHistory = (String -> [Grapheme]) -> [String] -> [[Grapheme]]
forall a b. (a -> b) -> [a] -> [b]
map String -> [Grapheme]
stringToGraphemes ([String] -> [[Grapheme]]) -> [String] -> [[Grapheme]]
forall a b. (a -> b) -> a -> b
$ History -> [String]
historyLines History
hist,
                        futureHistory :: [[Grapheme]]
futureHistory = []}

runHistoryFromFile :: (MonadIO m, MonadMask m) => Maybe FilePath -> Maybe Int
                            -> ReaderT (IORef History) m a -> m a
runHistoryFromFile :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Maybe String -> Maybe Int -> ReaderT (IORef History) m a -> m a
runHistoryFromFile Maybe String
Nothing Maybe Int
_ ReaderT (IORef History) m a
f = do
    IORef History
historyRef <- IO (IORef History) -> m (IORef History)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef History) -> m (IORef History))
-> IO (IORef History) -> m (IORef History)
forall a b. (a -> b) -> a -> b
$ History -> IO (IORef History)
forall a. a -> IO (IORef a)
newIORef History
emptyHistory
    ReaderT (IORef History) m a -> IORef History -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (IORef History) m a
f IORef History
historyRef
runHistoryFromFile (Just String
file) Maybe Int
stifleAmt ReaderT (IORef History) m a
f = do
    History
oldHistory <- IO History -> m History
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO History -> m History) -> IO History -> m History
forall a b. (a -> b) -> a -> b
$ String -> IO History
readHistory String
file
    IORef History
historyRef <- IO (IORef History) -> m (IORef History)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef History) -> m (IORef History))
-> IO (IORef History) -> m (IORef History)
forall a b. (a -> b) -> a -> b
$ History -> IO (IORef History)
forall a. a -> IO (IORef a)
newIORef (History -> IO (IORef History)) -> History -> IO (IORef History)
forall a b. (a -> b) -> a -> b
$ Maybe Int -> History -> History
stifleHistory Maybe Int
stifleAmt History
oldHistory
    -- Run the action and then write the new history, even on an exception.
    -- For example, if there's an unhandled ctrl-c, we don't want to lose
    -- the user's previously-entered commands.
    -- (Note that this requires using ReaderT (IORef History) instead of StateT.
    a
x <- ReaderT (IORef History) m a -> IORef History -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (IORef History) m a
f IORef History
historyRef
            m a -> m () -> m a
forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
`finally` (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef History -> IO History
forall a. IORef a -> IO a
readIORef IORef History
historyRef IO History -> (History -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> History -> IO ()
writeHistory String
file)
    a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

prevHistory, firstHistory :: Save s => s -> HistLog -> (s, HistLog)
prevHistory :: forall s. Save s => s -> HistLog -> (s, HistLog)
prevHistory s
s HistLog
h = let ([Grapheme]
s',HistLog
h') = ([Grapheme], HistLog)
-> Maybe ([Grapheme], HistLog) -> ([Grapheme], HistLog)
forall a. a -> Maybe a -> a
fromMaybe (s -> [Grapheme]
forall s. Save s => s -> [Grapheme]
listSave s
s,HistLog
h) 
                                    (Maybe ([Grapheme], HistLog) -> ([Grapheme], HistLog))
-> Maybe ([Grapheme], HistLog) -> ([Grapheme], HistLog)
forall a b. (a -> b) -> a -> b
$ [Grapheme] -> HistLog -> Maybe ([Grapheme], HistLog)
prevHistoryM (s -> [Grapheme]
forall s. Save s => s -> [Grapheme]
listSave s
s) HistLog
h
                  in ([Grapheme] -> s
forall s. Save s => [Grapheme] -> s
listRestore [Grapheme]
s',HistLog
h')

firstHistory :: forall s. Save s => s -> HistLog -> (s, HistLog)
firstHistory s
s HistLog
h = let prevs :: [([Grapheme], HistLog)]
prevs = (s -> [Grapheme]
forall s. Save s => s -> [Grapheme]
listSave s
s,HistLog
h)([Grapheme], HistLog)
-> [([Grapheme], HistLog)] -> [([Grapheme], HistLog)]
forall a. a -> [a] -> [a]
:[Grapheme] -> HistLog -> [([Grapheme], HistLog)]
prevHistories (s -> [Grapheme]
forall s. Save s => s -> [Grapheme]
listSave s
s) HistLog
h
                       -- above makes sure we don't take the last of an empty list.
                       ([Grapheme]
s',HistLog
h') = [([Grapheme], HistLog)] -> ([Grapheme], HistLog)
forall a. HasCallStack => [a] -> a
last [([Grapheme], HistLog)]
prevs
                   in ([Grapheme] -> s
forall s. Save s => [Grapheme] -> s
listRestore [Grapheme]
s',HistLog
h')

historyBack, historyForward :: (Save s, MonadState HistLog m) => Command m s s
historyBack :: forall s (m :: * -> *).
(Save s, MonadState HistLog m) =>
Command m s s
historyBack = (s -> m (Either Effect s)) -> Command m s s
forall s (m :: * -> *).
(LineState s, Monad m) =>
(s -> m (Either Effect s)) -> Command m s s
simpleCommand ((s -> m (Either Effect s)) -> Command m s s)
-> (s -> m (Either Effect s)) -> Command m s s
forall a b. (a -> b) -> a -> b
$ (s -> HistLog -> (s, HistLog)) -> s -> m (Either Effect s)
forall (m :: * -> *) s t.
MonadState HistLog m =>
(s -> HistLog -> (t, HistLog)) -> s -> m (Either Effect t)
histUpdate s -> HistLog -> (s, HistLog)
forall s. Save s => s -> HistLog -> (s, HistLog)
prevHistory
historyForward :: forall s (m :: * -> *).
(Save s, MonadState HistLog m) =>
Command m s s
historyForward = (s -> m (Either Effect s)) -> Command m s s
forall s (m :: * -> *).
(LineState s, Monad m) =>
(s -> m (Either Effect s)) -> Command m s s
simpleCommand ((s -> m (Either Effect s)) -> Command m s s)
-> (s -> m (Either Effect s)) -> Command m s s
forall a b. (a -> b) -> a -> b
$ m (Either Effect s) -> m (Either Effect s)
forall (m :: * -> *) b. MonadState HistLog m => m b -> m b
reverseHist (m (Either Effect s) -> m (Either Effect s))
-> (s -> m (Either Effect s)) -> s -> m (Either Effect s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> HistLog -> (s, HistLog)) -> s -> m (Either Effect s)
forall (m :: * -> *) s t.
MonadState HistLog m =>
(s -> HistLog -> (t, HistLog)) -> s -> m (Either Effect t)
histUpdate s -> HistLog -> (s, HistLog)
forall s. Save s => s -> HistLog -> (s, HistLog)
prevHistory

historyStart, historyEnd :: (Save s, MonadState HistLog m) => Command m s s
historyStart :: forall s (m :: * -> *).
(Save s, MonadState HistLog m) =>
Command m s s
historyStart = (s -> m (Either Effect s)) -> Command m s s
forall s (m :: * -> *).
(LineState s, Monad m) =>
(s -> m (Either Effect s)) -> Command m s s
simpleCommand ((s -> m (Either Effect s)) -> Command m s s)
-> (s -> m (Either Effect s)) -> Command m s s
forall a b. (a -> b) -> a -> b
$ (s -> HistLog -> (s, HistLog)) -> s -> m (Either Effect s)
forall (m :: * -> *) s t.
MonadState HistLog m =>
(s -> HistLog -> (t, HistLog)) -> s -> m (Either Effect t)
histUpdate s -> HistLog -> (s, HistLog)
forall s. Save s => s -> HistLog -> (s, HistLog)
firstHistory
historyEnd :: forall s (m :: * -> *).
(Save s, MonadState HistLog m) =>
Command m s s
historyEnd = (s -> m (Either Effect s)) -> Command m s s
forall s (m :: * -> *).
(LineState s, Monad m) =>
(s -> m (Either Effect s)) -> Command m s s
simpleCommand ((s -> m (Either Effect s)) -> Command m s s)
-> (s -> m (Either Effect s)) -> Command m s s
forall a b. (a -> b) -> a -> b
$ m (Either Effect s) -> m (Either Effect s)
forall (m :: * -> *) b. MonadState HistLog m => m b -> m b
reverseHist (m (Either Effect s) -> m (Either Effect s))
-> (s -> m (Either Effect s)) -> s -> m (Either Effect s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> HistLog -> (s, HistLog)) -> s -> m (Either Effect s)
forall (m :: * -> *) s t.
MonadState HistLog m =>
(s -> HistLog -> (t, HistLog)) -> s -> m (Either Effect t)
histUpdate s -> HistLog -> (s, HistLog)
forall s. Save s => s -> HistLog -> (s, HistLog)
firstHistory

histUpdate :: MonadState HistLog m => (s -> HistLog -> (t,HistLog))
                        -> s -> m (Either Effect t)
histUpdate :: forall (m :: * -> *) s t.
MonadState HistLog m =>
(s -> HistLog -> (t, HistLog)) -> s -> m (Either Effect t)
histUpdate s -> HistLog -> (t, HistLog)
f = (t -> Either Effect t) -> m t -> m (Either Effect t)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM t -> Either Effect t
forall a b. b -> Either a b
Right (m t -> m (Either Effect t))
-> (s -> m t) -> s -> m (Either Effect t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HistLog -> (t, HistLog)) -> m t
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
update ((HistLog -> (t, HistLog)) -> m t)
-> (s -> HistLog -> (t, HistLog)) -> s -> m t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> HistLog -> (t, HistLog)
f

reverseHist :: MonadState HistLog m => m b -> m b
reverseHist :: forall (m :: * -> *) b. MonadState HistLog m => m b -> m b
reverseHist m b
f = do
    (HistLog -> HistLog) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify HistLog -> HistLog
reverser
    b
y <- m b
f
    (HistLog -> HistLog) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify HistLog -> HistLog
reverser
    b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
y
  where
    reverser :: HistLog -> HistLog
reverser HistLog
h = HistLog {futureHistory :: [[Grapheme]]
futureHistory=HistLog -> [[Grapheme]]
pastHistory HistLog
h, 
                            pastHistory :: [[Grapheme]]
pastHistory=HistLog -> [[Grapheme]]
futureHistory HistLog
h}

data SearchMode = SearchMode {SearchMode -> [Grapheme]
searchTerm :: [Grapheme],
                              SearchMode -> InsertMode
foundHistory :: InsertMode,
                              SearchMode -> Direction
direction :: Direction}
                        deriving Int -> SearchMode -> ShowS
[SearchMode] -> ShowS
SearchMode -> String
(Int -> SearchMode -> ShowS)
-> (SearchMode -> String)
-> ([SearchMode] -> ShowS)
-> Show SearchMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SearchMode -> ShowS
showsPrec :: Int -> SearchMode -> ShowS
$cshow :: SearchMode -> String
show :: SearchMode -> String
$cshowList :: [SearchMode] -> ShowS
showList :: [SearchMode] -> ShowS
Show

data Direction = Forward | Reverse
                    deriving (Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
(Int -> Direction -> ShowS)
-> (Direction -> String)
-> ([Direction] -> ShowS)
-> Show Direction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Direction -> ShowS
showsPrec :: Int -> Direction -> ShowS
$cshow :: Direction -> String
show :: Direction -> String
$cshowList :: [Direction] -> ShowS
showList :: [Direction] -> ShowS
Show,Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
/= :: Direction -> Direction -> Bool
Eq)

directionName :: Direction -> String
directionName :: Direction -> String
directionName Direction
Forward = String
"i-search"
directionName Direction
Reverse = String
"reverse-i-search"

instance LineState SearchMode where
    beforeCursor :: [Grapheme] -> SearchMode -> [Grapheme]
beforeCursor [Grapheme]
_ SearchMode
sm = [Grapheme] -> InsertMode -> [Grapheme]
forall s. LineState s => [Grapheme] -> s -> [Grapheme]
beforeCursor [Grapheme]
prefix (SearchMode -> InsertMode
foundHistory SearchMode
sm)
        where 
            prefix :: [Grapheme]
prefix = String -> [Grapheme]
stringToGraphemes (String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Direction -> String
directionName (SearchMode -> Direction
direction SearchMode
sm) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")`")
                            [Grapheme] -> [Grapheme] -> [Grapheme]
forall a. [a] -> [a] -> [a]
++ SearchMode -> [Grapheme]
searchTerm SearchMode
sm [Grapheme] -> [Grapheme] -> [Grapheme]
forall a. [a] -> [a] -> [a]
++ String -> [Grapheme]
stringToGraphemes String
"': "
    afterCursor :: SearchMode -> [Grapheme]
afterCursor = InsertMode -> [Grapheme]
forall s. LineState s => s -> [Grapheme]
afterCursor (InsertMode -> [Grapheme])
-> (SearchMode -> InsertMode) -> SearchMode -> [Grapheme]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchMode -> InsertMode
foundHistory

instance Result SearchMode where
    toResult :: SearchMode -> String
toResult = InsertMode -> String
forall s. Result s => s -> String
toResult (InsertMode -> String)
-> (SearchMode -> InsertMode) -> SearchMode -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchMode -> InsertMode
foundHistory

saveSM :: SearchMode -> [Grapheme]
saveSM :: SearchMode -> [Grapheme]
saveSM = InsertMode -> [Grapheme]
forall s. Save s => s -> [Grapheme]
listSave (InsertMode -> [Grapheme])
-> (SearchMode -> InsertMode) -> SearchMode -> [Grapheme]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchMode -> InsertMode
foundHistory

startSearchMode :: Direction -> InsertMode -> SearchMode
startSearchMode :: Direction -> InsertMode -> SearchMode
startSearchMode Direction
dir InsertMode
im = SearchMode {searchTerm :: [Grapheme]
searchTerm = [],foundHistory :: InsertMode
foundHistory=InsertMode
im, direction :: Direction
direction=Direction
dir}

addChar :: Char -> SearchMode -> SearchMode
addChar :: Char -> SearchMode -> SearchMode
addChar Char
c SearchMode
s = SearchMode
s {searchTerm = listSave $ insertChar c 
                                $ listRestore $ searchTerm s}

searchHistories :: Direction -> [Grapheme] -> [([Grapheme],HistLog)]
            -> Maybe (SearchMode,HistLog)
searchHistories :: Direction
-> [Grapheme]
-> [([Grapheme], HistLog)]
-> Maybe (SearchMode, HistLog)
searchHistories Direction
dir [Grapheme]
text = (Maybe (SearchMode, HistLog)
 -> Maybe (SearchMode, HistLog) -> Maybe (SearchMode, HistLog))
-> Maybe (SearchMode, HistLog)
-> [Maybe (SearchMode, HistLog)]
-> Maybe (SearchMode, HistLog)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Maybe (SearchMode, HistLog)
-> Maybe (SearchMode, HistLog) -> Maybe (SearchMode, HistLog)
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus Maybe (SearchMode, HistLog)
forall a. Maybe a
Nothing ([Maybe (SearchMode, HistLog)] -> Maybe (SearchMode, HistLog))
-> ([([Grapheme], HistLog)] -> [Maybe (SearchMode, HistLog)])
-> [([Grapheme], HistLog)]
-> Maybe (SearchMode, HistLog)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Grapheme], HistLog) -> Maybe (SearchMode, HistLog))
-> [([Grapheme], HistLog)] -> [Maybe (SearchMode, HistLog)]
forall a b. (a -> b) -> [a] -> [b]
map ([Grapheme], HistLog) -> Maybe (SearchMode, HistLog)
forall {b}. ([Grapheme], b) -> Maybe (SearchMode, b)
findIt
    where
        findIt :: ([Grapheme], b) -> Maybe (SearchMode, b)
findIt ([Grapheme]
l,b
h) = do 
            InsertMode
im <- [Grapheme] -> [Grapheme] -> Maybe InsertMode
findInLine [Grapheme]
text [Grapheme]
l
            (SearchMode, b) -> Maybe (SearchMode, b)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Grapheme] -> InsertMode -> Direction -> SearchMode
SearchMode [Grapheme]
text InsertMode
im Direction
dir,b
h)

findInLine :: [Grapheme] -> [Grapheme] -> Maybe InsertMode
findInLine :: [Grapheme] -> [Grapheme] -> Maybe InsertMode
findInLine [Grapheme]
text [Grapheme]
l = [Grapheme] -> [Grapheme] -> Maybe InsertMode
find' [] [Grapheme]
l
    where
        find' :: [Grapheme] -> [Grapheme] -> Maybe InsertMode
find' [Grapheme]
_ [] = Maybe InsertMode
forall a. Maybe a
Nothing
        find' [Grapheme]
prev ccs :: [Grapheme]
ccs@(Grapheme
c:[Grapheme]
cs)
            | [Grapheme]
text [Grapheme] -> [Grapheme] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Grapheme]
ccs = InsertMode -> Maybe InsertMode
forall a. a -> Maybe a
Just ([Grapheme] -> [Grapheme] -> InsertMode
IMode [Grapheme]
prev [Grapheme]
ccs)
            | Bool
otherwise = [Grapheme] -> [Grapheme] -> Maybe InsertMode
find' (Grapheme
cGrapheme -> [Grapheme] -> [Grapheme]
forall a. a -> [a] -> [a]
:[Grapheme]
prev) [Grapheme]
cs

prepSearch :: SearchMode -> HistLog -> ([Grapheme],[([Grapheme],HistLog)])
prepSearch :: SearchMode -> HistLog -> ([Grapheme], [([Grapheme], HistLog)])
prepSearch SearchMode
sm HistLog
h = let
    text :: [Grapheme]
text = SearchMode -> [Grapheme]
searchTerm SearchMode
sm
    l :: [Grapheme]
l = SearchMode -> [Grapheme]
saveSM SearchMode
sm
    in ([Grapheme]
text,[Grapheme] -> HistLog -> [([Grapheme], HistLog)]
prevHistories [Grapheme]
l HistLog
h)

searchBackwards :: Bool -> SearchMode -> HistLog -> Maybe (SearchMode, HistLog)
searchBackwards :: Bool -> SearchMode -> HistLog -> Maybe (SearchMode, HistLog)
searchBackwards Bool
useCurrent SearchMode
s HistLog
h = let
    ([Grapheme]
text,[([Grapheme], HistLog)]
hists) = SearchMode -> HistLog -> ([Grapheme], [([Grapheme], HistLog)])
prepSearch SearchMode
s HistLog
h
    hists' :: [([Grapheme], HistLog)]
hists' = if Bool
useCurrent then (SearchMode -> [Grapheme]
saveSM SearchMode
s,HistLog
h)([Grapheme], HistLog)
-> [([Grapheme], HistLog)] -> [([Grapheme], HistLog)]
forall a. a -> [a] -> [a]
:[([Grapheme], HistLog)]
hists else [([Grapheme], HistLog)]
hists
    in Direction
-> [Grapheme]
-> [([Grapheme], HistLog)]
-> Maybe (SearchMode, HistLog)
searchHistories (SearchMode -> Direction
direction SearchMode
s) [Grapheme]
text [([Grapheme], HistLog)]
hists'

doSearch :: MonadState HistLog m => Bool -> SearchMode -> m (Either Effect SearchMode)
doSearch :: forall (m :: * -> *).
MonadState HistLog m =>
Bool -> SearchMode -> m (Either Effect SearchMode)
doSearch Bool
useCurrent SearchMode
sm = case SearchMode -> Direction
direction SearchMode
sm of
    Direction
Reverse -> m (Either Effect SearchMode)
searchHist
    Direction
Forward -> m (Either Effect SearchMode) -> m (Either Effect SearchMode)
forall (m :: * -> *) b. MonadState HistLog m => m b -> m b
reverseHist m (Either Effect SearchMode)
searchHist
  where
    searchHist :: m (Either Effect SearchMode)
searchHist = do
        HistLog
hist <- m HistLog
forall s (m :: * -> *). MonadState s m => m s
get
        case Bool -> SearchMode -> HistLog -> Maybe (SearchMode, HistLog)
searchBackwards Bool
useCurrent SearchMode
sm HistLog
hist of
            Just (SearchMode
sm',HistLog
hist') -> HistLog -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put HistLog
hist' m ()
-> m (Either Effect SearchMode) -> m (Either Effect SearchMode)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either Effect SearchMode -> m (Either Effect SearchMode)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SearchMode -> Either Effect SearchMode
forall a b. b -> Either a b
Right SearchMode
sm')
            Maybe (SearchMode, HistLog)
Nothing -> Either Effect SearchMode -> m (Either Effect SearchMode)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Effect SearchMode -> m (Either Effect SearchMode))
-> Either Effect SearchMode -> m (Either Effect SearchMode)
forall a b. (a -> b) -> a -> b
$ Effect -> Either Effect SearchMode
forall a b. a -> Either a b
Left Effect
RingBell

searchHistory :: MonadState HistLog m => KeyCommand m InsertMode InsertMode
searchHistory :: forall (m :: * -> *).
MonadState HistLog m =>
KeyCommand m InsertMode InsertMode
searchHistory = [KeyMap (Command m InsertMode InsertMode)]
-> KeyMap (Command m InsertMode InsertMode)
forall a. [KeyMap a] -> KeyMap a
choiceCmd [
            Char -> Key
metaChar Char
'j' Key
-> Command m InsertMode InsertMode
-> KeyMap (Command m InsertMode InsertMode)
forall a. Key -> a -> KeyMap a
+> Direction -> Command m InsertMode InsertMode
forall (m :: * -> *).
MonadState HistLog m =>
Direction -> Command m InsertMode InsertMode
searchForPrefix Direction
Forward
            , Char -> Key
metaChar Char
'k' Key
-> Command m InsertMode InsertMode
-> KeyMap (Command m InsertMode InsertMode)
forall a. Key -> a -> KeyMap a
+> Direction -> Command m InsertMode InsertMode
forall (m :: * -> *).
MonadState HistLog m =>
Direction -> Command m InsertMode InsertMode
searchForPrefix Direction
Reverse
            , [KeyMap (Command m InsertMode SearchMode)]
-> KeyMap (Command m InsertMode SearchMode)
forall a. [KeyMap a] -> KeyMap a
choiceCmd [
                 Key
backKey Key
-> Command m InsertMode SearchMode
-> KeyMap (Command m InsertMode SearchMode)
forall a. Key -> a -> KeyMap a
+> (InsertMode -> SearchMode) -> Command m InsertMode SearchMode
forall t (m :: * -> *) s.
(LineState t, Monad m) =>
(s -> t) -> Command m s t
change (Direction -> InsertMode -> SearchMode
startSearchMode Direction
Reverse)
                 , Key
forwardKey Key
-> Command m InsertMode SearchMode
-> KeyMap (Command m InsertMode SearchMode)
forall a. Key -> a -> KeyMap a
+> (InsertMode -> SearchMode) -> Command m InsertMode SearchMode
forall t (m :: * -> *) s.
(LineState t, Monad m) =>
(s -> t) -> Command m s t
change (Direction -> InsertMode -> SearchMode
startSearchMode Direction
Forward)
                 ] KeyMap (Command m InsertMode SearchMode)
-> Command m SearchMode InsertMode
-> KeyMap (Command m InsertMode InsertMode)
forall (m :: * -> *) s t u.
Monad m =>
KeyCommand m s t -> Command m t u -> KeyCommand m s u
>+> Command m SearchMode InsertMode
keepSearching
            ]
    where
        backKey :: Key
backKey = Char -> Key
ctrlChar Char
'r'
        forwardKey :: Key
forwardKey = Char -> Key
ctrlChar Char
's'
        keepSearching :: Command m SearchMode InsertMode
keepSearching = [KeyCommand m SearchMode InsertMode]
-> Command m SearchMode InsertMode
forall (m :: * -> *) s t. [KeyCommand m s t] -> Command m s t
keyChoiceCmd [
                            [KeyMap (Command m SearchMode SearchMode)]
-> KeyMap (Command m SearchMode SearchMode)
forall a. [KeyMap a] -> KeyMap a
choiceCmd [
                                (Char -> SearchMode -> m (Either Effect SearchMode))
-> KeyMap (Command m SearchMode SearchMode)
forall s (m :: * -> *).
(LineState s, Monad m) =>
(Char -> s -> m (Either Effect s)) -> KeyCommand m s s
charCommand Char -> SearchMode -> m (Either Effect SearchMode)
forall {m :: * -> *}.
MonadState HistLog m =>
Char -> SearchMode -> m (Either Effect SearchMode)
oneMoreChar
                                , Key
backKey Key
-> Command m SearchMode SearchMode
-> KeyMap (Command m SearchMode SearchMode)
forall a. Key -> a -> KeyMap a
+> (SearchMode -> m (Either Effect SearchMode))
-> Command m SearchMode SearchMode
forall s (m :: * -> *).
(LineState s, Monad m) =>
(s -> m (Either Effect s)) -> Command m s s
simpleCommand (Direction -> SearchMode -> m (Either Effect SearchMode)
forall {m :: * -> *}.
MonadState HistLog m =>
Direction -> SearchMode -> m (Either Effect SearchMode)
searchMore Direction
Reverse)
                                , Key
forwardKey Key
-> Command m SearchMode SearchMode
-> KeyMap (Command m SearchMode SearchMode)
forall a. Key -> a -> KeyMap a
+> (SearchMode -> m (Either Effect SearchMode))
-> Command m SearchMode SearchMode
forall s (m :: * -> *).
(LineState s, Monad m) =>
(s -> m (Either Effect s)) -> Command m s s
simpleCommand (Direction -> SearchMode -> m (Either Effect SearchMode)
forall {m :: * -> *}.
MonadState HistLog m =>
Direction -> SearchMode -> m (Either Effect SearchMode)
searchMore Direction
Forward)
                                , BaseKey -> Key
simpleKey BaseKey
Backspace Key
-> Command m SearchMode SearchMode
-> KeyMap (Command m SearchMode SearchMode)
forall a. Key -> a -> KeyMap a
+> (SearchMode -> SearchMode) -> Command m SearchMode SearchMode
forall t (m :: * -> *) s.
(LineState t, Monad m) =>
(s -> t) -> Command m s t
change SearchMode -> SearchMode
delLastChar
                                ] KeyMap (Command m SearchMode SearchMode)
-> Command m SearchMode InsertMode
-> KeyCommand m SearchMode InsertMode
forall (m :: * -> *) s t u.
Monad m =>
KeyCommand m s t -> Command m t u -> KeyCommand m s u
>+> Command m SearchMode InsertMode
keepSearching
                            , Command m SearchMode InsertMode
-> KeyCommand m SearchMode InsertMode
forall (m :: * -> *) s t. Command m s t -> KeyCommand m s t
withoutConsuming ((SearchMode -> InsertMode) -> Command m SearchMode InsertMode
forall t (m :: * -> *) s.
(LineState t, Monad m) =>
(s -> t) -> Command m s t
change SearchMode -> InsertMode
foundHistory) -- abort
                            ]
        delLastChar :: SearchMode -> SearchMode
delLastChar SearchMode
s = SearchMode
s {searchTerm = minit (searchTerm s)}
        minit :: [a] -> [a]
minit [a]
xs = if [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs then [] else [a] -> [a]
forall a. HasCallStack => [a] -> [a]
init [a]
xs
        oneMoreChar :: Char -> SearchMode -> m (Either Effect SearchMode)
oneMoreChar Char
c = Bool -> SearchMode -> m (Either Effect SearchMode)
forall (m :: * -> *).
MonadState HistLog m =>
Bool -> SearchMode -> m (Either Effect SearchMode)
doSearch Bool
True (SearchMode -> m (Either Effect SearchMode))
-> (SearchMode -> SearchMode)
-> SearchMode
-> m (Either Effect SearchMode)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> SearchMode -> SearchMode
addChar Char
c
        searchMore :: Direction -> SearchMode -> m (Either Effect SearchMode)
searchMore Direction
d SearchMode
s = Bool -> SearchMode -> m (Either Effect SearchMode)
forall (m :: * -> *).
MonadState HistLog m =>
Bool -> SearchMode -> m (Either Effect SearchMode)
doSearch Bool
False SearchMode
s {direction=d}


searchForPrefix :: MonadState HistLog m => Direction
                    -> Command m InsertMode InsertMode
searchForPrefix :: forall (m :: * -> *).
MonadState HistLog m =>
Direction -> Command m InsertMode InsertMode
searchForPrefix Direction
dir s :: InsertMode
s@(IMode [Grapheme]
xs [Grapheme]
_) = do
    Maybe InsertMode
next <- ([Grapheme] -> Maybe InsertMode)
-> Direction -> InsertMode -> CmdM m (Maybe InsertMode)
forall s (m :: * -> *).
(Save s, MonadState HistLog m) =>
([Grapheme] -> Maybe s) -> Direction -> s -> m (Maybe s)
findFirst [Grapheme] -> Maybe InsertMode
prefixed Direction
dir InsertMode
s
    CmdM m InsertMode
-> (InsertMode -> CmdM m InsertMode)
-> Maybe InsertMode
-> CmdM m InsertMode
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (InsertMode -> CmdM m InsertMode
forall a. a -> CmdM m a
forall (m :: * -> *) a. Monad m => a -> m a
return InsertMode
s) InsertMode -> CmdM m InsertMode
forall (m :: * -> *) s. (Monad m, LineState s) => Command m s s
setState Maybe InsertMode
next
  where
    prefixed :: [Grapheme] -> Maybe InsertMode
prefixed [Grapheme]
gs = if [Grapheme]
rxs [Grapheme] -> [Grapheme] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Grapheme]
gs
                    then InsertMode -> Maybe InsertMode
forall a. a -> Maybe a
Just (InsertMode -> Maybe InsertMode) -> InsertMode -> Maybe InsertMode
forall a b. (a -> b) -> a -> b
$ [Grapheme] -> [Grapheme] -> InsertMode
IMode [Grapheme]
xs (Int -> [Grapheme] -> [Grapheme]
forall a. Int -> [a] -> [a]
drop ([Grapheme] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Grapheme]
xs) [Grapheme]
gs)
                    else Maybe InsertMode
forall a. Maybe a
Nothing
    rxs :: [Grapheme]
rxs = [Grapheme] -> [Grapheme]
forall {a}. [a] -> [a]
reverse [Grapheme]
xs

-- Search for the first entry in the history which satisfies the constraint.
-- If it succeeds, the HistLog is updated and the result is returned.
-- If it fails, the HistLog is unchanged.
-- TODO: make the other history searching functions use this instead.
findFirst :: forall s m . (Save s, MonadState HistLog m)
    => ([Grapheme] -> Maybe s) -> Direction -> s -> m (Maybe s)
findFirst :: forall s (m :: * -> *).
(Save s, MonadState HistLog m) =>
([Grapheme] -> Maybe s) -> Direction -> s -> m (Maybe s)
findFirst [Grapheme] -> Maybe s
cond Direction
Forward s
s = m (Maybe s) -> m (Maybe s)
forall (m :: * -> *) b. MonadState HistLog m => m b -> m b
reverseHist (m (Maybe s) -> m (Maybe s)) -> m (Maybe s) -> m (Maybe s)
forall a b. (a -> b) -> a -> b
$ ([Grapheme] -> Maybe s) -> Direction -> s -> m (Maybe s)
forall s (m :: * -> *).
(Save s, MonadState HistLog m) =>
([Grapheme] -> Maybe s) -> Direction -> s -> m (Maybe s)
findFirst [Grapheme] -> Maybe s
cond Direction
Reverse s
s
findFirst [Grapheme] -> Maybe s
cond Direction
Reverse s
s = do
    HistLog
hist <- m HistLog
forall s (m :: * -> *). MonadState s m => m s
get
    case [([Grapheme], HistLog)] -> Maybe (s, HistLog)
search ([Grapheme] -> HistLog -> [([Grapheme], HistLog)]
prevHistories (s -> [Grapheme]
forall s. Save s => s -> [Grapheme]
listSave s
s) HistLog
hist) of
        Maybe (s, HistLog)
Nothing -> Maybe s -> m (Maybe s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe s
forall a. Maybe a
Nothing
        Just (s
s',HistLog
hist') -> HistLog -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put HistLog
hist' m () -> m (Maybe s) -> m (Maybe s)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe s -> m (Maybe s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (s -> Maybe s
forall a. a -> Maybe a
Just s
s')
  where
    search :: [([Grapheme],HistLog)] -> Maybe (s,HistLog)
    search :: [([Grapheme], HistLog)] -> Maybe (s, HistLog)
search [] = Maybe (s, HistLog)
forall a. Maybe a
Nothing
    search (([Grapheme]
g,HistLog
h):[([Grapheme], HistLog)]
gs) = case [Grapheme] -> Maybe s
cond [Grapheme]
g of
        Maybe s
Nothing -> [([Grapheme], HistLog)] -> Maybe (s, HistLog)
search [([Grapheme], HistLog)]
gs
        Just s
s' -> (s, HistLog) -> Maybe (s, HistLog)
forall a. a -> Maybe a
Just (s
s',HistLog
h)