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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HistLog] -> ShowS
$cshowList :: [HistLog] -> ShowS
show :: HistLog -> String
$cshow :: HistLog -> String
showsPrec :: Int -> HistLog -> ShowS
$cshowsPrec :: Int -> HistLog -> ShowS
Show

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

prevHistories :: [Grapheme] -> HistLog -> [([Grapheme],HistLog)]
prevHistories :: [Grapheme] -> HistLog -> [([Grapheme], HistLog)]
prevHistories [Grapheme]
s HistLog
h = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr ([Grapheme]
s,HistLog
h) forall a b. (a -> b) -> a -> b
$ \([Grapheme]
s',HistLog
h') -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\([Grapheme], HistLog)
r -> (([Grapheme], HistLog)
r,([Grapheme], HistLog)
r))
                    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 = forall a b. (a -> b) -> [a] -> [b]
map String -> [Grapheme]
stringToGraphemes 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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef History
emptyHistory
    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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO History
readHistory String
file
    IORef History
historyRef <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef 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 <- forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (IORef History) m a
f IORef History
historyRef
            forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
`finally` (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef History
historyRef forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> History -> IO ()
writeHistory String
file)
    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') = forall a. a -> Maybe a -> a
fromMaybe (forall s. Save s => s -> [Grapheme]
listSave s
s,HistLog
h) 
                                    forall a b. (a -> b) -> a -> b
$ [Grapheme] -> HistLog -> Maybe ([Grapheme], HistLog)
prevHistoryM (forall s. Save s => s -> [Grapheme]
listSave s
s) HistLog
h
                  in (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 = (forall s. Save s => s -> [Grapheme]
listSave s
s,HistLog
h)forall a. a -> [a] -> [a]
:[Grapheme] -> HistLog -> [([Grapheme], HistLog)]
prevHistories (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') = forall a. [a] -> a
last [([Grapheme], HistLog)]
prevs
                   in (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 = forall s (m :: * -> *).
(LineState s, Monad m) =>
(s -> m (Either Effect s)) -> Command m s s
simpleCommand forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s t.
MonadState HistLog m =>
(s -> HistLog -> (t, HistLog)) -> s -> m (Either Effect t)
histUpdate forall s. Save s => s -> HistLog -> (s, HistLog)
prevHistory
historyForward :: forall s (m :: * -> *).
(Save s, MonadState HistLog m) =>
Command m s s
historyForward = forall s (m :: * -> *).
(LineState s, Monad m) =>
(s -> m (Either Effect s)) -> Command m s s
simpleCommand forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b. MonadState HistLog m => m b -> m b
reverseHist forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) s t.
MonadState HistLog m =>
(s -> HistLog -> (t, HistLog)) -> s -> m (Either Effect t)
histUpdate 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 = forall s (m :: * -> *).
(LineState s, Monad m) =>
(s -> m (Either Effect s)) -> Command m s s
simpleCommand forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s t.
MonadState HistLog m =>
(s -> HistLog -> (t, HistLog)) -> s -> m (Either Effect t)
histUpdate forall s. Save s => s -> HistLog -> (s, HistLog)
firstHistory
historyEnd :: forall s (m :: * -> *).
(Save s, MonadState HistLog m) =>
Command m s s
historyEnd = forall s (m :: * -> *).
(LineState s, Monad m) =>
(s -> m (Either Effect s)) -> Command m s s
simpleCommand forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b. MonadState HistLog m => m b -> m b
reverseHist forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) s t.
MonadState HistLog m =>
(s -> HistLog -> (t, HistLog)) -> s -> m (Either Effect t)
histUpdate 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 = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
update 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
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify HistLog -> HistLog
reverser
    b
y <- m b
f
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify HistLog -> HistLog
reverser
    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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SearchMode] -> ShowS
$cshowList :: [SearchMode] -> ShowS
show :: SearchMode -> String
$cshow :: SearchMode -> String
showsPrec :: Int -> SearchMode -> ShowS
$cshowsPrec :: Int -> SearchMode -> ShowS
Show

data Direction = Forward | Reverse
                    deriving (Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Direction] -> ShowS
$cshowList :: [Direction] -> ShowS
show :: Direction -> String
$cshow :: Direction -> String
showsPrec :: Int -> Direction -> ShowS
$cshowsPrec :: Int -> Direction -> ShowS
Show,Direction -> Direction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c== :: 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 = forall s. LineState s => [Grapheme] -> s -> [Grapheme]
beforeCursor [Grapheme]
prefix (SearchMode -> InsertMode
foundHistory SearchMode
sm)
        where 
            prefix :: [Grapheme]
prefix = String -> [Grapheme]
stringToGraphemes (String
"(" forall a. [a] -> [a] -> [a]
++ Direction -> String
directionName (SearchMode -> Direction
direction SearchMode
sm) forall a. [a] -> [a] -> [a]
++ String
")`")
                            forall a. [a] -> [a] -> [a]
++ SearchMode -> [Grapheme]
searchTerm SearchMode
sm forall a. [a] -> [a] -> [a]
++ String -> [Grapheme]
stringToGraphemes String
"': "
    afterCursor :: SearchMode -> [Grapheme]
afterCursor = forall s. LineState s => s -> [Grapheme]
afterCursor forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchMode -> InsertMode
foundHistory

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

saveSM :: SearchMode -> [Grapheme]
saveSM :: SearchMode -> [Grapheme]
saveSM = forall s. Save s => s -> [Grapheme]
listSave 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 :: [Grapheme]
searchTerm = forall s. Save s => s -> [Grapheme]
listSave forall a b. (a -> b) -> a -> b
$ Char -> InsertMode -> InsertMode
insertChar Char
c 
                                forall a b. (a -> b) -> a -> b
$ forall s. Save s => [Grapheme] -> s
listRestore forall a b. (a -> b) -> a -> b
$ SearchMode -> [Grapheme]
searchTerm SearchMode
s}

searchHistories :: Direction -> [Grapheme] -> [([Grapheme],HistLog)]
            -> Maybe (SearchMode,HistLog)
searchHistories :: Direction
-> [Grapheme]
-> [([Grapheme], HistLog)]
-> Maybe (SearchMode, HistLog)
searchHistories Direction
dir [Grapheme]
text = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map 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
            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]
_ [] = forall a. Maybe a
Nothing
        find' [Grapheme]
prev ccs :: [Grapheme]
ccs@(Grapheme
c:[Grapheme]
cs)
            | [Grapheme]
text forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Grapheme]
ccs = forall a. a -> Maybe a
Just ([Grapheme] -> [Grapheme] -> InsertMode
IMode [Grapheme]
prev [Grapheme]
ccs)
            | Bool
otherwise = [Grapheme] -> [Grapheme] -> Maybe InsertMode
find' (Grapheme
cforall 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)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 -> 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 <- 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') -> forall s (m :: * -> *). MonadState s m => s -> m ()
put HistLog
hist' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right SearchMode
sm')
            Maybe (SearchMode, HistLog)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 = forall a. [KeyMap a] -> KeyMap a
choiceCmd [
            Char -> Key
metaChar Char
'j' forall a. Key -> a -> KeyMap a
+> forall (m :: * -> *).
MonadState HistLog m =>
Direction -> Command m InsertMode InsertMode
searchForPrefix Direction
Forward
            , Char -> Key
metaChar Char
'k' forall a. Key -> a -> KeyMap a
+> forall (m :: * -> *).
MonadState HistLog m =>
Direction -> Command m InsertMode InsertMode
searchForPrefix Direction
Reverse
            , forall a. [KeyMap a] -> KeyMap a
choiceCmd [
                 Key
backKey forall a. Key -> a -> KeyMap a
+> forall t (m :: * -> *) s.
(LineState t, Monad m) =>
(s -> t) -> Command m s t
change (Direction -> InsertMode -> SearchMode
startSearchMode Direction
Reverse)
                 , Key
forwardKey forall a. Key -> a -> KeyMap a
+> forall t (m :: * -> *) s.
(LineState t, Monad m) =>
(s -> t) -> Command m s t
change (Direction -> InsertMode -> SearchMode
startSearchMode Direction
Forward)
                 ] 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 = forall (m :: * -> *) s t. [KeyCommand m s t] -> Command m s t
keyChoiceCmd [
                            forall a. [KeyMap a] -> KeyMap a
choiceCmd [
                                forall s (m :: * -> *).
(LineState s, Monad m) =>
(Char -> s -> m (Either Effect s)) -> KeyCommand m s s
charCommand forall {m :: * -> *}.
MonadState HistLog m =>
Char -> SearchMode -> m (Either Effect SearchMode)
oneMoreChar
                                , Key
backKey forall a. Key -> a -> KeyMap a
+> forall s (m :: * -> *).
(LineState s, Monad m) =>
(s -> m (Either Effect s)) -> Command m s s
simpleCommand (forall {m :: * -> *}.
MonadState HistLog m =>
Direction -> SearchMode -> m (Either Effect SearchMode)
searchMore Direction
Reverse)
                                , Key
forwardKey forall a. Key -> a -> KeyMap a
+> forall s (m :: * -> *).
(LineState s, Monad m) =>
(s -> m (Either Effect s)) -> Command m s s
simpleCommand (forall {m :: * -> *}.
MonadState HistLog m =>
Direction -> SearchMode -> m (Either Effect SearchMode)
searchMore Direction
Forward)
                                , BaseKey -> Key
simpleKey BaseKey
Backspace forall a. Key -> a -> KeyMap a
+> forall t (m :: * -> *) s.
(LineState t, Monad m) =>
(s -> t) -> Command m s t
change SearchMode -> SearchMode
delLastChar
                                ] forall (m :: * -> *) s t u.
Monad m =>
KeyCommand m s t -> Command m t u -> KeyCommand m s u
>+> Command m SearchMode InsertMode
keepSearching
                            , forall (m :: * -> *) s t. Command m s t -> KeyCommand m s t
withoutConsuming (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 :: [Grapheme]
searchTerm = forall {a}. [a] -> [a]
minit (SearchMode -> [Grapheme]
searchTerm SearchMode
s)}
        minit :: [a] -> [a]
minit [a]
xs = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs then [] else forall {a}. [a] -> [a]
init [a]
xs
        oneMoreChar :: Char -> SearchMode -> m (Either Effect SearchMode)
oneMoreChar Char
c = forall (m :: * -> *).
MonadState HistLog m =>
Bool -> SearchMode -> m (Either Effect SearchMode)
doSearch Bool
True 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 = forall (m :: * -> *).
MonadState HistLog m =>
Bool -> SearchMode -> m (Either Effect SearchMode)
doSearch Bool
False SearchMode
s {direction :: Direction
direction=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 <- 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
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return InsertMode
s) 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 forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Grapheme]
gs
                    then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Grapheme] -> [Grapheme] -> InsertMode
IMode [Grapheme]
xs (forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Grapheme]
xs) [Grapheme]
gs)
                    else forall a. Maybe a
Nothing
    rxs :: [Grapheme]
rxs = 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 = forall (m :: * -> *) b. MonadState HistLog m => m b -> m b
reverseHist forall a b. (a -> b) -> a -> b
$ 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 <- forall s (m :: * -> *). MonadState s m => m s
get
    case [([Grapheme], HistLog)] -> Maybe (s, HistLog)
search ([Grapheme] -> HistLog -> [([Grapheme], HistLog)]
prevHistories (forall s. Save s => s -> [Grapheme]
listSave s
s) HistLog
hist) of
        Maybe (s, HistLog)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        Just (s
s',HistLog
hist') -> forall s (m :: * -> *). MonadState s m => s -> m ()
put HistLog
hist' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just s
s')
  where
    search :: [([Grapheme],HistLog)] -> Maybe (s,HistLog)
    search :: [([Grapheme], HistLog)] -> Maybe (s, HistLog)
search [] = 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' -> forall a. a -> Maybe a
Just (s
s',HistLog
h)