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

-- |
-- Module      :  Yi.Keymap.Vim.Ex.Commands.BufferDelete
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- :buffers or :ls ex command to list buffers.
module Yi.Keymap.Vim.Ex.Commands.Buffers (parse) where

import           Control.Applicative              (Alternative ((<|>)))
import           Lens.Micro.Platform                     (view)
import           Control.Monad                    (void)
import qualified Data.Attoparsec.Text             as P (string, try)
import qualified Data.Map                         as M (elems, mapWithKey)
import qualified Data.Text                        as T (intercalate, pack, unlines)
import           Yi.Buffer.Basic                  (BufferRef (BufferRef))
import           Yi.Buffer.Misc                   (BufferId (MemBuffer), identA)
import           Yi.Editor
import           Yi.Keymap                        (Action (EditorA))
import           Yi.Keymap.Vim.Common             (EventString)
import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (parse, pureExCommand)
import           Yi.Keymap.Vim.Ex.Types           (ExCommand (cmdAction, cmdShow))
import           Yi.Monad                         (gets)
import           Yi.Rope                          (fromText)

parse :: EventString -> Maybe ExCommand
parse :: EventString -> Maybe ExCommand
parse = Parser ExCommand -> EventString -> Maybe ExCommand
Common.parse (Parser ExCommand -> EventString -> Maybe ExCommand)
-> Parser ExCommand -> EventString -> Maybe ExCommand
forall a b. (a -> b) -> a -> b
$ do
    Parser Text Text -> Parser Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text Text -> Parser Text ())
-> Parser Text Text -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Parser Text Text -> Parser Text Text
forall i a. Parser i a -> Parser i a
P.try ( Text -> Parser Text Text
P.string Text
"buffers") Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Text -> Parser Text Text
forall i a. Parser i a -> Parser i a
P.try ( Text -> Parser Text Text
P.string Text
"ls") Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Text -> Parser Text Text
forall i a. Parser i a -> Parser i a
P.try ( Text -> Parser Text Text
P.string Text
"files" )
    ExCommand -> Parser ExCommand
forall (m :: * -> *) a. Monad m => a -> m a
return (ExCommand -> Parser ExCommand) -> ExCommand -> Parser ExCommand
forall a b. (a -> b) -> a -> b
$ ExCommand
Common.pureExCommand {
        cmdShow :: Text
cmdShow = Text
"buffers"
      , cmdAction :: Action
cmdAction = EditorM () -> Action
forall a. Show a => EditorM a -> Action
EditorA (EditorM () -> Action) -> EditorM () -> Action
forall a b. (a -> b) -> a -> b
$ EditorM () -> EditorM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM ()
printBuffers
      }

printBuffers :: EditorM ()
printBuffers :: EditorM ()
printBuffers = do
    -- TODO Don't keep recreating new buffers. Use a pre-existing one.
    --      See the cabal buffer used in Command.hs for an example.
    -- TODO Add some simple keymaps to the buffer, like <CR> to open the buffer?
    Map BufferRef FBuffer
bufs <- (Editor -> Map BufferRef FBuffer)
-> EditorM (Map BufferRef FBuffer)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Editor -> Map BufferRef FBuffer
buffers
    let bufLines :: [Text]
bufLines = Map BufferRef Text -> [Text]
forall k a. Map k a -> [a]
M.elems (Map BufferRef Text -> [Text]) -> Map BufferRef Text -> [Text]
forall a b. (a -> b) -> a -> b
$ (BufferRef -> FBuffer -> Text)
-> Map BufferRef FBuffer -> Map BufferRef Text
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey BufferRef -> FBuffer -> Text
forall s. HasAttributes s => BufferRef -> s -> Text
bufLine Map BufferRef FBuffer
bufs
    if [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
bufLines Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
      then EditorM () -> EditorM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> EditorM ())
-> (EditorM BufferRef -> EditorM ())
-> EditorM BufferRef
-> EditorM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditorM BufferRef -> EditorM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (EditorM BufferRef -> EditorM ())
-> EditorM BufferRef -> EditorM ()
forall a b. (a -> b) -> a -> b
$
             BufferId -> YiString -> EditorM BufferRef
newBufferE (Text -> BufferId
MemBuffer Text
"Buffer list")
                        (Text -> YiString
fromText (Text -> YiString) -> Text -> YiString
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines [Text]
bufLines)
      else [Text] -> EditorM ()
forall (m :: * -> *). MonadEditor m => [Text] -> m ()
printMsgs [Text]
bufLines
  where
    tab :: Text
tab = String -> Text
T.pack String
"\t"
    -- TODO shorten this name string perhaps.
    -- TODO Add more information: modified status, line number.
    bufLine :: BufferRef -> s -> Text
bufLine (BufferRef Int
bufNum) s
buf =
        Text -> [Text] -> Text
T.intercalate Text
tab [ String -> Text
T.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int
bufNum
                          , String -> Text
T.pack (String -> Text) -> (s -> String) -> s -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BufferId -> String
forall a. Show a => a -> String
show (BufferId -> String) -> (s -> BufferId) -> s -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting BufferId s BufferId -> s -> BufferId
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting BufferId s BufferId
forall c. HasAttributes c => Lens' c BufferId
identA (s -> Text) -> s -> Text
forall a b. (a -> b) -> a -> b
$ s
buf
                          ]