{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Yi.Keymap.Vim.Ex.Commands.Undo
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable

module Yi.Keymap.Vim.Ex.Commands.Undo (parse) where

import           Yi.Buffer                        (redoB, undoB)
import           Yi.Keymap                        (Action (BufferA))
import           Yi.Keymap.Vim.Common             (EventString (Ev))
import           Yi.Keymap.Vim.Ex.Commands.Common (pureExCommand)
import           Yi.Keymap.Vim.Ex.Types           (ExCommand (cmdAction, cmdComplete, cmdShow))

parse :: EventString -> Maybe ExCommand
parse :: EventString -> Maybe ExCommand
parse (Ev Text
s) | Text
s Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"u", Text
"undo"] =  
         ExCommand -> Maybe ExCommand
forall a. a -> Maybe a
Just ExCommand
pureExCommand {
             cmdAction :: Action
cmdAction   = BufferM () -> Action
forall a. Show a => BufferM a -> Action
BufferA BufferM ()
undoB
           , cmdShow :: Text
cmdShow     =         Text
"undo"
           , cmdComplete :: YiM [Text]
cmdComplete = [Text] -> YiM [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text
"undo"]
         }
parse (Ev Text
s) | Text
s Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"redo"] =
         ExCommand -> Maybe ExCommand
forall a. a -> Maybe a
Just ExCommand
pureExCommand {
             cmdAction :: Action
cmdAction   = BufferM () -> Action
forall a. Show a => BufferM a -> Action
BufferA BufferM ()
redoB
           , cmdShow :: Text
cmdShow     =         Text
"redo"
           , cmdComplete :: YiM [Text]
cmdComplete = [Text] -> YiM [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text
"redo"]
         }
parse EventString
_                               = Maybe ExCommand
forall a. Maybe a
Nothing