{-# LANGUAGE CPP                 #-}
{-# LANGUAGE DeriveDataTypeable  #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE Rank2Types          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Yi.History
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- ‘Command history’ implementation.

module Yi.History where

import           Control.Applicative (liftA3)
import           Lens.Micro.Platform          (Lens', lens, set, (^.))
import           Data.Binary         (Binary, get, put)
import           Data.Default        (Default, def)
import           Data.List           (nub)
import qualified Data.Map            as M (Map, findWithDefault, insert, mapKeys)
import           Data.Monoid         ((<>))
import qualified Data.Text           as T (Text, isPrefixOf, null, pack, unpack)
import qualified Data.Text.Encoding  as E (decodeUtf8, encodeUtf8)
import           Data.Typeable       (Typeable)
import           Yi.Buffer           (elemsB, replaceBufferContent)
import           Yi.Editor
import qualified Yi.Rope             as R (fromText, toText)
import           Yi.Types            (YiVariable)

newtype Histories = Histories (M.Map T.Text History)
                  deriving (Int -> Histories -> ShowS
[Histories] -> ShowS
Histories -> String
(Int -> Histories -> ShowS)
-> (Histories -> String)
-> ([Histories] -> ShowS)
-> Show Histories
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Histories] -> ShowS
$cshowList :: [Histories] -> ShowS
show :: Histories -> String
$cshow :: Histories -> String
showsPrec :: Int -> Histories -> ShowS
$cshowsPrec :: Int -> Histories -> ShowS
Show, Histories -> Histories -> Bool
(Histories -> Histories -> Bool)
-> (Histories -> Histories -> Bool) -> Eq Histories
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Histories -> Histories -> Bool
$c/= :: Histories -> Histories -> Bool
== :: Histories -> Histories -> Bool
$c== :: Histories -> Histories -> Bool
Eq, Typeable)

instance Binary Histories where
  put :: Histories -> Put
put (Histories Map Text History
m) = Map String History -> Put
forall t. Binary t => t -> Put
put (Map String History -> Put) -> Map String History -> Put
forall a b. (a -> b) -> a -> b
$ (Text -> String) -> Map Text History -> Map String History
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys Text -> String
T.unpack Map Text History
m
  get :: Get Histories
get = Map Text History -> Histories
Histories (Map Text History -> Histories)
-> (Map String History -> Map Text History)
-> Map String History
-> Histories
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Text) -> Map String History -> Map Text History
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys String -> Text
T.pack (Map String History -> Histories)
-> Get (Map String History) -> Get Histories
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Map String History)
forall t. Binary t => Get t
get

instance Default Histories where
  def :: Histories
def = Map Text History -> Histories
Histories Map Text History
forall a. Default a => a
def

data History = History { History -> Int
_historyCurrent  :: Int
                       , History -> [Text]
_historyContents :: [T.Text]
                       , History -> Text
_historyPrefix   :: T.Text
                       } deriving (Int -> History -> ShowS
[History] -> ShowS
History -> String
(Int -> History -> ShowS)
-> (History -> String) -> ([History] -> ShowS) -> Show History
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [History] -> ShowS
$cshowList :: [History] -> ShowS
show :: History -> String
$cshow :: History -> String
showsPrec :: Int -> History -> ShowS
$cshowsPrec :: Int -> History -> ShowS
Show, History -> History -> Bool
(History -> History -> Bool)
-> (History -> History -> Bool) -> Eq History
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: History -> History -> Bool
$c/= :: History -> History -> Bool
== :: History -> History -> Bool
$c== :: History -> History -> Bool
Eq, Typeable)

instance Default History where
    def :: History
def = Int -> [Text] -> Text -> History
History (-Int
1) [] Text
forall a. Monoid a => a
mempty

instance Binary History where
  put :: History -> Put
put (History Int
cu [Text]
co Text
pr) =
    Int -> Put
forall t. Binary t => t -> Put
put Int
cu Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [ByteString] -> Put
forall t. Binary t => t -> Put
put ((Text -> ByteString) -> [Text] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Text -> ByteString
E.encodeUtf8 [Text]
co) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
forall t. Binary t => t -> Put
put (Text -> ByteString
E.encodeUtf8 Text
pr)
  get :: Get History
get = (Int -> [Text] -> Text -> History)
-> Get Int -> Get [Text] -> Get Text -> Get History
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 Int -> [Text] -> Text -> History
History Get Int
forall t. Binary t => Get t
get ((ByteString -> Text) -> [ByteString] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
E.decodeUtf8 ([ByteString] -> [Text]) -> Get [ByteString] -> Get [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [ByteString]
forall t. Binary t => Get t
get) (ByteString -> Text
E.decodeUtf8 (ByteString -> Text) -> Get ByteString -> Get Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
forall t. Binary t => Get t
get)

instance YiVariable Histories

dynKeyA :: (Default v, Ord k) => k -> Lens' (M.Map k v) v
dynKeyA :: k -> Lens' (Map k v) v
dynKeyA k
key = (Map k v -> v) -> (Map k v -> v -> Map k v) -> Lens' (Map k v) v
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (v -> k -> Map k v -> v
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault v
forall a. Default a => a
def k
key) ((v -> Map k v -> Map k v) -> Map k v -> v -> Map k v
forall a b c. (a -> b -> c) -> b -> a -> c
flip (k -> v -> Map k v -> Map k v
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
key))

miniBuffer :: T.Text
miniBuffer :: Text
miniBuffer = Text
"minibuffer"

historyUp :: EditorM ()
historyUp :: EditorM ()
historyUp = Text -> Int -> EditorM ()
historyMove Text
miniBuffer Int
1

historyDown :: EditorM ()
historyDown :: EditorM ()
historyDown = Text -> Int -> EditorM ()
historyMove Text
miniBuffer (-Int
1)

historyStart :: EditorM ()
historyStart :: EditorM ()
historyStart = Text -> EditorM ()
historyStartGen Text
miniBuffer

-- | Start an input session with History
historyStartGen :: T.Text -> EditorM ()
historyStartGen :: Text -> EditorM ()
historyStartGen Text
ident = do
  Histories Map Text History
histories <- EditorM Histories
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Default a, Functor m) =>
m a
getEditorDyn
  let (History Int
_cur [Text]
cont Text
pref) = Map Text History
histories Map Text History
-> Getting History (Map Text History) History -> History
forall s a. s -> Getting a s a -> a
^. Text -> Lens' (Map Text History) History
forall v k. (Default v, Ord k) => k -> Lens' (Map k v) v
dynKeyA Text
ident
  Text -> History -> Map Text History -> EditorM ()
forall (m :: * -> *).
(MonadEditor m, Functor m) =>
Text -> History -> Map Text History -> m ()
setHistory Text
ident (Int -> [Text] -> Text -> History
History Int
0 ([Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub (Text
""Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
cont)) Text
pref) Map Text History
histories

historyFinish :: EditorM ()
historyFinish :: EditorM ()
historyFinish = Text -> EditorM Text -> EditorM ()
historyFinishGen Text
miniBuffer (YiString -> Text
R.toText (YiString -> Text) -> EditorM YiString -> EditorM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM YiString -> EditorM YiString
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM YiString
elemsB)

-- | Finish the current input session with history.
historyFinishGen :: T.Text -> EditorM T.Text -> EditorM ()
historyFinishGen :: Text -> EditorM Text -> EditorM ()
historyFinishGen Text
ident EditorM Text
getCurValue = do
  Histories Map Text History
histories <- EditorM Histories
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Default a, Functor m) =>
m a
getEditorDyn
  let History Int
_cur [Text]
cont Text
pref = Map Text History
histories Map Text History
-> Getting History (Map Text History) History -> History
forall s a. s -> Getting a s a -> a
^. Text -> Lens' (Map Text History) History
forall v k. (Default v, Ord k) => k -> Lens' (Map k v) v
dynKeyA Text
ident
  Text
curValue <- EditorM Text
getCurValue
  let cont' :: [Text]
cont' = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Text
curValue Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==) ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Text -> Bool
T.null ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text]
cont
  Text
curValue Text -> EditorM () -> EditorM ()
`seq`        -- force the new value, otherwise we'll hold
                        -- on to the buffer from which it's computed
    [Text]
cont'         [Text] -> EditorM () -> EditorM ()
`seq` -- force checking the top of the history,
                        -- otherwise we'll build up thunks
    Text -> History -> Map Text History -> EditorM ()
forall (m :: * -> *).
(MonadEditor m, Functor m) =>
Text -> History -> Map Text History -> m ()
setHistory Text
ident (Int -> [Text] -> Text -> History
History (-Int
1) (Text
curValueText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
cont') Text
pref) Map Text History
histories

historyFind :: [T.Text] -> Int -> Int -> Int -> T.Text -> Int
historyFind :: [Text] -> Int -> Int -> Int -> Text -> Int
historyFind [Text]
cont Int
len Int
cur Int
delta Text
pref =
  case (Int
next Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0, Int
next Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len) of
    (Bool
True,Bool
_) -> Int
next
    (Bool
_,Bool
True) -> Int
next
    (Bool
_,Bool
_) -> if Text
pref Text -> Text -> Bool
`T.isPrefixOf` ([Text]
cont [Text] -> Int -> Text
forall a. [a] -> Int -> a
!! Int
next)
      then Int
next
      else [Text] -> Int -> Int -> Int -> Text -> Int
historyFind [Text]
cont Int
len Int
cur Int
deltaLarger Text
pref
  where
    next :: Int
next = Int
cur Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delta
    deltaLarger :: Int
deltaLarger = Int
delta Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall a. Num a => a -> a
signum Int
delta

historyMove :: T.Text -> Int -> EditorM ()
historyMove :: Text -> Int -> EditorM ()
historyMove Text
ident Int
delta = do
  Text
s <- Text -> Int -> EditorM Text -> EditorM Text
historyMoveGen Text
ident Int
delta (YiString -> Text
R.toText (YiString -> Text) -> EditorM YiString -> EditorM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM YiString -> EditorM YiString
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM YiString
elemsB)
  BufferM () -> EditorM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> EditorM ())
-> (Text -> BufferM ()) -> Text -> EditorM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> BufferM ()
replaceBufferContent (YiString -> BufferM ())
-> (Text -> YiString) -> Text -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> YiString
R.fromText (Text -> EditorM ()) -> Text -> EditorM ()
forall a b. (a -> b) -> a -> b
$ Text
s

historyMoveGen :: T.Text -> Int -> EditorM T.Text -> EditorM T.Text
historyMoveGen :: Text -> Int -> EditorM Text -> EditorM Text
historyMoveGen Text
ident Int
delta EditorM Text
getCurValue = do
  Histories Map Text History
histories <- EditorM Histories
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Default a, Functor m) =>
m a
getEditorDyn
  let History Int
cur [Text]
cont Text
pref = Map Text History
histories Map Text History
-> Getting History (Map Text History) History -> History
forall s a. s -> Getting a s a -> a
^. Text -> Lens' (Map Text History) History
forall v k. (Default v, Ord k) => k -> Lens' (Map k v) v
dynKeyA Text
ident

  Text
curValue <- EditorM Text
getCurValue
  let len :: Int
len = [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
cont
      next :: Int
next = [Text] -> Int -> Int -> Int -> Text -> Int
historyFind [Text]
cont Int
len Int
cur Int
delta Text
pref
      nextValue :: Text
nextValue = [Text]
cont [Text] -> Int -> Text
forall a. [a] -> Int -> a
!! Int
next
  case (Int
next Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0, Int
next Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len) of
    (Bool
True, Bool
_) -> do
      Text -> EditorM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> EditorM ()) -> Text -> EditorM ()
forall a b. (a -> b) -> a -> b
$ Text
"end of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ident Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" history, no next item."
      Text -> EditorM Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
curValue
    (Bool
_, Bool
True) -> do
      Text -> EditorM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> EditorM ()) -> Text -> EditorM ()
forall a b. (a -> b) -> a -> b
$ Text
"beginning of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ident Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" history, no previous item."
      Text -> EditorM Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
curValue
    (Bool
_,Bool
_) -> do
      let contents :: [Text]
contents = Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
cur [Text]
cont [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
curValue] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop (Int
cur Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Text]
cont
      Text -> History -> Map Text History -> EditorM ()
forall (m :: * -> *).
(MonadEditor m, Functor m) =>
Text -> History -> Map Text History -> m ()
setHistory Text
ident (Int -> [Text] -> Text -> History
History Int
next [Text]
contents Text
pref) Map Text History
histories
      Text -> EditorM Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
nextValue

historyPrefixSet :: T.Text -> EditorM ()
historyPrefixSet :: Text -> EditorM ()
historyPrefixSet = Text -> Text -> EditorM ()
historyPrefixSet' Text
miniBuffer

historyPrefixSet' :: T.Text -> T.Text -> EditorM ()
historyPrefixSet' :: Text -> Text -> EditorM ()
historyPrefixSet' Text
ident Text
pref = do
  Histories Map Text History
histories <- EditorM Histories
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Default a, Functor m) =>
m a
getEditorDyn
  let History Int
cur [Text]
cont Text
_pref = Map Text History
histories Map Text History
-> Getting History (Map Text History) History -> History
forall s a. s -> Getting a s a -> a
^. Text -> Lens' (Map Text History) History
forall v k. (Default v, Ord k) => k -> Lens' (Map k v) v
dynKeyA Text
ident
  Text -> History -> Map Text History -> EditorM ()
forall (m :: * -> *).
(MonadEditor m, Functor m) =>
Text -> History -> Map Text History -> m ()
setHistory Text
ident (Int -> [Text] -> Text -> History
History Int
cur [Text]
cont Text
pref) Map Text History
histories

-- | Helper that sets the given history at ident and 'putEditorDyn's
-- the result.
setHistory :: (MonadEditor m, Functor m) => T.Text -- ^ identifier
           -> History -- ^ History to set
           -> M.Map T.Text History -- ^ Map of existing histories
           -> m ()
setHistory :: Text -> History -> Map Text History -> m ()
setHistory Text
i History
h = Histories -> m ()
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Functor m) =>
a -> m ()
putEditorDyn (Histories -> m ())
-> (Map Text History -> Histories) -> Map Text History -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text History -> Histories
Histories (Map Text History -> Histories)
-> (Map Text History -> Map Text History)
-> Map Text History
-> Histories
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter (Map Text History) (Map Text History) History History
-> History -> Map Text History -> Map Text History
forall s t a b. ASetter s t a b -> b -> s -> t
set (Text -> Lens' (Map Text History) History
forall v k. (Default v, Ord k) => k -> Lens' (Map k v) v
dynKeyA Text
i) History
h