{-# 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
  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'       = [(RegisterName, Register)] -> [(YiString, YiString)]
visualizeConvert [(RegisterName, Register)]
xs
      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
"--- Register ---\n" YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> [YiString] -> YiString
R.concat [YiString]
registers
  void $ newBufferE (MemBuffer "Register list") bufDetail
  where
    replaceName :: RegisterName -> String
replaceName RegisterName
n | RegisterName
n RegisterName -> RegisterName -> Bool
forall a. Eq a => a -> a -> Bool
== RegisterName
'\NUL' = String
"\\NUL | "
                  | Bool
otherwise   = [RegisterName
'"', RegisterName
n] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"   | "  -- Straighten diff of \NUL
    replaceContent :: String -> String
replaceContent = let replaceContentChar :: RegisterName -> String
replaceContentChar RegisterName
c | RegisterName
c RegisterName -> RegisterName -> Bool
forall a. Eq a => a -> a -> Bool
== RegisterName
'\n' = String
"^J"
                                              | Bool
otherwise = [RegisterName
c]
                     in (RegisterName -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap RegisterName -> String
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 :: String
content = YiString -> String
R.toString (YiString -> String)
-> (Register -> YiString) -> Register -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Register -> YiString
regContent (Register -> String) -> Register -> String
forall a b. (a -> b) -> a -> b
$ Register
reg
      in ( String -> YiString
R.fromString (String -> YiString)
-> (RegisterName -> String) -> RegisterName -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegisterName -> String
replaceName (RegisterName -> YiString) -> RegisterName -> YiString
forall a b. (a -> b) -> a -> b
$ RegisterName
name
         , String -> YiString
R.fromString (String -> YiString) -> (String -> String) -> String -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
replaceContent (String -> YiString) -> String -> YiString
forall a b. (a -> b) -> a -> b
$ String
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 -> Parser Text
P.string Text
"reg" Parser Text -> Parser Text -> Parser Text
forall a b. Parser Text a -> Parser Text b -> Parser Text a
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 a. Parser Text a -> Parser Text a -> Parser Text a
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 a. Parser Text a -> Parser Text a -> Parser Text a
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 a. Parser Text a -> Parser Text a -> Parser Text a
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 a. Parser Text a -> Parser Text a -> Parser Text a
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 a. Parser Text a -> Parser Text a -> Parser Text a
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 a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
P.string Text
""
                    )
                 Parser Text -> Parser Text () -> Parser Text
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
P.endOfInput
  return Common.pureExCommand
    { cmdShow   = "registers"
    , cmdAction = EditorA $ withEditor printRegisters
    }