    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
    [Stack a] -> ShowS
    Stack a -> String
    (Int -> Stack a -> ShowS)
    -> (Stack a -> String) -> ([Stack a] -> ShowS) -> Show (Stack a)
    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
    $cshowsPrec :: forall a. Show a => Int -> Stack a -> ShowS
    showsPrec :: Int -> Stack a -> ShowS
    $cshow :: forall a. Show a => Stack a -> String
    show :: Stack a -> String
    $cshowList :: forall a. Show a => [Stack a] -> ShowS
    showList :: [Stack a] -> ShowS
    Show

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

    peek :: Stack a -> Maybe a
    peek :: forall a. Stack a -> Maybe a
    peek (Stack [] []) = Maybe a
    forall a. Maybe a
    Nothing
    peek (Stack (a
    x:[a]
    _) [a]
    _) = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    x
    peek (Stack [] [a]
    ys) = Stack a -> Maybe a
    forall a. Stack a -> Maybe a
    peek ([a] -> [a] -> Stack a
    forall a. [a] -> [a] -> Stack a
    Stack ([a] -> [a]
    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) = [a] -> [a] -> Stack a
    forall a. [a] -> [a] -> Stack a
    Stack [a]
    xs (a
    xa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    ys)
    rotate (Stack [] [a]
    ys) = Stack a -> Stack a
    forall a. Stack a -> Stack a
    rotate ([a] -> [a] -> Stack a
    forall a. [a] -> [a] -> Stack a
    Stack ([a] -> [a]
    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) = [a] -> [a] -> Stack a
    forall a. [a] -> [a] -> Stack a
    Stack (a
    xa -> [a] -> [a]
    forall 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 <- IO (IORef KillRing) -> m (IORef KillRing)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (IORef KillRing) -> m (IORef KillRing))
    -> IO (IORef KillRing) -> m (IORef KillRing)
    forall a b. (a -> b) -> a -> b
    $ KillRing -> IO (IORef KillRing)
    forall a. a -> IO (IORef a)
    newIORef KillRing
    forall a. Stack a
    emptyStack
        ReaderT (IORef KillRing) m a -> IORef KillRing -> m a
    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 <- (KillRing -> Maybe [Grapheme])
    -> CmdM m KillRing -> CmdM m (Maybe [Grapheme])
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM KillRing -> Maybe [Grapheme]
    forall a. Stack a -> Maybe a
    peek CmdM m KillRing
    forall s (m :: * -> *). MonadState s m => m s
    get
        case Maybe [Grapheme]
    ms of
            Maybe [Grapheme]
    Nothing -> s -> CmdM m s
    forall a. a -> CmdM m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (s -> CmdM m s) -> s -> CmdM m s
    forall a b. (a -> b) -> a -> b
    $ ArgMode s -> s
    forall s. ArgMode s -> s
    argState ArgMode s
    s
            Just [Grapheme]
    p -> do
                (Undo -> Undo) -> CmdM m ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((Undo -> Undo) -> CmdM m ()) -> (Undo -> Undo) -> CmdM m ()
    forall a b. (a -> b) -> a -> b
    $ s -> Undo -> Undo
    forall s. Save s => s -> Undo -> Undo
    saveToUndo (s -> Undo -> Undo) -> s -> Undo -> Undo
    forall a b. (a -> b) -> a -> b
    $ ArgMode s -> s
    forall s. ArgMode s -> s
    argState ArgMode s
    s
                s -> CmdM m s
    forall (m :: * -> *) s. (Monad m, LineState s) => Command m s s
    setState (s -> CmdM m s) -> s -> CmdM m s
    forall a b. (a -> b) -> a -> b
    $ (s -> s) -> ArgMode s -> s
    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 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    0 = (Int -> [Grapheme] -> [Grapheme]
    forall a. Int -> [a] -> [a]
    take Int
    posChange [Grapheme]
    ys1, [Grapheme] -> [Grapheme] -> InsertMode
    IMode [Grapheme]
    xs1 [Grapheme]
    ys2)
        | Bool
    otherwise = (Int -> [Grapheme] -> [Grapheme]
    forall a. Int -> [a] -> [a]
    take (Int -> Int
    forall a. Num a => a -> a
    negate Int
    posChange) [Grapheme]
    ys2 ,[Grapheme] -> [Grapheme] -> InsertMode
    IMode [Grapheme]
    xs2 [Grapheme]
    ys1)
      where
        posChange :: Int
    posChange = [Grapheme] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Grapheme]
    xs2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - [Grapheme] -> Int
    forall a. [a] -> Int
    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 = Command m s s
    forall s (m :: * -> *).
    (Save s, MonadState Undo m) =>
    Command m s s
    saveForUndo Command m s s -> Command m s t -> Command m s t
    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 (s -> InsertMode
    forall s. Save s => s -> InsertMode
    save s
    oldS)
        (KillRing -> KillRing) -> CmdM m ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ([Grapheme] -> KillRing -> KillRing
    forall a. a -> Stack a -> Stack a
    push [Grapheme]
    gs)
        Command m t t
    forall (m :: * -> *) s. (Monad m, LineState s) => Command m s s
    setState (InsertMode -> t
    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 = Command m (ArgMode s) (ArgMode s)
    forall s (m :: * -> *).
    (Save s, MonadState Undo m) =>
    Command m s s
    saveForUndo Command m (ArgMode s) (ArgMode s)
    -> Command m (ArgMode s) t -> Command m (ArgMode s) t
    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 ((s -> InsertMode) -> ArgMode s -> ArgMode InsertMode
    forall a b. (a -> b) -> ArgMode a -> ArgMode b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap s -> InsertMode
    forall s. Save s => s -> InsertMode
    save ArgMode s
    oldS)
        (KillRing -> KillRing) -> CmdM m ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ([Grapheme] -> KillRing -> KillRing
    forall a. a -> Stack a -> Stack a
    push [Grapheme]
    gs)
        Command m t t
    forall (m :: * -> *) s. (Monad m, LineState s) => Command m s s
    setState (InsertMode -> t
    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 ((s -> InsertMode) -> ArgMode s -> ArgMode InsertMode
    forall a b. (a -> b) -> ArgMode a -> ArgMode b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap s -> InsertMode
    forall s. Save s => s -> InsertMode
    save ArgMode s
    oldS)
        (KillRing -> KillRing) -> CmdM m ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ([Grapheme] -> KillRing -> KillRing
    forall a. a -> Stack a -> Stack a
    push [Grapheme]
    gs)
        Command m s s
    forall (m :: * -> *) s. (Monad m, LineState s) => Command m s s
    setState (ArgMode s -> s
    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 ((InsertMode -> ([Grapheme], InsertMode)) -> KillHelper)
    -> (InsertMode -> ([Grapheme], InsertMode)) -> KillHelper
    forall a b. (a -> b) -> a -> b
    $ \(IMode [Grapheme]
    xs [Grapheme]
    ys) -> ([Grapheme] -> [Grapheme]
    forall a. [a] -> [a]
    reverse [Grapheme]
    xs [Grapheme] -> [Grapheme] -> [Grapheme]
    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' (ArgMode InsertMode -> InsertMode
    forall s. ArgMode s -> s
    argState ArgMode InsertMode
    im) ((InsertMode -> InsertMode) -> ArgMode InsertMode -> InsertMode
    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 (ArgMode InsertMode -> InsertMode
    forall s. ArgMode s -> s
    argState ArgMode InsertMode
    im)