module Yi.Keymap.Vim.TextObject
  ( TextObject(..)
  , CountedTextObject(..)
  , regionOfTextObjectB
  , changeTextObjectCount
  , changeTextObjectStyle
  , stringToTextObject
  ) where

import Control.Monad              (replicateM_, (<=<))
import Yi.Buffer
import Yi.Keymap.Vim.MatchResult
import Yi.Keymap.Vim.StyledRegion (StyledRegion (..), normalizeRegion)

data TextObject = TextObject !RegionStyle !TextUnit
data CountedTextObject = CountedTextObject !Int !TextObject

changeTextObjectCount :: Int -> CountedTextObject -> CountedTextObject
changeTextObjectCount :: Int -> CountedTextObject -> CountedTextObject
changeTextObjectCount Int
n (CountedTextObject Int
_ TextObject
to) = Int -> TextObject -> CountedTextObject
CountedTextObject Int
n TextObject
to

regionOfTextObjectB :: CountedTextObject -> BufferM StyledRegion
regionOfTextObjectB :: CountedTextObject -> BufferM StyledRegion
regionOfTextObjectB = StyledRegion -> BufferM StyledRegion
normalizeRegion (StyledRegion -> BufferM StyledRegion)
-> (CountedTextObject -> BufferM StyledRegion)
-> CountedTextObject
-> BufferM StyledRegion
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< CountedTextObject -> BufferM StyledRegion
textObjectRegionB'

textObjectRegionB' :: CountedTextObject -> BufferM StyledRegion
textObjectRegionB' :: CountedTextObject -> BufferM StyledRegion
textObjectRegionB' (CountedTextObject Int
count (TextObject RegionStyle
style TextUnit
unit)) =
    (Region -> StyledRegion) -> BufferM Region -> BufferM StyledRegion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RegionStyle -> Region -> StyledRegion
StyledRegion RegionStyle
style) (BufferM Region -> BufferM StyledRegion)
-> BufferM Region -> BufferM StyledRegion
forall a b. (a -> b) -> a -> b
$ BufferM () -> BufferM () -> BufferM Region
forall a b. BufferM a -> BufferM b -> BufferM Region
regionWithTwoMovesB
        (TextUnit -> Direction -> BufferM ()
maybeMoveB TextUnit
unit Direction
Backward)
        (Int -> BufferM () -> BufferM ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
count (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ TextUnit -> Direction -> BufferM ()
moveB TextUnit
unit Direction
Forward)

changeTextObjectStyle :: (RegionStyle -> RegionStyle) -> TextObject -> TextObject
changeTextObjectStyle :: (RegionStyle -> RegionStyle) -> TextObject -> TextObject
changeTextObjectStyle RegionStyle -> RegionStyle
smod (TextObject RegionStyle
s TextUnit
u) = RegionStyle -> TextUnit -> TextObject
TextObject (RegionStyle -> RegionStyle
smod RegionStyle
s) TextUnit
u

stringToTextObject :: String -> MatchResult TextObject
stringToTextObject :: String -> MatchResult TextObject
stringToTextObject String
"a" = MatchResult TextObject
forall a. MatchResult a
PartialMatch
stringToTextObject String
"i" = MatchResult TextObject
forall a. MatchResult a
PartialMatch
stringToTextObject (Char
'i':String
s) = Maybe TextObject -> MatchResult TextObject
forall a. Maybe a -> MatchResult a
matchFromMaybe (BoundarySide -> String -> Maybe TextObject
parseTextObject BoundarySide
InsideBound String
s)
stringToTextObject (Char
'a':String
s) = Maybe TextObject -> MatchResult TextObject
forall a. Maybe a -> MatchResult a
matchFromMaybe (BoundarySide -> String -> Maybe TextObject
parseTextObject BoundarySide
OutsideBound String
s)
stringToTextObject String
_ = MatchResult TextObject
forall a. MatchResult a
NoMatch

parseTextObject :: BoundarySide -> String -> Maybe TextObject
parseTextObject :: BoundarySide -> String -> Maybe TextObject
parseTextObject BoundarySide
bs (Char
c:[]) = ((Bool -> TextUnit) -> TextObject)
-> Maybe (Bool -> TextUnit) -> Maybe TextObject
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RegionStyle -> TextUnit -> TextObject
TextObject RegionStyle
Exclusive (TextUnit -> TextObject)
-> ((Bool -> TextUnit) -> TextUnit)
-> (Bool -> TextUnit)
-> TextObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Bool -> TextUnit) -> Bool -> TextUnit
forall a b. (a -> b) -> a -> b
$ BoundarySide
bs BoundarySide -> BoundarySide -> Bool
forall a. Eq a => a -> a -> Bool
== BoundarySide
OutsideBound)) Maybe (Bool -> TextUnit)
mkUnit
    where mkUnit :: Maybe (Bool -> TextUnit)
mkUnit = Char -> [(Char, Bool -> TextUnit)] -> Maybe (Bool -> TextUnit)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Char
c
           [(Char
'w',  TextUnit -> TextUnit -> Bool -> TextUnit
toOuter TextUnit
unitViWord TextUnit
unitViWordAnyBnd)
           ,(Char
'W',  TextUnit -> TextUnit -> Bool -> TextUnit
toOuter TextUnit
unitViWORD TextUnit
unitViWORDAnyBnd)
           ,(Char
'p',  TextUnit -> TextUnit -> Bool -> TextUnit
toOuter TextUnit
unitEmacsParagraph TextUnit
unitEmacsParagraph) -- TODO inner could be inproved
           ,(Char
's',  TextUnit -> TextUnit -> Bool -> TextUnit
toOuter TextUnit
unitSentence TextUnit
unitSentence) -- TODO inner could be inproved
           ,(Char
'"',  Char -> Char -> Bool -> TextUnit
unitDelimited Char
'"' Char
'"')
           ,(Char
'`',  Char -> Char -> Bool -> TextUnit
unitDelimited Char
'`' Char
'`')
           ,(Char
'\'', Char -> Char -> Bool -> TextUnit
unitDelimited Char
'\'' Char
'\'')
           ,(Char
'(',  Char -> Char -> Bool -> TextUnit
unitDelimited Char
'(' Char
')')
           ,(Char
')',  Char -> Char -> Bool -> TextUnit
unitDelimited Char
'(' Char
')')
           ,(Char
'b',  Char -> Char -> Bool -> TextUnit
unitDelimited Char
'(' Char
')')
           ,(Char
'[',  Char -> Char -> Bool -> TextUnit
unitDelimited Char
'[' Char
']')
           ,(Char
']',  Char -> Char -> Bool -> TextUnit
unitDelimited Char
'[' Char
']')
           ,(Char
'{',  Char -> Char -> Bool -> TextUnit
unitDelimited Char
'{' Char
'}')
           ,(Char
'}',  Char -> Char -> Bool -> TextUnit
unitDelimited Char
'{' Char
'}')
           ,(Char
'B',  Char -> Char -> Bool -> TextUnit
unitDelimited Char
'{' Char
'}')
           ,(Char
'<',  Char -> Char -> Bool -> TextUnit
unitDelimited Char
'<' Char
'>')
           ,(Char
'>',  Char -> Char -> Bool -> TextUnit
unitDelimited Char
'<' Char
'>')
           -- TODO: 't'
           ]
parseTextObject BoundarySide
_ String
_ = Maybe TextObject
forall a. Maybe a
Nothing

-- TODO: this probably belongs to Buffer.TextUnit
toOuter :: TextUnit -> TextUnit -> Bool -> TextUnit
toOuter :: TextUnit -> TextUnit -> Bool -> TextUnit
toOuter TextUnit
outer TextUnit
_     Bool
True  = TextUnit -> TextUnit
leftBoundaryUnit TextUnit
outer
toOuter TextUnit
_     TextUnit
inner Bool
False = TextUnit
inner