{-# LANGUAGE CPP                #-}
{-# LANGUAGE TemplateHaskell    #-}
{-# OPTIONS_HADDOCK show-extensions #-}

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

module Yi.KillRing ( Killring
                   , _krKilled
                   , _krContents
                   , krKilled
                   , krContents
                   , krEndCmd
                   , krPut
                   , krSet, krGet
                   , krEmpty
                   , krLastYank
                   )
    where

import           Prelude             hiding (head, tail, take)

import           Lens.Micro.Platform ((^.), makeLenses)
import           Data.Binary         (Binary, get, put)
import           Data.List.NonEmpty  (NonEmpty (..), head, take)
import           Data.Monoid         ((<>))
import           Yi.Buffer.Basic     (Direction (..))
import qualified Yi.Rope             as R (YiString, length)


data Killring = Killring { Killring -> Bool
_krKilled :: !Bool
                         , Killring -> Bool
_krAccumulate :: !Bool
                         , Killring -> NonEmpty YiString
_krContents :: !(NonEmpty R.YiString)
                         , Killring -> Bool
_krLastYank :: !Bool
                         } deriving (Int -> Killring -> ShowS
[Killring] -> ShowS
Killring -> String
(Int -> Killring -> ShowS)
-> (Killring -> String) -> ([Killring] -> ShowS) -> Show Killring
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Killring] -> ShowS
$cshowList :: [Killring] -> ShowS
show :: Killring -> String
$cshow :: Killring -> String
showsPrec :: Int -> Killring -> ShowS
$cshowsPrec :: Int -> Killring -> ShowS
Show, Killring -> Killring -> Bool
(Killring -> Killring -> Bool)
-> (Killring -> Killring -> Bool) -> Eq Killring
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Killring -> Killring -> Bool
$c/= :: Killring -> Killring -> Bool
== :: Killring -> Killring -> Bool
$c== :: Killring -> Killring -> Bool
Eq)

instance Binary Killring where
  put :: Killring -> Put
put (Killring Bool
k Bool
a NonEmpty YiString
c Bool
l) =
    let putNE :: NonEmpty t -> Put
putNE (t
x :| [t]
xs) = t -> Put
forall t. Binary t => t -> Put
put t
x Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [t] -> Put
forall t. Binary t => t -> Put
put [t]
xs
    in Bool -> Put
forall t. Binary t => t -> Put
put Bool
k Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Put
forall t. Binary t => t -> Put
put Bool
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> NonEmpty YiString -> Put
forall t. Binary t => NonEmpty t -> Put
putNE NonEmpty YiString
c Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Put
forall t. Binary t => t -> Put
put Bool
l
  get :: Get Killring
get = let getNE :: Get (NonEmpty YiString)
getNE = YiString -> [YiString] -> NonEmpty YiString
forall a. a -> [a] -> NonEmpty a
(:|) (YiString -> [YiString] -> NonEmpty YiString)
-> Get YiString -> Get ([YiString] -> NonEmpty YiString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get YiString
forall t. Binary t => Get t
get Get ([YiString] -> NonEmpty YiString)
-> Get [YiString] -> Get (NonEmpty YiString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [YiString]
forall t. Binary t => Get t
get
        in Bool -> Bool -> NonEmpty YiString -> Bool -> Killring
Killring (Bool -> Bool -> NonEmpty YiString -> Bool -> Killring)
-> Get Bool -> Get (Bool -> NonEmpty YiString -> Bool -> Killring)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
forall t. Binary t => Get t
get Get (Bool -> NonEmpty YiString -> Bool -> Killring)
-> Get Bool -> Get (NonEmpty YiString -> Bool -> Killring)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Bool
forall t. Binary t => Get t
get Get (NonEmpty YiString -> Bool -> Killring)
-> Get (NonEmpty YiString) -> Get (Bool -> Killring)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (NonEmpty YiString)
getNE Get (Bool -> Killring) -> Get Bool -> Get Killring
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Bool
forall t. Binary t => Get t
get

makeLenses ''Killring

maxDepth :: Int
maxDepth :: Int
maxDepth = Int
10

krEmpty :: Killring
krEmpty :: Killring
krEmpty = Killring :: Bool -> Bool -> NonEmpty YiString -> Bool -> Killring
Killring { _krKilled :: Bool
_krKilled = Bool
False
                   , _krAccumulate :: Bool
_krAccumulate = Bool
False
                   , _krContents :: NonEmpty YiString
_krContents = YiString
forall a. Monoid a => a
mempty YiString -> [YiString] -> NonEmpty YiString
forall a. a -> [a] -> NonEmpty a
:| [YiString]
forall a. Monoid a => a
mempty
                   , _krLastYank :: Bool
_krLastYank = Bool
False
                   }

-- | Finish an atomic command, for the purpose of killring accumulation.
krEndCmd :: Killring -> Killring
krEndCmd :: Killring -> Killring
krEndCmd Killring
kr = Killring
kr { _krKilled :: Bool
_krKilled = Bool
False , _krAccumulate :: Bool
_krAccumulate = Killring
kr Killring -> Getting Bool Killring Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool Killring Bool
Lens' Killring Bool
krKilled }

-- | Put some text in the killring.
-- It's accumulated if the last command was a kill too
krPut :: Direction -> R.YiString -> Killring -> Killring
krPut :: Direction -> YiString -> Killring -> Killring
krPut Direction
dir YiString
s kr :: Killring
kr@Killring { _krContents :: Killring -> NonEmpty YiString
_krContents = r :: NonEmpty YiString
r@(YiString
x :| [YiString]
xs) }
    = Killring
kr { _krKilled :: Bool
_krKilled = Bool
True
         , _krContents :: NonEmpty YiString
_krContents =
           if Killring
kr Killring -> Getting Bool Killring Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool Killring Bool
Lens' Killring Bool
krAccumulate
           then (case Direction
dir of Direction
Forward  -> YiString
x YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString
s
                             Direction
Backward -> YiString
s YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString
x) YiString -> [YiString] -> NonEmpty YiString
forall a. a -> [a] -> NonEmpty a
:| [YiString]
xs
           else YiString -> NonEmpty YiString -> NonEmpty YiString
push YiString
s NonEmpty YiString
r
         }

-- | Push a string in the killring.
push :: R.YiString -> NonEmpty R.YiString -> NonEmpty R.YiString
push :: YiString -> NonEmpty YiString -> NonEmpty YiString
push YiString
s r :: NonEmpty YiString
r@(YiString
h :| [YiString]
t) = YiString
s YiString -> [YiString] -> NonEmpty YiString
forall a. a -> [a] -> NonEmpty a
:| if YiString -> Int
R.length YiString
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 then [YiString]
t else Int -> NonEmpty YiString -> [YiString]
forall a. Int -> NonEmpty a -> [a]
take Int
maxDepth NonEmpty YiString
r
-- Don't save very small cutted text portions.

-- | Set the top of the killring. Never accumulate the previous content.
krSet :: R.YiString -> Killring -> Killring
krSet :: YiString -> Killring -> Killring
krSet YiString
s kr :: Killring
kr@Killring {_krContents :: Killring -> NonEmpty YiString
_krContents = YiString
_ :| [YiString]
xs} = Killring
kr {_krContents :: NonEmpty YiString
_krContents = YiString
s YiString -> [YiString] -> NonEmpty YiString
forall a. a -> [a] -> NonEmpty a
:| [YiString]
xs}

-- | Get the top of the killring.
krGet :: Killring -> R.YiString
krGet :: Killring -> YiString
krGet = NonEmpty YiString -> YiString
forall a. NonEmpty a -> a
head (NonEmpty YiString -> YiString)
-> (Killring -> NonEmpty YiString) -> Killring -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Killring -> NonEmpty YiString
_krContents