{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Yi.Keymap.Vim.StyledRegion
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- I'm a module waiting for some kind soul to give me a commentary!

module Yi.Keymap.Vim.StyledRegion
    ( StyledRegion(..)
    , normalizeRegion
    , transformCharactersInRegionB
    , transformCharactersInLineN
    ) where

import           Control.Monad      (forM_)
import qualified Data.Text          as T (map)
import           Yi.Buffer
import qualified Yi.Rope            as R (withText)
import           Yi.Utils           (SemiNum ((-~)))

data StyledRegion = StyledRegion !RegionStyle !Region

-- | from vim help:
--
-- 1. If the motion is exclusive and the end of the motion is in
--    column 1, the end of the motion is moved to the end of the
--    previous line and the motion becomes inclusive. Example: "}"
--    moves to the first line after a paragraph, but "d}" will not
--    include that line.
--
-- 2. If the motion is exclusive, the end of the motion is in column 1
--    and the start of the motion was at or before the first non-blank
--    in the line, the motion becomes linewise. Example: If a
--    paragraph begins with some blanks and you do "d}" while standing
--    on the first non-blank, all the lines of the paragraph are
--    deleted, including the blanks. If you do a put now, the deleted
--    lines will be inserted below the cursor position.
--
-- TODO: case 2
normalizeRegion :: StyledRegion -> BufferM StyledRegion
normalizeRegion :: StyledRegion -> BufferM StyledRegion
normalizeRegion sr :: StyledRegion
sr@(StyledRegion RegionStyle
style Region
reg) =

    if RegionStyle
style RegionStyle -> RegionStyle -> Bool
forall a. Eq a => a -> a -> Bool
== RegionStyle
Exclusive
    then do
        let end :: Point
end = Region -> Point
regionEnd Region
reg
        (Int
_, Int
endColumn) <- Point -> BufferM (Int, Int)
getLineAndColOfPoint Point
end
        StyledRegion -> BufferM StyledRegion
forall (m :: * -> *) a. Monad m => a -> m a
return (if Int
endColumn Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
            then RegionStyle -> Region -> StyledRegion
StyledRegion RegionStyle
Inclusive (Region -> StyledRegion) -> Region -> StyledRegion
forall a b. (a -> b) -> a -> b
$ Region
reg { regionEnd :: Point
regionEnd = Point
end Point -> Size -> Point
forall absolute relative.
SemiNum absolute relative =>
absolute -> relative -> absolute
-~ Size
2 }
            else StyledRegion
sr)
    else StyledRegion -> BufferM StyledRegion
forall (m :: * -> *) a. Monad m => a -> m a
return StyledRegion
sr

transformCharactersInRegionB :: StyledRegion -> (Char -> Char) -> BufferM ()
transformCharactersInRegionB :: StyledRegion -> (Char -> Char) -> BufferM ()
transformCharactersInRegionB (StyledRegion RegionStyle
Block Region
reg) Char -> Char
f = do
    [Region]
subregions <- Region -> BufferM [Region]
splitBlockRegionToContiguousSubRegionsB Region
reg
    [Region] -> (Region -> BufferM ()) -> BufferM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Region]
subregions ((Region -> BufferM ()) -> BufferM ())
-> (Region -> BufferM ()) -> BufferM ()
forall a b. (a -> b) -> a -> b
$ \Region
sr ->
        StyledRegion -> (Char -> Char) -> BufferM ()
transformCharactersInRegionB (RegionStyle -> Region -> StyledRegion
StyledRegion RegionStyle
Exclusive Region
sr) Char -> Char
f
    case [Region]
subregions of
        (Region
sr:[Region]
_) -> Point -> BufferM ()
moveTo (Region -> Point
regionStart Region
sr)
        [] -> [Char] -> BufferM ()
forall a. HasCallStack => [Char] -> a
error [Char]
"Should never happen"
transformCharactersInRegionB (StyledRegion RegionStyle
style Region
reg) Char -> Char
f = do
    Region
reg' <- Region -> RegionStyle -> BufferM Region
convertRegionToStyleB Region
reg RegionStyle
style
    YiString
s <- Region -> BufferM YiString
readRegionB Region
reg'
    Region -> YiString -> BufferM ()
replaceRegionB Region
reg' ((Text -> Text) -> YiString -> YiString
R.withText ((Char -> Char) -> Text -> Text
T.map Char -> Char
f) YiString
s)
    Point -> BufferM ()
moveTo (Region -> Point
regionStart Region
reg')

transformCharactersInLineN :: Int -> (Char -> Char) -> BufferM ()
transformCharactersInLineN :: Int -> (Char -> Char) -> BufferM ()
transformCharactersInLineN Int
count Char -> Char
action = do
    Point
p0 <- BufferM Point
pointB
    Int -> BufferM ()
moveXorEol Int
count
    Point
p1 <- BufferM Point
pointB
    let sreg :: StyledRegion
sreg = RegionStyle -> Region -> StyledRegion
StyledRegion RegionStyle
Exclusive (Region -> StyledRegion) -> Region -> StyledRegion
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Region
mkRegion Point
p0 Point
p1
    StyledRegion -> (Char -> Char) -> BufferM ()
transformCharactersInRegionB StyledRegion
sreg Char -> Char
action
    Point -> BufferM ()
moveTo Point
p1