    {-# 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
    $cshowsPrec :: Int -> Histories -> ShowS
    showsPrec :: Int -> Histories -> ShowS
    $cshow :: Histories -> String
    show :: Histories -> String
    $cshowList :: [Histories] -> ShowS
    showList :: [Histories] -> ShowS
    Show, Histories -> Histories -> Bool
    (Histories -> Histories -> Bool)
    -> (Histories -> Histories -> Bool) -> Eq Histories
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Histories -> Histories -> Bool
    == :: Histories -> Histories -> Bool
    $c/= :: Histories -> Histories -> Bool
    /= :: 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
    $cshowsPrec :: Int -> History -> ShowS
    showsPrec :: Int -> History -> ShowS
    $cshow :: History -> String
    show :: History -> String
    $cshowList :: [History] -> ShowS
    showList :: [History] -> ShowS
    Show, History -> History -> Bool
    (History -> History -> Bool)
    -> (History -> History -> Bool) -> Eq History
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: History -> History -> Bool
    == :: History -> History -> Bool
    $c/= :: History -> History -> Bool
    /= :: 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 a b. PutM a -> PutM b -> PutM b
    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 a b. PutM a -> PutM b -> PutM b
    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 a b. (a -> b) -> [a] -> [b]
    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 :: forall v k. (Default v, Ord k) => k -> Lens' (Map k v) v
    dynKeyA k
    key = (Map k v -> v)
    -> (Map k v -> v -> Map k v) -> Lens (Map k v) (Map k v) 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 histories <- EditorM Histories
    forall (m :: * -> *) a.
    (MonadEditor m, YiVariable a, Default a, Functor m) =>
    m a
    getEditorDyn
      let (History _cur cont pref) = histories ^. dynKeyA ident
      setHistory ident (History 0 (nub ("":cont)) pref) 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 histories <- EditorM Histories
    forall (m :: * -> *) a.
    (MonadEditor m, YiVariable a, Default a, Functor m) =>
    m a
    getEditorDyn
      let History _cur cont pref = histories ^. dynKeyA ident
      curValue <- getCurValue
      let 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
      curValue `seq`        -- force the new value, otherwise we'll hold
                            -- on to the buffer from which it's computed
        cont'         `seq` -- force checking the top of the history,
                            -- otherwise we'll build up thunks
        setHistory ident (History (-1) (curValue:cont') pref) 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. HasCallStack => [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
      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)
      withCurrentBuffer . replaceBufferContent . R.fromText $ 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 histories <- EditorM Histories
    forall (m :: * -> *) a.
    (MonadEditor m, YiVariable a, Default a, Functor m) =>
    m a
    getEditorDyn
      let History cur cont pref = histories ^. dynKeyA ident

      curValue <- getCurValue
      let len = [Text] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Text]
    cont
          next = [Text] -> Int -> Int -> Int -> Text -> Int
    historyFind [Text]
    cont Int
    len Int
    cur Int
    delta Text
    pref
          nextValue = [Text]
    cont [Text] -> Int -> Text
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    next
      case (next < 0, next >= 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 a. a -> EditorM a
    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 a. a -> EditorM a
    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 a. a -> EditorM a
    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 histories <- EditorM Histories
    forall (m :: * -> *) a.
    (MonadEditor m, YiVariable a, Default a, Functor m) =>
    m a
    getEditorDyn
      let History cur cont _pref = histories ^. dynKeyA ident
      setHistory ident (History cur cont pref) 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 :: forall (m :: * -> *).
    (MonadEditor m, Functor m) =>
    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