{-# OPTIONS_HADDOCK show-extensions #-}
{-# language RankNTypes #-}

-- |
-- Module      :  Yi.Keymap.Emacs.KillRing
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable

module Yi.Keymap.Emacs.KillRing where

import           Lens.Micro.Platform (use, (%=), (.=), Getting)
import           Control.Monad       (replicateM_, when)
import           Control.Monad.State.Class (MonadState)
import           Data.List.NonEmpty  (NonEmpty ((:|)))
import           Data.Maybe          (fromMaybe)
import           Yi.Buffer
import           Yi.Editor           (EditorM, killringA, withCurrentBuffer)
import           Yi.Keymap           (YiM)
import           Yi.KillRing         (Killring (_krContents), krKilled, krPut)
import qualified Yi.Rope             as R (YiString, fromString, toString)
import           Yi.Types            (withEditor)
import           Yi.Utils            (io)
import           System.Hclip        (getClipboard, setClipboard)

uses :: forall a b f s. MonadState s f => Getting a s a -> (a -> b) -> f b
uses :: forall a b (f :: * -> *) s.
MonadState s f =>
Getting a s a -> (a -> b) -> f b
uses Getting a s a
l a -> b
f = a -> b
f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting a s a -> f a
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting a s a
l

-- * Killring actions

-- | Adds system clipboard's contents on top of the killring if not already there
clipboardToKillring :: YiM ()
clipboardToKillring :: YiM ()
clipboardToKillring = do
  text <- (String -> YiString) -> YiM String -> YiM YiString
forall a b. (a -> b) -> YiM a -> YiM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> YiString
R.fromString (YiM String -> YiM YiString) -> YiM String -> YiM YiString
forall a b. (a -> b) -> a -> b
$ IO String -> YiM String
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io IO String
getClipboard
  withEditor $ do
    text' <- killringGet
    when (text' /= text) $ killringPut Forward text

-- | Adds the top of the killring to the system clipboard
killringToClipboard :: YiM ()
killringToClipboard :: YiM ()
killringToClipboard = do
  text <- EditorM YiString -> YiM YiString
forall a. EditorM a -> YiM a
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM YiString
killringGet
  io . setClipboard $ R.toString text

-- This is like @kill-region-or-backward-word@.
killRegionB :: BufferM ()
killRegionB :: BufferM ()
killRegionB = BufferM Region
getSelectRegionB BufferM Region -> (Region -> BufferM ()) -> BufferM ()
forall a b. BufferM a -> (a -> BufferM b) -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Region
r ->
  if Region -> Point
regionStart Region
r Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Region -> Point
regionEnd Region
r then BufferM ()
bkillWordB else Region -> BufferM ()
deleteRegionB Region
r

-- | C-w
-- Like `killRegionB`, but with system clipboard synchronization
killRegion :: YiM ()
killRegion :: YiM ()
killRegion = BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM ()
killRegionB YiM () -> YiM () -> YiM ()
forall a b. YiM a -> YiM b -> YiM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> YiM ()
killringToClipboard

-- | Kills current line
killLineB :: Maybe Int -> BufferM ()
killLineB :: Maybe Int -> BufferM ()
killLineB Maybe Int
mbr = Int -> BufferM () -> BufferM ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 Maybe Int
mbr) (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ do
  eol <- BufferM Bool
atEol
  let tu = if Bool
eol then TextUnit
Character else TextUnit
Line
  deleteRegionB =<< regionOfPartNonEmptyB tu Forward

-- | C-k
-- | Like `killLineB`, but with system clipboard synchronization
killLine :: Maybe Int -> YiM ()
killLine :: Maybe Int -> YiM ()
killLine Maybe Int
mbr = BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (Maybe Int -> BufferM ()
killLineB Maybe Int
mbr) YiM () -> YiM () -> YiM ()
forall a b. YiM a -> YiM b -> YiM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> YiM ()
killringToClipboard

killringGet :: EditorM R.YiString
killringGet :: EditorM YiString
killringGet = do
  text :| _ <- Getting Killring Editor Killring
-> (Killring -> NonEmpty YiString) -> EditorM (NonEmpty YiString)
forall a b (f :: * -> *) s.
MonadState s f =>
Getting a s a -> (a -> b) -> f b
uses Getting Killring Editor Killring
Lens' Editor Killring
killringA Killring -> NonEmpty YiString
_krContents
  return text

killringPut :: Direction -> R.YiString -> EditorM ()
killringPut :: Direction -> YiString -> EditorM ()
killringPut Direction
dir YiString
s = (Killring -> Identity Killring) -> Editor -> Identity Editor
Lens' Editor Killring
killringA ((Killring -> Identity Killring) -> Editor -> Identity Editor)
-> (Killring -> Killring) -> EditorM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Direction -> YiString -> Killring -> Killring
krPut Direction
dir YiString
s

-- | Yanks top of killbuffer
yankE :: EditorM ()
yankE :: EditorM ()
yankE = do
  text :| _ <- Getting Killring Editor Killring
-> (Killring -> NonEmpty YiString) -> EditorM (NonEmpty YiString)
forall a b (f :: * -> *) s.
MonadState s f =>
Getting a s a -> (a -> b) -> f b
uses Getting Killring Editor Killring
Lens' Editor Killring
killringA Killring -> NonEmpty YiString
_krContents
  withCurrentBuffer $ pointB >>= setSelectionMarkPointB >> insertN text

-- | C-y
-- Like `yankE`, but with system clipboard synchronization
yank :: YiM ()
yank :: YiM ()
yank = YiM ()
clipboardToKillring YiM () -> YiM () -> YiM ()
forall a b. YiM a -> YiM b -> YiM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EditorM () -> YiM ()
forall a. EditorM a -> YiM a
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM ()
yankE

-- | Saves current selection to killring and then clears it
killRingSaveE :: EditorM ()
killRingSaveE :: EditorM ()
killRingSaveE = do
  (r, text) <- BufferM (Region, YiString) -> EditorM (Region, YiString)
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM (Region, YiString) -> EditorM (Region, YiString))
-> BufferM (Region, YiString) -> EditorM (Region, YiString)
forall a b. (a -> b) -> a -> b
$ do
    r <- BufferM Region
getSelectRegionB
    text <- readRegionB r
    highlightSelectionA .= False
    return (r, text)
  killringPut (regionDirection r) text

-- | M-w
-- Like `killRingSaveE`, but with system clipboard synchronization
killRingSave :: YiM ()
killRingSave :: YiM ()
killRingSave = EditorM () -> YiM ()
forall a. EditorM a -> YiM a
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM ()
killRingSaveE YiM () -> YiM () -> YiM ()
forall a b. YiM a -> YiM b -> YiM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> YiM ()
killringToClipboard

-- | M-y
-- TODO: Handle argument, verify last command was a yank
yankPopE :: EditorM ()
yankPopE :: EditorM ()
yankPopE = do
  kr <- Getting Killring Editor Killring -> EditorM Killring
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Killring Editor Killring
Lens' Editor Killring
killringA
  withCurrentBuffer (deleteRegionB =<< getRawestSelectRegionB)
  killringA .= let x :| xs = _krContents kr
               in kr { _krContents = case xs of
                          [] -> YiString
x YiString -> [YiString] -> NonEmpty YiString
forall a. a -> [a] -> NonEmpty a
:| []
                          YiString
y:[YiString]
ys -> YiString
y YiString -> [YiString] -> NonEmpty YiString
forall a. a -> [a] -> NonEmpty a
:| [YiString]
ys [YiString] -> [YiString] -> [YiString]
forall a. [a] -> [a] -> [a]
++ [YiString
x]
                     }
  yankE

-- | C-M-w
appendNextKillE :: EditorM ()
appendNextKillE :: EditorM ()
appendNextKillE = (Killring -> Identity Killring) -> Editor -> Identity Editor
Lens' Editor Killring
killringA ((Killring -> Identity Killring) -> Editor -> Identity Editor)
-> ((Bool -> Identity Bool) -> Killring -> Identity Killring)
-> (Bool -> Identity Bool)
-> Editor
-> Identity Editor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool) -> Killring -> Identity Killring
Lens' Killring Bool
krKilled ((Bool -> Identity Bool) -> Editor -> Identity Editor)
-> Bool -> EditorM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True