{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Yi.Keymap.Vim.Common
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Common types used by the vim keymap.

module Yi.Keymap.Vim.Common
    ( VimMode(..)
    , VimBinding(..)
    , GotoCharCommand(..)
    , VimState(..)
    , Register(..)
    , RepeatToken(..)
    , RepeatableAction(..)
    , MatchResult(..)
    , EventString(..), unEv
    , OperatorName(..), unOp
    , RegisterName
    , Substitution(..)
    , module Yi.Keymap.Vim.MatchResult
    , lookupBestMatch, matchesString
    ) where

import           GHC.Generics              (Generic)

import           Control.Applicative       (Alternative ((<|>)))
import           Lens.Micro.Platform                (makeLenses)
import           Data.Binary               (Binary (..))
import           Data.Default              (Default (..))
import qualified Data.HashMap.Strict       as HM (HashMap)
import           Data.Monoid               ((<>))
import           Data.Semigroup            (Semigroup)
import           Data.String               (IsString (..))
import qualified Data.Text                 as T (Text, isPrefixOf, pack)
import qualified Data.Text.Encoding        as E (decodeUtf8, encodeUtf8)
import           Data.Typeable             (Typeable)
import           Yi.Buffer                 (Direction, Point, RegionStyle)
import           Yi.Editor                 (EditorM)
import           Yi.Keymap                 (YiM)
import           Yi.Keymap.Vim.MatchResult (MatchResult (..))
import           Yi.Rope                   (YiString)
import           Yi.Types                  (YiVariable)


newtype EventString = Ev { EventString -> Text
_unEv :: T.Text } deriving (Int -> EventString -> ShowS
[EventString] -> ShowS
EventString -> String
(Int -> EventString -> ShowS)
-> (EventString -> String)
-> ([EventString] -> ShowS)
-> Show EventString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventString] -> ShowS
$cshowList :: [EventString] -> ShowS
show :: EventString -> String
$cshow :: EventString -> String
showsPrec :: Int -> EventString -> ShowS
$cshowsPrec :: Int -> EventString -> ShowS
Show, EventString -> EventString -> Bool
(EventString -> EventString -> Bool)
-> (EventString -> EventString -> Bool) -> Eq EventString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventString -> EventString -> Bool
$c/= :: EventString -> EventString -> Bool
== :: EventString -> EventString -> Bool
$c== :: EventString -> EventString -> Bool
Eq, Eq EventString
Eq EventString
-> (EventString -> EventString -> Ordering)
-> (EventString -> EventString -> Bool)
-> (EventString -> EventString -> Bool)
-> (EventString -> EventString -> Bool)
-> (EventString -> EventString -> Bool)
-> (EventString -> EventString -> EventString)
-> (EventString -> EventString -> EventString)
-> Ord EventString
EventString -> EventString -> Bool
EventString -> EventString -> Ordering
EventString -> EventString -> EventString
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EventString -> EventString -> EventString
$cmin :: EventString -> EventString -> EventString
max :: EventString -> EventString -> EventString
$cmax :: EventString -> EventString -> EventString
>= :: EventString -> EventString -> Bool
$c>= :: EventString -> EventString -> Bool
> :: EventString -> EventString -> Bool
$c> :: EventString -> EventString -> Bool
<= :: EventString -> EventString -> Bool
$c<= :: EventString -> EventString -> Bool
< :: EventString -> EventString -> Bool
$c< :: EventString -> EventString -> Bool
compare :: EventString -> EventString -> Ordering
$ccompare :: EventString -> EventString -> Ordering
$cp1Ord :: Eq EventString
Ord, b -> EventString -> EventString
NonEmpty EventString -> EventString
EventString -> EventString -> EventString
(EventString -> EventString -> EventString)
-> (NonEmpty EventString -> EventString)
-> (forall b. Integral b => b -> EventString -> EventString)
-> Semigroup EventString
forall b. Integral b => b -> EventString -> EventString
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> EventString -> EventString
$cstimes :: forall b. Integral b => b -> EventString -> EventString
sconcat :: NonEmpty EventString -> EventString
$csconcat :: NonEmpty EventString -> EventString
<> :: EventString -> EventString -> EventString
$c<> :: EventString -> EventString -> EventString
Semigroup, Semigroup EventString
EventString
Semigroup EventString
-> EventString
-> (EventString -> EventString -> EventString)
-> ([EventString] -> EventString)
-> Monoid EventString
[EventString] -> EventString
EventString -> EventString -> EventString
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [EventString] -> EventString
$cmconcat :: [EventString] -> EventString
mappend :: EventString -> EventString -> EventString
$cmappend :: EventString -> EventString -> EventString
mempty :: EventString
$cmempty :: EventString
$cp1Monoid :: Semigroup EventString
Monoid)

instance IsString EventString where
  fromString :: String -> EventString
fromString = Text -> EventString
Ev (Text -> EventString) -> (String -> Text) -> String -> EventString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

newtype OperatorName = Op { OperatorName -> Text
_unOp :: T.Text } deriving (Int -> OperatorName -> ShowS
[OperatorName] -> ShowS
OperatorName -> String
(Int -> OperatorName -> ShowS)
-> (OperatorName -> String)
-> ([OperatorName] -> ShowS)
-> Show OperatorName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OperatorName] -> ShowS
$cshowList :: [OperatorName] -> ShowS
show :: OperatorName -> String
$cshow :: OperatorName -> String
showsPrec :: Int -> OperatorName -> ShowS
$cshowsPrec :: Int -> OperatorName -> ShowS
Show, OperatorName -> OperatorName -> Bool
(OperatorName -> OperatorName -> Bool)
-> (OperatorName -> OperatorName -> Bool) -> Eq OperatorName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OperatorName -> OperatorName -> Bool
$c/= :: OperatorName -> OperatorName -> Bool
== :: OperatorName -> OperatorName -> Bool
$c== :: OperatorName -> OperatorName -> Bool
Eq, b -> OperatorName -> OperatorName
NonEmpty OperatorName -> OperatorName
OperatorName -> OperatorName -> OperatorName
(OperatorName -> OperatorName -> OperatorName)
-> (NonEmpty OperatorName -> OperatorName)
-> (forall b. Integral b => b -> OperatorName -> OperatorName)
-> Semigroup OperatorName
forall b. Integral b => b -> OperatorName -> OperatorName
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> OperatorName -> OperatorName
$cstimes :: forall b. Integral b => b -> OperatorName -> OperatorName
sconcat :: NonEmpty OperatorName -> OperatorName
$csconcat :: NonEmpty OperatorName -> OperatorName
<> :: OperatorName -> OperatorName -> OperatorName
$c<> :: OperatorName -> OperatorName -> OperatorName
Semigroup, Semigroup OperatorName
OperatorName
Semigroup OperatorName
-> OperatorName
-> (OperatorName -> OperatorName -> OperatorName)
-> ([OperatorName] -> OperatorName)
-> Monoid OperatorName
[OperatorName] -> OperatorName
OperatorName -> OperatorName -> OperatorName
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [OperatorName] -> OperatorName
$cmconcat :: [OperatorName] -> OperatorName
mappend :: OperatorName -> OperatorName -> OperatorName
$cmappend :: OperatorName -> OperatorName -> OperatorName
mempty :: OperatorName
$cmempty :: OperatorName
$cp1Monoid :: Semigroup OperatorName
Monoid)

instance IsString OperatorName where
  fromString :: String -> OperatorName
fromString = Text -> OperatorName
Op (Text -> OperatorName)
-> (String -> Text) -> String -> OperatorName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

instance Binary EventString where
  get :: Get EventString
get = Text -> EventString
Ev (Text -> EventString)
-> (ByteString -> Text) -> ByteString -> EventString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
E.decodeUtf8 (ByteString -> EventString) -> Get ByteString -> Get EventString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
forall t. Binary t => Get t
get
  put :: EventString -> Put
put (Ev Text
t) = ByteString -> Put
forall t. Binary t => t -> Put
put (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
E.encodeUtf8 Text
t

instance Binary OperatorName where
  get :: Get OperatorName
get = Text -> OperatorName
Op (Text -> OperatorName)
-> (ByteString -> Text) -> ByteString -> OperatorName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
E.decodeUtf8 (ByteString -> OperatorName) -> Get ByteString -> Get OperatorName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
forall t. Binary t => Get t
get
  put :: OperatorName -> Put
put (Op Text
t) = ByteString -> Put
forall t. Binary t => t -> Put
put (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
E.encodeUtf8 Text
t

makeLenses ''EventString
makeLenses ''OperatorName

-- 'lookupBestMatch' and 'matchesString' pulled out of MatchResult
-- module to prevent cyclic dependencies. Screw more bootfiles.
lookupBestMatch :: EventString -> [(EventString, a)] -> MatchResult a
lookupBestMatch :: EventString -> [(EventString, a)] -> MatchResult a
lookupBestMatch EventString
key = (MatchResult a -> (EventString, a) -> MatchResult a)
-> MatchResult a -> [(EventString, a)] -> MatchResult a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl MatchResult a -> (EventString, a) -> MatchResult a
forall a. MatchResult a -> (EventString, a) -> MatchResult a
go MatchResult a
forall a. MatchResult a
NoMatch
    where go :: MatchResult a -> (EventString, a) -> MatchResult a
go MatchResult a
m (EventString
k, a
x) = MatchResult a
m MatchResult a -> MatchResult a -> MatchResult a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (() -> a) -> MatchResult () -> MatchResult a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> () -> a
forall a b. a -> b -> a
const a
x) (EventString
key EventString -> EventString -> MatchResult ()
`matchesString` EventString
k)

matchesString :: EventString -> EventString -> MatchResult ()
matchesString :: EventString -> EventString -> MatchResult ()
matchesString (Ev Text
got) (Ev Text
expected)
  | Text
expected Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
got = () -> MatchResult ()
forall a. a -> MatchResult a
WholeMatch ()
  | Text
got Text -> Text -> Bool
`T.isPrefixOf` Text
expected = MatchResult ()
forall a. MatchResult a
PartialMatch
  | Bool
otherwise = MatchResult ()
forall a. MatchResult a
NoMatch

type RegisterName = Char
type MacroName = Char

data RepeatableAction = RepeatableAction
    { RepeatableAction -> Int
raPreviousCount :: !Int
    , RepeatableAction -> EventString
raActionString  :: !EventString
    } deriving (Typeable, RepeatableAction -> RepeatableAction -> Bool
(RepeatableAction -> RepeatableAction -> Bool)
-> (RepeatableAction -> RepeatableAction -> Bool)
-> Eq RepeatableAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RepeatableAction -> RepeatableAction -> Bool
$c/= :: RepeatableAction -> RepeatableAction -> Bool
== :: RepeatableAction -> RepeatableAction -> Bool
$c== :: RepeatableAction -> RepeatableAction -> Bool
Eq, Int -> RepeatableAction -> ShowS
[RepeatableAction] -> ShowS
RepeatableAction -> String
(Int -> RepeatableAction -> ShowS)
-> (RepeatableAction -> String)
-> ([RepeatableAction] -> ShowS)
-> Show RepeatableAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RepeatableAction] -> ShowS
$cshowList :: [RepeatableAction] -> ShowS
show :: RepeatableAction -> String
$cshow :: RepeatableAction -> String
showsPrec :: Int -> RepeatableAction -> ShowS
$cshowsPrec :: Int -> RepeatableAction -> ShowS
Show, (forall x. RepeatableAction -> Rep RepeatableAction x)
-> (forall x. Rep RepeatableAction x -> RepeatableAction)
-> Generic RepeatableAction
forall x. Rep RepeatableAction x -> RepeatableAction
forall x. RepeatableAction -> Rep RepeatableAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RepeatableAction x -> RepeatableAction
$cfrom :: forall x. RepeatableAction -> Rep RepeatableAction x
Generic)

data Register = Register
    { Register -> RegionStyle
regRegionStyle :: RegionStyle
    , Register -> YiString
regContent     :: YiString
    } deriving (Int -> Register -> ShowS
[Register] -> ShowS
Register -> String
(Int -> Register -> ShowS)
-> (Register -> String) -> ([Register] -> ShowS) -> Show Register
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Register] -> ShowS
$cshowList :: [Register] -> ShowS
show :: Register -> String
$cshow :: Register -> String
showsPrec :: Int -> Register -> ShowS
$cshowsPrec :: Int -> Register -> ShowS
Show, (forall x. Register -> Rep Register x)
-> (forall x. Rep Register x -> Register) -> Generic Register
forall x. Rep Register x -> Register
forall x. Register -> Rep Register x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Register x -> Register
$cfrom :: forall x. Register -> Rep Register x
Generic)

data VimMode
    = Normal
    | NormalOperatorPending OperatorName
    | Insert Char -- ^ char denotes how state got into insert mode ('i', 'a', etc.)
    | Replace
    | ReplaceSingleChar
    | InsertNormal -- ^ after C-o
    | InsertVisual -- ^ after C-o and one of v, V, C-v
    | Visual RegionStyle
    | Ex
    | Search { VimMode -> VimMode
previousMode :: VimMode, VimMode -> Direction
direction :: Direction }
    deriving (Typeable, VimMode -> VimMode -> Bool
(VimMode -> VimMode -> Bool)
-> (VimMode -> VimMode -> Bool) -> Eq VimMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VimMode -> VimMode -> Bool
$c/= :: VimMode -> VimMode -> Bool
== :: VimMode -> VimMode -> Bool
$c== :: VimMode -> VimMode -> Bool
Eq, Int -> VimMode -> ShowS
[VimMode] -> ShowS
VimMode -> String
(Int -> VimMode -> ShowS)
-> (VimMode -> String) -> ([VimMode] -> ShowS) -> Show VimMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VimMode] -> ShowS
$cshowList :: [VimMode] -> ShowS
show :: VimMode -> String
$cshow :: VimMode -> String
showsPrec :: Int -> VimMode -> ShowS
$cshowsPrec :: Int -> VimMode -> ShowS
Show, (forall x. VimMode -> Rep VimMode x)
-> (forall x. Rep VimMode x -> VimMode) -> Generic VimMode
forall x. Rep VimMode x -> VimMode
forall x. VimMode -> Rep VimMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VimMode x -> VimMode
$cfrom :: forall x. VimMode -> Rep VimMode x
Generic)

data GotoCharCommand = GotoCharCommand !Char !Direction !RegionStyle
    deriving ((forall x. GotoCharCommand -> Rep GotoCharCommand x)
-> (forall x. Rep GotoCharCommand x -> GotoCharCommand)
-> Generic GotoCharCommand
forall x. Rep GotoCharCommand x -> GotoCharCommand
forall x. GotoCharCommand -> Rep GotoCharCommand x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GotoCharCommand x -> GotoCharCommand
$cfrom :: forall x. GotoCharCommand -> Rep GotoCharCommand x
Generic)

data VimState = VimState
    { VimState -> VimMode
vsMode                  :: !VimMode
    , VimState -> Maybe Int
vsCount                 :: !(Maybe Int)
    , VimState -> EventString
vsAccumulator           :: !EventString -- ^ for repeat and potentially macros
    , VimState -> EventString
vsTextObjectAccumulator :: !EventString
    , VimState -> HashMap RegisterName Register
vsRegisterMap           :: !(HM.HashMap RegisterName Register)
    , VimState -> RegisterName
vsActiveRegister        :: !RegisterName
    , VimState -> Maybe RepeatableAction
vsRepeatableAction      :: !(Maybe RepeatableAction)
    , VimState -> EventString
vsStringToEval          :: !EventString -- ^ see Yi.Keymap.Vim.pureEval comment
    , VimState -> EventString
vsOngoingInsertEvents   :: !EventString
    , VimState -> Maybe GotoCharCommand
vsLastGotoCharCommand   :: !(Maybe GotoCharCommand)
    , VimState -> EventString
vsBindingAccumulator    :: !EventString
    , VimState -> [Point]
vsSecondaryCursors      :: ![Point] -- TODO: these should live in a buffer, just as the main cursor does
    , VimState -> Bool
vsPaste                 :: !Bool -- ^ like vim's :help paste
    , VimState -> Maybe (RegisterName, EventString)
vsCurrentMacroRecording :: !(Maybe (MacroName, EventString))
    , VimState -> Maybe Substitution
vsLastSubstitution      :: !(Maybe Substitution)
    } deriving (Typeable, (forall x. VimState -> Rep VimState x)
-> (forall x. Rep VimState x -> VimState) -> Generic VimState
forall x. Rep VimState x -> VimState
forall x. VimState -> Rep VimState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VimState x -> VimState
$cfrom :: forall x. VimState -> Rep VimState x
Generic)

instance Binary RepeatableAction
instance Binary Register
instance Binary GotoCharCommand

instance Default VimMode where
    def :: VimMode
def = VimMode
Normal

instance Binary VimMode

instance Default VimState where
    def :: VimState
def = VimMode
-> Maybe Int
-> EventString
-> EventString
-> HashMap RegisterName Register
-> RegisterName
-> Maybe RepeatableAction
-> EventString
-> EventString
-> Maybe GotoCharCommand
-> EventString
-> [Point]
-> Bool
-> Maybe (RegisterName, EventString)
-> Maybe Substitution
-> VimState
VimState
            VimMode
Normal -- mode
            Maybe Int
forall a. Maybe a
Nothing -- count
            EventString
forall a. Monoid a => a
mempty -- accumulator
            EventString
forall a. Monoid a => a
mempty -- textobject accumulator
            HashMap RegisterName Register
forall a. Monoid a => a
mempty -- register map
            RegisterName
'\0' -- active register
            Maybe RepeatableAction
forall a. Maybe a
Nothing -- repeatable action
            EventString
forall a. Monoid a => a
mempty -- string to eval
            EventString
forall a. Monoid a => a
mempty -- ongoing insert events
            Maybe GotoCharCommand
forall a. Maybe a
Nothing -- last goto char command
            EventString
forall a. Monoid a => a
mempty -- binding accumulator
            [Point]
forall a. Monoid a => a
mempty -- secondary cursors
            Bool
False -- :set paste
            Maybe (RegisterName, EventString)
forall a. Maybe a
Nothing -- current macro recording
            Maybe Substitution
forall a. Maybe a
Nothing -- last substitution

instance Binary VimState

instance YiVariable VimState

-- Whether an action can be repeated through the use of the '.' key.
--
-- Actions with a RepeatToken of:
--
--  - Finish are repeatable.
--  - Drop are not repeatable.
--  - Continue are currently in progress. They will become repeatable when
--    completed. It is possible to cancel a in progress action, in which case
--    it will not be repeatable.
data RepeatToken = Finish
                 | Drop
                 | Continue
    deriving Int -> RepeatToken -> ShowS
[RepeatToken] -> ShowS
RepeatToken -> String
(Int -> RepeatToken -> ShowS)
-> (RepeatToken -> String)
-> ([RepeatToken] -> ShowS)
-> Show RepeatToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RepeatToken] -> ShowS
$cshowList :: [RepeatToken] -> ShowS
show :: RepeatToken -> String
$cshow :: RepeatToken -> String
showsPrec :: Int -> RepeatToken -> ShowS
$cshowsPrec :: Int -> RepeatToken -> ShowS
Show

-- Distinction between YiM and EditorM variants is for testing.
data VimBinding
    = VimBindingY (EventString -> VimState -> MatchResult (YiM RepeatToken))
    | VimBindingE (EventString -> VimState -> MatchResult (EditorM RepeatToken))

data Substitution = Substitution
    { Substitution -> YiString
subsFrom :: YiString
    , Substitution -> YiString
subsTo :: YiString
    , Substitution -> Bool
subsFlagGlobal :: !Bool
    , Substitution -> Bool
subsFlagCaseInsensitive :: !Bool
    , Substitution -> Bool
subsFlagConfirm :: !Bool
    } deriving ((forall x. Substitution -> Rep Substitution x)
-> (forall x. Rep Substitution x -> Substitution)
-> Generic Substitution
forall x. Rep Substitution x -> Substitution
forall x. Substitution -> Rep Substitution x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Substitution x -> Substitution
$cfrom :: forall x. Substitution -> Rep Substitution x
Generic)

instance Binary Substitution