{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_HADDOCK show-extensions #-}
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
}
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 }
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 :: 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
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}
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