module System.Console.Haskeline.Command.KillRing where

import System.Console.Haskeline.LineState
import System.Console.Haskeline.Command
import System.Console.Haskeline.Monads
import System.Console.Haskeline.Command.Undo
import Control.Monad
import Data.IORef

-- standard trick for a purely functional queue:
data Stack a = Stack [a] [a]
                deriving Int -> Stack a -> ShowS
forall a. Show a => Int -> Stack a -> ShowS
forall a. Show a => [Stack a] -> ShowS
forall a. Show a => Stack a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stack a] -> ShowS
$cshowList :: forall a. Show a => [Stack a] -> ShowS
show :: Stack a -> String
$cshow :: forall a. Show a => Stack a -> String
showsPrec :: Int -> Stack a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Stack a -> ShowS
Show

emptyStack :: Stack a
emptyStack :: forall a. Stack a
emptyStack = forall a. [a] -> [a] -> Stack a
Stack [] []

peek :: Stack a -> Maybe a
peek :: forall a. Stack a -> Maybe a
peek (Stack [] []) = forall a. Maybe a
Nothing
peek (Stack (a
x:[a]
_) [a]
_) = forall a. a -> Maybe a
Just a
x
peek (Stack [] [a]
ys) = forall a. Stack a -> Maybe a
peek (forall a. [a] -> [a] -> Stack a
Stack (forall a. [a] -> [a]
reverse [a]
ys) [])

rotate :: Stack a -> Stack a
rotate :: forall a. Stack a -> Stack a
rotate s :: Stack a
s@(Stack [] []) = Stack a
s
rotate (Stack (a
x:[a]
xs) [a]
ys) = forall a. [a] -> [a] -> Stack a
Stack [a]
xs (a
xforall a. a -> [a] -> [a]
:[a]
ys)
rotate (Stack [] [a]
ys) = forall a. Stack a -> Stack a
rotate (forall a. [a] -> [a] -> Stack a
Stack (forall a. [a] -> [a]
reverse [a]
ys) [])

push :: a -> Stack a -> Stack a
push :: forall a. a -> Stack a -> Stack a
push a
x (Stack [a]
xs [a]
ys) = forall a. [a] -> [a] -> Stack a
Stack (a
xforall a. a -> [a] -> [a]
:[a]
xs) [a]
ys

type KillRing = Stack [Grapheme]

runKillRing :: MonadIO m => ReaderT (IORef KillRing) m a -> m a
runKillRing :: forall (m :: * -> *) a.
MonadIO m =>
ReaderT (IORef KillRing) m a -> m a
runKillRing ReaderT (IORef KillRing) m a
act = do
    IORef KillRing
ringRef <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef forall a. Stack a
emptyStack
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (IORef KillRing) m a
act IORef KillRing
ringRef


pasteCommand :: (Save s, MonadState KillRing m, MonadState Undo m)
            => ([Grapheme] -> s -> s) -> Command m (ArgMode s) s
pasteCommand :: forall s (m :: * -> *).
(Save s, MonadState KillRing m, MonadState Undo m) =>
([Grapheme] -> s -> s) -> Command m (ArgMode s) s
pasteCommand [Grapheme] -> s -> s
use = \ArgMode s
s -> do
    Maybe [Grapheme]
ms <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. Stack a -> Maybe a
peek forall s (m :: * -> *). MonadState s m => m s
get
    case Maybe [Grapheme]
ms of
        Maybe [Grapheme]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s. ArgMode s -> s
argState ArgMode s
s
        Just [Grapheme]
p -> do
            forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall s. Save s => s -> Undo -> Undo
saveToUndo forall a b. (a -> b) -> a -> b
$ forall s. ArgMode s -> s
argState ArgMode s
s
            forall (m :: * -> *) s. (Monad m, LineState s) => Command m s s
setState forall a b. (a -> b) -> a -> b
$ forall s. (s -> s) -> ArgMode s -> s
applyArg ([Grapheme] -> s -> s
use [Grapheme]
p) ArgMode s
s

deleteFromDiff' :: InsertMode -> InsertMode -> ([Grapheme],InsertMode)
deleteFromDiff' :: InsertMode -> InsertMode -> ([Grapheme], InsertMode)
deleteFromDiff' (IMode [Grapheme]
xs1 [Grapheme]
ys1) (IMode [Grapheme]
xs2 [Grapheme]
ys2)
    | Int
posChange forall a. Ord a => a -> a -> Bool
>= Int
0 = (forall a. Int -> [a] -> [a]
take Int
posChange [Grapheme]
ys1, [Grapheme] -> [Grapheme] -> InsertMode
IMode [Grapheme]
xs1 [Grapheme]
ys2)
    | Bool
otherwise = (forall a. Int -> [a] -> [a]
take (forall a. Num a => a -> a
negate Int
posChange) [Grapheme]
ys2 ,[Grapheme] -> [Grapheme] -> InsertMode
IMode [Grapheme]
xs2 [Grapheme]
ys1)
  where
    posChange :: Int
posChange = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Grapheme]
xs2 forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [Grapheme]
xs1

killFromHelper :: (MonadState KillRing m, MonadState Undo m,
                        Save s, Save t)
                => KillHelper -> Command m s t
killFromHelper :: forall (m :: * -> *) s t.
(MonadState KillRing m, MonadState Undo m, Save s, Save t) =>
KillHelper -> Command m s t
killFromHelper KillHelper
helper = forall s (m :: * -> *).
(Save s, MonadState Undo m) =>
Command m s s
saveForUndo forall (m :: * -> *) s t u.
Monad m =>
Command m s t -> Command m t u -> Command m s u
>|> \s
oldS -> do
    let ([Grapheme]
gs,InsertMode
newIM) = KillHelper -> InsertMode -> ([Grapheme], InsertMode)
applyHelper KillHelper
helper (forall s. Save s => s -> InsertMode
save s
oldS)
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall a. a -> Stack a -> Stack a
push [Grapheme]
gs)
    forall (m :: * -> *) s. (Monad m, LineState s) => Command m s s
setState (forall s. Save s => InsertMode -> s
restore InsertMode
newIM)

killFromArgHelper :: (MonadState KillRing m, MonadState Undo m, Save s, Save t)
                => KillHelper -> Command m (ArgMode s) t
killFromArgHelper :: forall (m :: * -> *) s t.
(MonadState KillRing m, MonadState Undo m, Save s, Save t) =>
KillHelper -> Command m (ArgMode s) t
killFromArgHelper KillHelper
helper = forall s (m :: * -> *).
(Save s, MonadState Undo m) =>
Command m s s
saveForUndo forall (m :: * -> *) s t u.
Monad m =>
Command m s t -> Command m t u -> Command m s u
>|> \ArgMode s
oldS -> do
    let ([Grapheme]
gs,InsertMode
newIM) = KillHelper -> ArgMode InsertMode -> ([Grapheme], InsertMode)
applyArgHelper KillHelper
helper (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall s. Save s => s -> InsertMode
save ArgMode s
oldS)
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall a. a -> Stack a -> Stack a
push [Grapheme]
gs)
    forall (m :: * -> *) s. (Monad m, LineState s) => Command m s s
setState (forall s. Save s => InsertMode -> s
restore InsertMode
newIM)

copyFromArgHelper :: (MonadState KillRing m, Save s)
                => KillHelper -> Command m (ArgMode s) s
copyFromArgHelper :: forall (m :: * -> *) s.
(MonadState KillRing m, Save s) =>
KillHelper -> Command m (ArgMode s) s
copyFromArgHelper KillHelper
helper = \ArgMode s
oldS -> do
    let ([Grapheme]
gs,InsertMode
_) = KillHelper -> ArgMode InsertMode -> ([Grapheme], InsertMode)
applyArgHelper KillHelper
helper (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall s. Save s => s -> InsertMode
save ArgMode s
oldS)
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall a. a -> Stack a -> Stack a
push [Grapheme]
gs)
    forall (m :: * -> *) s. (Monad m, LineState s) => Command m s s
setState (forall s. ArgMode s -> s
argState ArgMode s
oldS)


data KillHelper = SimpleMove (InsertMode -> InsertMode)
                 | GenericKill (InsertMode -> ([Grapheme],InsertMode))
        -- a generic kill gives more flexibility, but isn't repeatable.
        -- for example: dd,cc, %

killAll :: KillHelper
killAll :: KillHelper
killAll = (InsertMode -> ([Grapheme], InsertMode)) -> KillHelper
GenericKill forall a b. (a -> b) -> a -> b
$ \(IMode [Grapheme]
xs [Grapheme]
ys) -> (forall a. [a] -> [a]
reverse [Grapheme]
xs forall a. [a] -> [a] -> [a]
++ [Grapheme]
ys, InsertMode
emptyIM)

applyHelper :: KillHelper -> InsertMode -> ([Grapheme],InsertMode)
applyHelper :: KillHelper -> InsertMode -> ([Grapheme], InsertMode)
applyHelper (SimpleMove InsertMode -> InsertMode
move) InsertMode
im = InsertMode -> InsertMode -> ([Grapheme], InsertMode)
deleteFromDiff' InsertMode
im (InsertMode -> InsertMode
move InsertMode
im)
applyHelper (GenericKill InsertMode -> ([Grapheme], InsertMode)
act) InsertMode
im = InsertMode -> ([Grapheme], InsertMode)
act InsertMode
im

applyArgHelper :: KillHelper -> ArgMode InsertMode -> ([Grapheme],InsertMode)
applyArgHelper :: KillHelper -> ArgMode InsertMode -> ([Grapheme], InsertMode)
applyArgHelper (SimpleMove InsertMode -> InsertMode
move) ArgMode InsertMode
im = InsertMode -> InsertMode -> ([Grapheme], InsertMode)
deleteFromDiff' (forall s. ArgMode s -> s
argState ArgMode InsertMode
im) (forall s. (s -> s) -> ArgMode s -> s
applyArg InsertMode -> InsertMode
move ArgMode InsertMode
im)
applyArgHelper (GenericKill InsertMode -> ([Grapheme], InsertMode)
act) ArgMode InsertMode
im = InsertMode -> ([Grapheme], InsertMode)
act (forall s. ArgMode s -> s
argState ArgMode InsertMode
im)