{-# 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 :: 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
  YiString
text <- (String -> YiString) -> YiM String -> YiM YiString
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
  EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ()) -> EditorM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ do
    YiString
text' <- EditorM YiString
killringGet
    Bool -> EditorM () -> EditorM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (YiString
text' YiString -> YiString -> Bool
forall a. Eq a => a -> a -> Bool
/= YiString
text) (EditorM () -> EditorM ()) -> EditorM () -> EditorM ()
forall a b. (a -> b) -> a -> b
$ Direction -> YiString -> EditorM ()
killringPut Direction
Forward YiString
text

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

-- This is like @kill-region-or-backward-word@.
killRegionB :: BufferM ()
killRegionB :: BufferM ()
killRegionB = BufferM Region
getSelectRegionB BufferM Region -> (Region -> BufferM ()) -> BufferM ()
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 (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
  Bool
eol <- BufferM Bool
atEol
  let tu :: TextUnit
tu = if Bool
eol then TextUnit
Character else TextUnit
Line
  Region -> BufferM ()
deleteRegionB (Region -> BufferM ()) -> BufferM Region -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TextUnit -> Direction -> BufferM Region
regionOfPartNonEmptyB TextUnit
tu Direction
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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> YiM ()
killringToClipboard

killringGet :: EditorM R.YiString
killringGet :: EditorM YiString
killringGet = do
  YiString
text :| [YiString]
_ <- 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
  YiString -> EditorM YiString
forall (m :: * -> *) a. Monad m => a -> m a
return YiString
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
  YiString
text :| [YiString]
_ <- 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
  BufferM () -> EditorM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> EditorM ()) -> BufferM () -> EditorM ()
forall a b. (a -> b) -> a -> b
$ BufferM Point
pointB BufferM Point -> (Point -> BufferM ()) -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Point -> BufferM ()
setSelectionMarkPointB BufferM () -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> YiString -> BufferM ()
insertN YiString
text

-- | C-y
-- Like `yankE`, but with system clipboard synchronization
yank :: YiM ()
yank :: YiM ()
yank = YiM ()
clipboardToKillring YiM () -> YiM () -> YiM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EditorM () -> YiM ()
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
  (Region
r, YiString
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
    Region
r <- BufferM Region
getSelectRegionB
    YiString
text <- Region -> BufferM YiString
readRegionB Region
r
    (Bool -> Identity Bool) -> FBuffer -> Identity FBuffer
Lens' FBuffer Bool
highlightSelectionA ((Bool -> Identity Bool) -> FBuffer -> Identity FBuffer)
-> Bool -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False
    (Region, YiString) -> BufferM (Region, YiString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Region
r, YiString
text)
  Direction -> YiString -> EditorM ()
killringPut (Region -> Direction
regionDirection Region
r) YiString
text

-- | M-w
-- Like `killRingSaveE`, but with system clipboard synchronization
killRingSave :: YiM ()
killRingSave :: YiM ()
killRingSave = EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM ()
killRingSaveE YiM () -> YiM () -> YiM ()
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
  Killring
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
  BufferM () -> EditorM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (Region -> BufferM ()
deleteRegionB (Region -> BufferM ()) -> BufferM Region -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BufferM Region
getRawestSelectRegionB)
  (Killring -> Identity Killring) -> Editor -> Identity Editor
Lens' Editor Killring
killringA ((Killring -> Identity Killring) -> Editor -> Identity Editor)
-> Killring -> EditorM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= let YiString
x :| [YiString]
xs = Killring -> NonEmpty YiString
_krContents Killring
kr
               in Killring
kr { _krContents :: NonEmpty YiString
_krContents = case [YiString]
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]
                     }
  EditorM ()
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