    {-# 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
    $cshowsPrec :: Int -> Killring -> ShowS
    showsPrec :: Int -> Killring -> ShowS
    $cshow :: Killring -> String
    show :: Killring -> String
    $cshowList :: [Killring] -> ShowS
    showList :: [Killring] -> ShowS
    Show, Killring -> Killring -> Bool
    (Killring -> Killring -> Bool)
    -> (Killring -> Killring -> Bool) -> Eq Killring
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Killring -> Killring -> Bool
    == :: Killring -> Killring -> Bool
    $c/= :: Killring -> Killring -> Bool
    /= :: 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 a b. PutM a -> PutM b -> PutM b
    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 a b. PutM a -> PutM b -> PutM b
    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 a b. PutM a -> PutM b -> PutM b
    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 a b. PutM a -> PutM b -> PutM b
    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 a b. Get (a -> b) -> Get a -> Get b
    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 a b. Get (a -> b) -> Get a -> Get b
    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 a b. Get (a -> b) -> Get a -> Get b
    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 a b. Get (a -> b) -> Get a -> Get b
    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 { _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 = False , _krAccumulate = kr ^. 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 = True
             , _krContents =
               if kr ^. krAccumulate
               then (case 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) :| xs
               else push s 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 = s :| 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