{-# 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 (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ()) -> EditorM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ do
    [FBuffer]
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 :: YiString
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
    BufferRef
bufRef <- BufferId -> YiString -> EditorM BufferRef
forall (m :: * -> *).
MonadEditor m =>
BufferId -> YiString -> m BufferRef
stringToNewBuffer (Text -> BufferId
MemBuffer Text
"Buffer List") YiString
bufferList
    BufferRef -> EditorM ()
switchToBufferE BufferRef
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. Lens' (Mode syntax) (KeymapSet -> KeymapSet)
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. Lens' (Mode syntax) Text
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
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
  String
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 :: Text
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
  EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ()) -> EditorM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ Text -> EditorM ()
switchToBufferWithNameE Text
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 (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 (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
readOnlyA