    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 a b. (a -> b) -> BufferM a -> BufferM b
    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 a b. (a -> b) -> Maybe a -> Maybe b
    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