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 n :: Int
n (CountedTextObject _ to :: 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 count :: Int
count (TextObject style :: RegionStyle
style unit :: 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 smod :: RegionStyle -> RegionStyle
smod (TextObject s :: RegionStyle
s u :: TextUnit
u) = RegionStyle -> TextUnit -> TextObject
TextObject (RegionStyle -> RegionStyle
smod RegionStyle
s) TextUnit
u

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

parseTextObject :: BoundarySide -> String -> Maybe TextObject
parseTextObject :: BoundarySide -> String -> Maybe TextObject
parseTextObject bs :: BoundarySide
bs (c :: 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
           [('w',  TextUnit -> TextUnit -> Bool -> TextUnit
toOuter TextUnit
unitViWord TextUnit
unitViWordAnyBnd)
           ,('W',  TextUnit -> TextUnit -> Bool -> TextUnit
toOuter TextUnit
unitViWORD TextUnit
unitViWORDAnyBnd)
           ,('p',  TextUnit -> TextUnit -> Bool -> TextUnit
toOuter TextUnit
unitEmacsParagraph TextUnit
unitEmacsParagraph) -- TODO inner could be inproved
           ,('s',  TextUnit -> TextUnit -> Bool -> TextUnit
toOuter TextUnit
unitSentence TextUnit
unitSentence) -- TODO inner could be inproved
           ,('"',  Char -> Char -> Bool -> TextUnit
unitDelimited '"' '"')
           ,('`',  Char -> Char -> Bool -> TextUnit
unitDelimited '`' '`')
           ,('\'', Char -> Char -> Bool -> TextUnit
unitDelimited '\'' '\'')
           ,('(',  Char -> Char -> Bool -> TextUnit
unitDelimited '(' ')')
           ,(')',  Char -> Char -> Bool -> TextUnit
unitDelimited '(' ')')
           ,('b',  Char -> Char -> Bool -> TextUnit
unitDelimited '(' ')')
           ,('[',  Char -> Char -> Bool -> TextUnit
unitDelimited '[' ']')
           ,(']',  Char -> Char -> Bool -> TextUnit
unitDelimited '[' ']')
           ,('{',  Char -> Char -> Bool -> TextUnit
unitDelimited '{' '}')
           ,('}',  Char -> Char -> Bool -> TextUnit
unitDelimited '{' '}')
           ,('B',  Char -> Char -> Bool -> TextUnit
unitDelimited '{' '}')
           ,('<',  Char -> Char -> Bool -> TextUnit
unitDelimited '<' '>')
           ,('>',  Char -> Char -> Bool -> TextUnit
unitDelimited '<' '>')
           -- TODO: 't'
           ]
parseTextObject _ _ = 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 outer :: TextUnit
outer _     True  = TextUnit -> TextUnit
leftBoundaryUnit TextUnit
outer
toOuter _     inner :: TextUnit
inner False = TextUnit
inner