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

-- |
-- Module      :  Yi.Keymap.Vim.Ex.Commands.BufferDelete
-- License     :  GPL-2
--
-- :reg[isters] ex command to list yanked texts.
module Yi.Keymap.Vim.Ex.Commands.Registers (printRegisters, parse) where

import           Control.Applicative              (Alternative ((<|>)))
import           Control.Monad                    (void)
import           Data.Monoid                      ((<>))
import           Yi.Keymap                        (Action (EditorA))
import           Yi.Keymap.Vim.Ex.Types           (ExCommand (cmdAction, cmdShow))
import           Yi.Keymap.Vim.Common             (EventString, RegisterName, Register (regContent), VimState (vsRegisterMap))
import           Yi.Editor                        (EditorM, getEditorDyn, newBufferE)
import           Yi.Rope                          (YiString)
import           Yi.Types                         (withEditor, BufferId (MemBuffer))
import qualified Data.Attoparsec.Text             as P (string, try, endOfInput)
import qualified Data.HashMap.Strict              as HM (toList)
import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (parse, pureExCommand)
import qualified Yi.Rope                          as R (concat, toString, fromString)


-- | Show registered register and content in new buffer
printRegisters :: EditorM ()
printRegisters :: EditorM ()
printRegisters = do
  [(RegisterName, Register)]
xs <- HashMap RegisterName Register -> [(RegisterName, Register)]
forall k v. HashMap k v -> [(k, v)]
HM.toList (HashMap RegisterName Register -> [(RegisterName, Register)])
-> (VimState -> HashMap RegisterName Register)
-> VimState
-> [(RegisterName, Register)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VimState -> HashMap RegisterName Register
vsRegisterMap (VimState -> [(RegisterName, Register)])
-> EditorM VimState -> EditorM [(RegisterName, Register)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EditorM VimState
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Default a, Functor m) =>
m a
getEditorDyn
  let xs' :: [(YiString, YiString)]
xs'       = [(RegisterName, Register)] -> [(YiString, YiString)]
visualizeConvert [(RegisterName, Register)]
xs
      registers :: [YiString]
registers = (((YiString, YiString) -> YiString)
 -> [(YiString, YiString)] -> [YiString])
-> [(YiString, YiString)]
-> ((YiString, YiString) -> YiString)
-> [YiString]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((YiString, YiString) -> YiString)
-> [(YiString, YiString)] -> [YiString]
forall a b. (a -> b) -> [a] -> [b]
map [(YiString, YiString)]
xs' (((YiString, YiString) -> YiString) -> [YiString])
-> ((YiString, YiString) -> YiString) -> [YiString]
forall a b. (a -> b) -> a -> b
$ \(YiString
nameWithSep, YiString
content) -> YiString
nameWithSep YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString
content YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString
"\n"
      bufDetail :: YiString
bufDetail = YiString
"--- Register ---\n" YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> [YiString] -> YiString
R.concat [YiString]
registers
  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
"Register list") YiString
bufDetail
  where
    replaceName :: RegisterName -> [RegisterName]
replaceName RegisterName
n | RegisterName
n RegisterName -> RegisterName -> Bool
forall a. Eq a => a -> a -> Bool
== RegisterName
'\NUL' = [RegisterName]
"\\NUL | "
                  | Bool
otherwise   = [RegisterName
'"', RegisterName
n] [RegisterName] -> [RegisterName] -> [RegisterName]
forall a. [a] -> [a] -> [a]
++ [RegisterName]
"   | "  -- Straighten diff of \NUL
    replaceContent :: [RegisterName] -> [RegisterName]
replaceContent = let replaceContentChar :: RegisterName -> [RegisterName]
replaceContentChar RegisterName
c | RegisterName
c RegisterName -> RegisterName -> Bool
forall a. Eq a => a -> a -> Bool
== RegisterName
'\n' = [RegisterName]
"^J"
                                              | Bool
otherwise = [RegisterName
c]
                     in (RegisterName -> [RegisterName])
-> [RegisterName] -> [RegisterName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap RegisterName -> [RegisterName]
replaceContentChar
    visualizeConvert :: [(RegisterName, Register)] -> [(YiString, YiString)]
    visualizeConvert :: [(RegisterName, Register)] -> [(YiString, YiString)]
visualizeConvert = ((RegisterName, Register) -> (YiString, YiString))
-> [(RegisterName, Register)] -> [(YiString, YiString)]
forall a b. (a -> b) -> [a] -> [b]
map (((RegisterName, Register) -> (YiString, YiString))
 -> [(RegisterName, Register)] -> [(YiString, YiString)])
-> ((RegisterName, Register) -> (YiString, YiString))
-> [(RegisterName, Register)]
-> [(YiString, YiString)]
forall a b. (a -> b) -> a -> b
$ \(RegisterName
name, Register
reg) ->
      let content :: [RegisterName]
content = YiString -> [RegisterName]
R.toString (YiString -> [RegisterName])
-> (Register -> YiString) -> Register -> [RegisterName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Register -> YiString
regContent (Register -> [RegisterName]) -> Register -> [RegisterName]
forall a b. (a -> b) -> a -> b
$ Register
reg
      in ( [RegisterName] -> YiString
R.fromString ([RegisterName] -> YiString)
-> (RegisterName -> [RegisterName]) -> RegisterName -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegisterName -> [RegisterName]
replaceName (RegisterName -> YiString) -> RegisterName -> YiString
forall a b. (a -> b) -> a -> b
$ RegisterName
name
         , [RegisterName] -> YiString
R.fromString ([RegisterName] -> YiString)
-> ([RegisterName] -> [RegisterName]) -> [RegisterName] -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RegisterName] -> [RegisterName]
replaceContent ([RegisterName] -> YiString) -> [RegisterName] -> YiString
forall a b. (a -> b) -> a -> b
$ [RegisterName]
content
         )


-- | See :help :registers on Vim
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
  Text
_ <- Text -> Parser Text
P.string Text
"reg" Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (     Parser Text -> Parser Text
forall i a. Parser i a -> Parser i a
P.try (Text -> Parser Text
P.string Text
"isters")
                      Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text -> Parser Text
forall i a. Parser i a -> Parser i a
P.try (Text -> Parser Text
P.string Text
"ister")
                      Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text -> Parser Text
forall i a. Parser i a -> Parser i a
P.try (Text -> Parser Text
P.string Text
"iste")
                      Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text -> Parser Text
forall i a. Parser i a -> Parser i a
P.try (Text -> Parser Text
P.string Text
"ist")
                      Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text -> Parser Text
forall i a. Parser i a -> Parser i a
P.try (Text -> Parser Text
P.string Text
"is")
                      Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text -> Parser Text
forall i a. Parser i a -> Parser i a
P.try (Text -> Parser Text
P.string Text
"i")
                      Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
P.string Text
""
                    )
                 Parser Text -> Parser Text () -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
P.endOfInput
  ExCommand -> Parser ExCommand
forall (m :: * -> *) a. Monad m => a -> m a
return ExCommand
Common.pureExCommand
    { cmdShow :: Text
cmdShow   = Text
"registers"
    , 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 ()
printRegisters
    }