    {-# LANGUAGE OverloadedStrings #-}
    {-# OPTIONS_HADDOCK show-extensions #-}

    -- |
    -- Module      :  Yi.Mode.Buffers
    -- License     :  GPL-2
    -- Maintainer  :  yi-devel@googlegroups.com
    -- Stability   :  experimental
    -- Portability :  portable
    --
    -- A minimalist emulation of emacs buffer menu mode, to be fleshed out later

    module Yi.Mode.Buffers (listBuffers) where

    import           Control.Category    ((>>>))
    import           Lens.Micro.Platform ((.=), (%~), (.~))
    import           Data.List.NonEmpty  (toList)
    import qualified Data.Text           as T (intercalate, pack)
    import           System.FilePath     (takeFileName)
    import           Yi.Buffer
    import           Yi.Editor
    import           Yi.Keymap           (Keymap, YiM, topKeymapA)
    import           Yi.Keymap.Keys
    import qualified Yi.Rope             as R (fromText, toString)

    -- | Retrieve buffer list and open a them in buffer mode using the
    -- 'bufferKeymap'.
    listBuffers :: YiM ()
    listBuffers :: YiM ()
    listBuffers = do
      EditorM () -> YiM ()
    forall a. EditorM a -> YiM a
    forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
    withEditor (EditorM () -> YiM ()) -> EditorM () -> YiM ()
    forall a b. (a -> b) -> a -> b
    $ do
        bs <- NonEmpty FBuffer -> [FBuffer]
    forall a. NonEmpty a -> [a]
    toList (NonEmpty FBuffer -> [FBuffer])
    -> EditorM (NonEmpty FBuffer) -> EditorM [FBuffer]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> EditorM (NonEmpty FBuffer)
    forall (m :: * -> *). MonadEditor m => m (NonEmpty FBuffer)
    getBufferStack
        let bufferList = Text -> YiString
    R.fromText (Text -> YiString) -> ([Text] -> Text) -> [Text] -> YiString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> [Text] -> Text
    T.intercalate Text
    "\n" ([Text] -> YiString) -> [Text] -> YiString
    forall a b. (a -> b) -> a -> b
    $ (FBuffer -> Text) -> [FBuffer] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map FBuffer -> Text
    identString [FBuffer]
    bs
        bufRef <- stringToNewBuffer (MemBuffer "Buffer List") bufferList
        switchToBufferE bufRef
      BufferM () -> YiM ()
    forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
    withCurrentBuffer (BufferM () -> YiM ()) -> BufferM () -> YiM ()
    forall a b. (a -> b) -> a -> b
    $ do
        (forall syntax. Mode syntax -> Mode syntax) -> BufferM ()
    modifyMode ((forall syntax. Mode syntax -> Mode syntax) -> BufferM ())
    -> (forall syntax. Mode syntax -> Mode syntax) -> BufferM ()
    forall a b. (a -> b) -> a -> b
    $ ((KeymapSet -> KeymapSet) -> Identity (KeymapSet -> KeymapSet))
    -> Mode syntax -> Identity (Mode syntax)
    forall syntax (f :: * -> *).
    Functor f =>
    ((KeymapSet -> KeymapSet) -> f (KeymapSet -> KeymapSet))
    -> Mode syntax -> f (Mode syntax)
    modeKeymapA (((KeymapSet -> KeymapSet) -> Identity (KeymapSet -> KeymapSet))
     -> Mode syntax -> Identity (Mode syntax))
    -> (KeymapSet -> KeymapSet) -> Mode syntax -> Mode syntax
    forall s t a b. ASetter s t a b -> b -> s -> t
    .~ (Keymap -> Identity Keymap) -> KeymapSet -> Identity KeymapSet
    Lens' KeymapSet Keymap
    topKeymapA ((Keymap -> Identity Keymap) -> KeymapSet -> Identity KeymapSet)
    -> (Keymap -> Keymap) -> KeymapSet -> KeymapSet
    forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
    %~ Keymap -> Keymap
    bufferKeymap
                     (Mode syntax -> Mode syntax)
    -> (Mode syntax -> Mode syntax) -> Mode syntax -> Mode syntax
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> (Text -> Identity Text) -> Mode syntax -> Identity (Mode syntax)
    forall syntax (f :: * -> *).
    Functor f =>
    (Text -> f Text) -> Mode syntax -> f (Mode syntax)
    modeNameA ((Text -> Identity Text) -> Mode syntax -> Identity (Mode syntax))
    -> Text -> Mode syntax -> Mode syntax
    forall s t a b. ASetter s t a b -> b -> s -> t
    .~ Text
    "buffers"
        (Bool -> Identity Bool) -> FBuffer -> Identity FBuffer
    forall c. HasAttributes c => Lens' c Bool
    Lens' FBuffer Bool
    readOnlyA ((Bool -> Identity Bool) -> FBuffer -> Identity FBuffer)
    -> Bool -> BufferM ()
    forall s (m :: * -> *) a b.
    MonadState s m =>
    ASetter s s a b -> b -> m ()
    .= Bool
    True

    -- | Switch to the buffer with name at current name. If it it starts
    -- with a @/@ then assume it's a file and try to open it that way.
    switch :: YiM ()
    switch :: YiM ()
    switch = do
      -- the YiString -> FilePath -> Text conversion sucks
      s <- YiString -> String
    R.toString (YiString -> String) -> YiM YiString -> YiM String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> BufferM YiString -> YiM YiString
    forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
    withCurrentBuffer BufferM YiString
    readLnB
      let short = String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ if Int -> String -> String
    forall a. Int -> [a] -> [a]
    take Int
    1 String
    s String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "/" then String -> String
    takeFileName String
    s else String
    s
      withEditor $ switchToBufferWithNameE short

    -- | Keymap for the buffer mode.
    --
    -- @
    -- __p__              → line up
    -- __n__ or __SPACE__ → line down
    -- __ENTER__ or __f__ → open buffer
    -- __v__              → open buffer as read-only
    -- @
    bufferKeymap :: Keymap -> Keymap
    bufferKeymap :: Keymap -> Keymap
    bufferKeymap = Keymap -> Keymap -> Keymap
    forall (f :: * -> *) w e a.
    MonadInteract f w e =>
    f a -> f a -> f a
    important (Keymap -> Keymap -> Keymap) -> Keymap -> Keymap -> Keymap
    forall a b. (a -> b) -> a -> b
    $ [Keymap] -> Keymap
    forall (m :: * -> *) w e a.
    (MonadInteract m w e, MonadFail m) =>
    [m a] -> m a
    choice
      [ Char -> Event
    char Char
    'p'                        Event -> BufferM () -> Keymap
    forall (m :: * -> *) a x.
    (MonadInteract m Action Event, YiAction a x, Show x) =>
    Event -> a -> m ()
    ?>>! BufferM ()
    lineUp
      , [Event] -> I Event Action Event
    forall event (m :: * -> *) w.
    (Ord event, MonadInteract m w event, MonadFail m) =>
    [event] -> m event
    oneOf [ Char -> Event
    char Char
    'n', Char -> Event
    char Char
    ' ' ]    I Event Action Event -> BufferM () -> Keymap
    forall (m :: * -> *) a x b.
    (MonadInteract m Action Event, YiAction a x, Show x) =>
    m b -> a -> m ()
    >>! BufferM ()
    lineDown
      , [Event] -> I Event Action Event
    forall event (m :: * -> *) w.
    (Ord event, MonadInteract m w event, MonadFail m) =>
    [event] -> m event
    oneOf [ Key -> Event
    spec Key
    KEnter, Char -> Event
    char Char
    'f' ] I Event Action Event -> YiM () -> Keymap
    forall (m :: * -> *) a x b.
    (MonadInteract m Action Event, YiAction a x, Show x) =>
    m b -> a -> m ()
    >>! (YiM ()
    switch YiM () -> YiM () -> YiM ()
    forall a b. YiM a -> YiM b -> YiM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> YiM ()
    setReadOnly Bool
    False)
      , Char -> Event
    char Char
    'v'                        Event -> YiM () -> Keymap
    forall (m :: * -> *) a x.
    (MonadInteract m Action Event, YiAction a x, Show x) =>
    Event -> a -> m ()
    ?>>! (YiM ()
    switch YiM () -> YiM () -> YiM ()
    forall a b. YiM a -> YiM b -> YiM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> YiM ()
    setReadOnly Bool
    True)
      ]
      where
        setReadOnly :: Bool -> YiM ()
    setReadOnly = BufferM () -> YiM ()
    forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
    withCurrentBuffer (BufferM () -> YiM ()) -> (Bool -> BufferM ()) -> Bool -> YiM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Bool -> Identity Bool) -> FBuffer -> Identity FBuffer)
    -> Bool -> BufferM ()
    forall s (m :: * -> *) a b.
    MonadState s m =>
    ASetter s s a b -> b -> m ()
    (.=) (Bool -> Identity Bool) -> FBuffer -> Identity FBuffer
    forall c. HasAttributes c => Lens' c Bool
    Lens' FBuffer Bool
    readOnlyA