{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE MultiWayIf        #-}

-- |
-- Module      :  Yi.Buffer.HighLevel
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- High level operations on buffers.

module Yi.Buffer.HighLevel
    ( atEof
    , atEol
    , atLastLine
    , atSol
    , atSof
    , bdeleteB
    , bdeleteLineB
    , bkillWordB
    , botB
    , bufInfoB
    , BufferFileInfo (..)
    , capitaliseWordB
    , deleteBlankLinesB
    , deleteHorizontalSpaceB
    , deleteRegionWithStyleB
    , deleteToEol
    , deleteTrailingSpaceB
    , downFromTosB
    , downScreenB
    , downScreensB
    , exchangePointAndMarkB
    , fillParagraph
    , findMatchingPairB
    , firstNonSpaceB
    , flipRectangleB
    , getBookmarkB
    , getLineAndCol
    , getLineAndColOfPoint
    , getNextLineB
    , getNextNonBlankLineB
    , getRawestSelectRegionB
    , getSelectionMarkPointB
    , getSelectRegionB
    , gotoCharacterB
    , hasWhiteSpaceBefore
    , incrementNextNumberByB
    , insertRopeWithStyleB
    , isCurrentLineAllWhiteSpaceB
    , isCurrentLineEmptyB
    , isNumberB
    , killWordB
    , lastNonSpaceB
    , leftEdgesOfRegionB
    , leftOnEol
    , lineMoveVisRel
    , linePrefixSelectionB
    , lineStreamB
    , lowercaseWordB
    , middleB
    , modifyExtendedSelectionB
    , moveNonspaceOrSol
    , movePercentageFileB
    , moveToMTB
    , moveToEol
    , moveToSol
    , moveXorEol
    , moveXorSol
    , nextCExc
    , nextCInc
    , nextCInLineExc
    , nextCInLineInc
    , nextNParagraphs
    , nextWordB
    , prevCExc
    , prevCInc
    , prevCInLineExc
    , prevCInLineInc
    , prevNParagraphs
    , prevWordB
    , readCurrentWordB
    , readLnB
    , readPrevWordB
    , readRegionRopeWithStyleB
    , replaceBufferContent
    , revertB
    , rightEdgesOfRegionB
    , scrollB
    , scrollCursorToBottomB
    , scrollCursorToTopB
    , scrollScreensB
    , scrollToCursorB
    , scrollToLineAboveWindowB
    , scrollToLineBelowWindowB
    , selectNParagraphs
    , setSelectionMarkPointB
    , setSelectRegionB
    , shapeOfBlockRegionB
    , sortLines
    , sortLinesWithRegion
    , snapInsB
    , snapScreenB
    , splitBlockRegionToContiguousSubRegionsB
    , swapB
    , switchCaseChar
    , test3CharB
    , testHexB
    , toggleCommentB
    , topB
    , unLineCommentSelectionB
    , upFromBosB
    , uppercaseWordB
    , upScreenB
    , upScreensB
    , vimScrollB
    , vimScrollByB
    , markWord
    ) where

import           Lens.Micro.Platform      (over, use, (%=), (.=), _last)
import           Control.Monad            (forM, forM_, replicateM_, unless, void, when)
import           Control.Monad.RWS.Strict (ask)
import           Control.Monad.State      (gets)
import           Data.Char                (isDigit, isHexDigit, isOctDigit, isSpace, isUpper, toLower, toUpper)
import           Data.List                (intersperse, sort)
import           Data.List.NonEmpty       (NonEmpty(..))
import           Data.Maybe               (catMaybes, fromMaybe, listToMaybe)
import           Data.Monoid              ((<>))
import qualified Data.Set                 as Set
import qualified Data.Text                as T (Text, toLower, toUpper, unpack)
import           Data.Time                (UTCTime)
import           Data.Tuple               (swap)
import           Numeric                  (readHex, readOct, showHex, showOct)
import           Yi.Buffer.Basic          (Direction (..), Mark, Point (..), Size (Size))
import           Yi.Buffer.Misc
import           Yi.Buffer.Normal
import           Yi.Buffer.Region
import           Yi.Config.Misc           (ScrollStyle (SingleLine))
import           Yi.Rope                  (YiString)
import qualified Yi.Rope                  as R
import           Yi.String                (capitalizeFirst, fillText, isBlank, mapLines, onLines, overInit)
import           Yi.Utils                 (SemiNum ((+~), (-~)))
import           Yi.Window                (Window (actualLines, width, wkey))

-- ---------------------------------------------------------------------
-- Movement operations


-- | Move point between the middle, top and bottom of the screen
-- If the point stays at the middle, it'll be gone to the top
-- else if the point stays at the top, it'll be gone to the bottom
-- else it'll be gone to the middle
moveToMTB :: BufferM ()
moveToMTB = (==) <$> curLn <*> screenMidLn >>= \case
    True -> downFromTosB 0
    _    -> (==) <$> curLn <*> screenTopLn >>= \case
                True -> upFromBosB 0
                _    -> downFromTosB =<< (-) <$> screenMidLn <*> screenTopLn


-- | Move point to start of line
moveToSol :: BufferM ()
moveToSol = maybeMoveB Line Backward

-- | Move point to end of line
moveToEol :: BufferM ()
moveToEol = maybeMoveB Line Forward

-- | Move cursor to origin
topB :: BufferM ()
topB = moveTo 0

-- | Move cursor to end of buffer
botB :: BufferM ()
botB = moveTo =<< sizeB

-- | Move left if on eol, but not on blank line
leftOnEol :: BufferM ()
-- @savingPrefCol@ is needed, because deep down @leftB@ contains @forgetPrefCol@
-- which messes up vertical cursor motion in Vim normal mode
leftOnEol = savingPrefCol $ do
        eol <- atEol
        sol <- atSol
        when (eol && not sol) leftB

-- | Move @x@ chars back, or to the sol, whichever is less
moveXorSol :: Int -> BufferM ()
moveXorSol x = replicateM_ x $ do c <- atSol; unless c leftB

-- | Move @x@ chars forward, or to the eol, whichever is less
moveXorEol :: Int -> BufferM ()
moveXorEol x = replicateM_ x $ do c <- atEol; unless c rightB

-- | Move to first char of next word forwards
nextWordB :: BufferM ()
nextWordB = moveB unitWord Forward

-- | Move to first char of next word backwards
prevWordB :: BufferM ()
prevWordB = moveB unitWord Backward

-- * Char-based movement actions.

gotoCharacterB :: Char -> Direction -> RegionStyle -> Bool -> BufferM ()
gotoCharacterB c dir style stopAtLineBreaks = do
    start <- pointB
    let predicate = if stopAtLineBreaks then (`elem` [c, '\n']) else (== c)
        (move, moveBack) = if dir == Forward then (rightB, leftB) else (leftB, rightB)
    doUntilB_ (predicate <$> readB) move
    b <- readB
    if stopAtLineBreaks && b == '\n'
    then moveTo start
    else when (style == Exclusive && b == c) moveBack

-- | Move to the next occurence of @c@
nextCInc :: Char -> BufferM ()
nextCInc c = gotoCharacterB c Forward Inclusive False

nextCInLineInc :: Char -> BufferM ()
nextCInLineInc c = gotoCharacterB c Forward Inclusive True

-- | Move to the character before the next occurence of @c@
nextCExc :: Char -> BufferM ()
nextCExc c = gotoCharacterB c Forward Exclusive False

nextCInLineExc :: Char -> BufferM ()
nextCInLineExc c = gotoCharacterB c Forward Exclusive True

-- | Move to the previous occurence of @c@
prevCInc :: Char -> BufferM ()
prevCInc c = gotoCharacterB c Backward Inclusive False

prevCInLineInc :: Char -> BufferM ()
prevCInLineInc c = gotoCharacterB c Backward Inclusive True

-- | Move to the character after the previous occurence of @c@
prevCExc :: Char -> BufferM ()
prevCExc c = gotoCharacterB c Backward Exclusive False

prevCInLineExc :: Char -> BufferM ()
prevCInLineExc c = gotoCharacterB c Backward Exclusive True

-- | Move to first non-space character in this line
firstNonSpaceB :: BufferM ()
firstNonSpaceB = do
  moveToSol
  untilB_ ((||) <$> atEol <*> ((not . isSpace) <$> readB)) rightB

-- | Move to the last non-space character in this line
lastNonSpaceB :: BufferM ()
lastNonSpaceB = do
  moveToEol
  untilB_ ((||) <$> atSol <*> ((not . isSpace) <$> readB)) leftB

-- | Go to the first non space character in the line;
-- if already there, then go to the beginning of the line.
moveNonspaceOrSol :: BufferM ()
moveNonspaceOrSol = do
  prev <- readPreviousOfLnB
  if R.all isSpace prev then moveToSol else firstNonSpaceB

-- | True if current line consists of just a newline (no whitespace)
isCurrentLineEmptyB :: BufferM Bool
isCurrentLineEmptyB = savingPointB $ moveToSol >> atEol

-- | Note: Returns False if line doesn't have any characters besides a newline
isCurrentLineAllWhiteSpaceB :: BufferM Bool
isCurrentLineAllWhiteSpaceB = savingPointB $ do
    isEmpty <- isCurrentLineEmptyB
    if isEmpty
    then return False
    else do
        let go = do
                  eol <- atEol
                  if eol
                  then return True
                  else do
                      c <- readB
                      if isSpace c
                      then rightB >> go
                      else return False
        moveToSol
        go

------------

-- | Move down next @n@ paragraphs
nextNParagraphs :: Int -> BufferM ()
nextNParagraphs n = replicateM_ n $ moveB unitEmacsParagraph Forward

-- | Move up prev @n@ paragraphs
prevNParagraphs :: Int -> BufferM ()
prevNParagraphs n = replicateM_ n $ moveB unitEmacsParagraph Backward

-- | Select next @n@ paragraphs
selectNParagraphs :: Int -> BufferM ()
selectNParagraphs n = do
  getVisibleSelection >>= \case
    True -> exchangePointAndMarkB
            >> nextNParagraphs n >> (setVisibleSelection True)
            >> exchangePointAndMarkB
    False -> nextNParagraphs n >> (setVisibleSelection True)
             >> pointB >>= setSelectionMarkPointB >> prevNParagraphs n

-- ! Examples:
-- @goUnmatchedB Backward '(' ')'@
-- Move to the previous unmatched '('
-- @goUnmatchedB Forward '{' '}'@
-- Move to the next unmatched '}'
goUnmatchedB :: Direction -> Char -> Char -> BufferM ()
goUnmatchedB dir cStart' cStop' = getLineAndCol >>= \position ->
    stepB >> readB >>= go position (0::Int)
    where
        go pos opened c
           | c == cStop && opened == 0 = return ()
           | c == cStop       = goIfNotEofSof pos (opened-1)
           | c == cStart      = goIfNotEofSof pos (opened+1)
           | otherwise        = goIfNotEofSof pos  opened
        goIfNotEofSof pos opened = atEof >>= \eof -> atSof >>= \sof ->
            if not eof && not sof
                then stepB >> readB >>= go pos opened
                else gotoLn (fst pos) >> moveToColB (snd pos)
        (stepB, cStart, cStop) | dir == Forward = (rightB, cStart', cStop')
                               | otherwise      = (leftB, cStop', cStart')

-----------------------------------------------------------------------
-- Queries

-- | Return true if the current point is the start of a line
atSol :: BufferM Bool
atSol = atBoundaryB Line Backward

-- | Return true if the current point is the end of a line
atEol :: BufferM Bool
atEol = atBoundaryB Line Forward

-- | True if point at start of file
atSof :: BufferM Bool
atSof = atBoundaryB Document Backward

-- | True if point at end of file
atEof :: BufferM Bool
atEof = atBoundaryB Document Forward

-- | True if point at the last line
atLastLine :: BufferM Bool
atLastLine = savingPointB $ do
    moveToEol
    (==) <$> sizeB <*> pointB

-- | Get the current line and column number
getLineAndCol :: BufferM (Int, Int)
getLineAndCol = (,) <$> curLn <*> curCol

getLineAndColOfPoint :: Point -> BufferM (Int, Int)
getLineAndColOfPoint p = savingPointB $ moveTo p >> getLineAndCol

-- | Read the line the point is on
readLnB :: BufferM YiString
readLnB = readUnitB Line

-- | Read from point to beginning of line
readPreviousOfLnB :: BufferM YiString
readPreviousOfLnB = readRegionB =<< regionOfPartB Line Backward

hasWhiteSpaceBefore :: BufferM Bool
hasWhiteSpaceBefore = fmap isSpace (prevPointB >>= readAtB)

-- | Get the previous point, unless at the beginning of the file
prevPointB :: BufferM Point
prevPointB = do
  sof <- atSof
  if sof then pointB
         else do p <- pointB
                 return $ Point (fromPoint p - 1)

-- | Reads in word at point.
readCurrentWordB :: BufferM YiString
readCurrentWordB = readUnitB unitWord

-- | Reads in word before point.
readPrevWordB :: BufferM YiString
readPrevWordB = readPrevUnitB unitViWordOnLine

-------------------------
-- Deletes

-- | Delete one character backward
bdeleteB :: BufferM ()
bdeleteB = deleteB Character Backward

-- | Delete forward whitespace or non-whitespace depending on
-- the character under point.
killWordB :: BufferM ()
killWordB = deleteB unitWord Forward

-- | Delete backward whitespace or non-whitespace depending on
-- the character before point.
bkillWordB :: BufferM ()
bkillWordB = deleteB unitWord Backward

-- | Delete backward to the sof or the new line character
bdeleteLineB :: BufferM ()
bdeleteLineB = atSol >>= \sol -> if sol then bdeleteB else deleteB Line Backward


-- UnivArgument is in Yi.Keymap.Emacs.Utils but we can't import it due
-- to cyclic imports.
-- | emacs' @delete-horizontal-space@ with the optional argument.
deleteHorizontalSpaceB :: Maybe Int -> BufferM ()
deleteHorizontalSpaceB u = do
  c <- curCol
  reg <- regionOfB Line
  text <- readRegionB reg
  let (r, jb) = deleteSpaces c text
  modifyRegionB (const r) reg
  -- Jump backwards to where the now-deleted spaces have started so
  -- it's consistent and feels natural instead of leaving us somewhere
  -- in the text.
  moveToColB $ c - jb
  where
    deleteSpaces :: Int -> R.YiString -> (R.YiString, Int)
    deleteSpaces c l =
      let (f, b) = R.splitAt c l
          f' = R.dropWhileEnd isSpace f
          cleaned = f' <> case u of
            Nothing -> R.dropWhile isSpace b
            Just _ -> b
      -- We only want to jump back the number of spaces before the
      -- point, not the total number of characters we're removing.
      in (cleaned, R.length f - R.length f')

----------------------------------------
-- Transform operations

-- | capitalise the word under the cursor
uppercaseWordB :: BufferM ()
uppercaseWordB = transformB (R.withText T.toUpper) unitWord Forward

-- | lowerise word under the cursor
lowercaseWordB :: BufferM ()
lowercaseWordB = transformB (R.withText T.toLower) unitWord Forward

-- | capitalise the first letter of this word
capitaliseWordB :: BufferM ()
capitaliseWordB = transformB capitalizeFirst unitWord Forward

switchCaseChar :: Char -> Char
switchCaseChar c = if isUpper c then toLower c else toUpper c

-- | Delete to the end of line, excluding it.
deleteToEol :: BufferM ()
deleteToEol = deleteRegionB =<< regionOfPartB Line Forward

-- | Transpose two characters, (the Emacs C-t action)
swapB :: BufferM ()
swapB = do eol <- atEol
           when eol leftB
           transposeB Character Forward

-- | Delete trailing whitespace from all lines. Uses 'savingPositionB'
-- to get back to where it was.
deleteTrailingSpaceB :: BufferM ()
deleteTrailingSpaceB =
  regionOfB Document >>=
  savingPositionB . modifyRegionB (tru . mapLines stripEnd)
  where
    -- Strips the space from the end of each line, preserving
    -- newlines.
    stripEnd :: R.YiString -> R.YiString
    stripEnd x = case R.last x of
      Nothing -> x
      Just '\n' -> (`R.snoc` '\n') $ R.dropWhileEnd isSpace x
      _ -> R.dropWhileEnd isSpace x

    -- | Cut off trailing newlines, making sure to preserve one.
    tru :: R.YiString -> R.YiString
    tru x = if R.length x == 0
            then x
            else (`R.snoc` '\n') $ R.dropWhileEnd (== '\n') x

-- ----------------------------------------------------
-- | Marks

-- | Set the current buffer selection mark
setSelectionMarkPointB :: Point -> BufferM ()
setSelectionMarkPointB p = (.= p) . markPointA =<< selMark <$> askMarks

-- | Get the current buffer selection mark
getSelectionMarkPointB :: BufferM Point
getSelectionMarkPointB = use . markPointA =<< selMark <$> askMarks

-- | Exchange point & mark.
exchangePointAndMarkB :: BufferM ()
exchangePointAndMarkB = do m <- getSelectionMarkPointB
                           p <- pointB
                           setSelectionMarkPointB p
                           moveTo m

getBookmarkB :: String -> BufferM Mark
getBookmarkB = getMarkB . Just


-- ---------------------------------------------------------------------
-- Buffer operations

data BufferFileInfo =
    BufferFileInfo { bufInfoFileName :: FilePath
                   , bufInfoSize     :: Int
                   , bufInfoLineNo   :: Int
                   , bufInfoColNo    :: Int
                   , bufInfoCharNo   :: Point
                   , bufInfoPercent  :: T.Text
                   , bufInfoModified :: Bool
                   }

-- | File info, size in chars, line no, col num, char num, percent
bufInfoB :: BufferM BufferFileInfo
bufInfoB = do
    s <- sizeB
    p <- pointB
    m <- gets isUnchangedBuffer
    l <- curLn
    c <- curCol
    nm <- gets identString
    let bufInfo = BufferFileInfo { bufInfoFileName = T.unpack nm
                                 , bufInfoSize     = fromIntegral s
                                 , bufInfoLineNo   = l
                                 , bufInfoColNo    = c
                                 , bufInfoCharNo   = p
                                 , bufInfoPercent  = getPercent p s
                                 , bufInfoModified = not m
                                 }
    return bufInfo

-----------------------------
-- Window-related operations

upScreensB :: Int -> BufferM ()
upScreensB = scrollScreensB . negate

downScreensB :: Int -> BufferM ()
downScreensB = scrollScreensB

-- | Scroll up 1 screen
upScreenB :: BufferM ()
upScreenB = scrollScreensB (-1)

-- | Scroll down 1 screen
downScreenB :: BufferM ()
downScreenB = scrollScreensB 1

-- | Scroll by n screens (negative for up)
scrollScreensB :: Int -> BufferM ()
scrollScreensB n = do
    h <- askWindow actualLines
    scrollB $ n * max 0 (h - 1) -- subtract some amount to get some overlap (emacs-like).

-- | Same as scrollB, but also moves the cursor
vimScrollB :: Int -> BufferM ()
vimScrollB n = do scrollB n
                  void $ lineMoveRel n

-- | Same as scrollByB, but also moves the cursor
vimScrollByB :: (Int -> Int) -> Int -> BufferM ()
vimScrollByB f n = do h <- askWindow actualLines
                      vimScrollB $ n * f h

-- | Move to middle line in screen
scrollToCursorB :: BufferM ()
scrollToCursorB = do
    MarkSet f i _ <- markLines
    h <- askWindow actualLines
    let m = f + (h `div` 2)
    scrollB $ i - m

-- | Move cursor to the top of the screen
scrollCursorToTopB :: BufferM ()
scrollCursorToTopB = do
    MarkSet f i _ <- markLines
    scrollB $ i - f

-- | Move cursor to the bottom of the screen
scrollCursorToBottomB :: BufferM ()
scrollCursorToBottomB = do
    -- NOTE: This is only an approximation.
    --       The correct scroll amount depends on how many lines just above
    --       the current viewport are going to be wrapped. We don't have this
    --       information here as wrapping is done in the frontend.
    MarkSet f i _ <- markLines
    h <- askWindow actualLines
    scrollB $ i - f - h + 1

-- | Scroll by n lines.
scrollB :: Int -> BufferM ()
scrollB n = do
  MarkSet fr _ _ <- askMarks
  savingPointB $ do
    moveTo =<< use (markPointA fr)
    void $ gotoLnFrom n
    (markPointA fr .=) =<< pointB
  w <- askWindow wkey
  pointFollowsWindowA %= Set.insert w

-- Scroll line above window to the bottom.
scrollToLineAboveWindowB :: BufferM ()
scrollToLineAboveWindowB = do
    downFromTosB 0
    replicateM_ 1 lineUp
    scrollCursorToBottomB

-- Scroll line below window to the top.
scrollToLineBelowWindowB :: BufferM ()
scrollToLineBelowWindowB = do
    upFromBosB 0
    replicateM_ 1 lineDown
    scrollCursorToTopB

-- | Move the point to inside the viewable region
snapInsB :: BufferM ()
snapInsB = do
    w <- askWindow wkey
    movePoint <- Set.member w <$> use pointFollowsWindowA
    when movePoint $ do
        r <- winRegionB
        p <- pointB
        moveTo $ max (regionStart r) $ min (regionEnd r) p

-- | return index of Sol on line @n@ above current line
indexOfSolAbove :: Int -> BufferM Point
indexOfSolAbove n = pointAt $ gotoLnFrom (negate n)

data RelPosition = Above | Below | Within
  deriving (Show)

-- | return relative position of the point @p@
-- relative to the region defined by the points @rs@ and @re@
pointScreenRelPosition :: Point -> Point -> Point -> RelPosition
pointScreenRelPosition p rs re
  | rs > p && p > re = Within
  | p < rs = Above
  | p > re = Below
pointScreenRelPosition _ _ _ = Within -- just to disable the non-exhaustive pattern match warning

-- | Move the visible region to include the point
snapScreenB :: Maybe ScrollStyle -> BufferM Bool
snapScreenB style = do
    w <- askWindow wkey
    movePoint <- Set.member w <$> use pointFollowsWindowA
    if movePoint then return False else do
        inWin <- pointInWindowB =<< pointB
        if inWin then return False else do
            h <- askWindow actualLines
            r <- winRegionB
            p <- pointB
            let gap = case style of
                        Just SingleLine -> case pointScreenRelPosition p (regionStart r) (regionEnd r) of
                                             Above  -> 0
                                             Below  -> h - 1
                                             Within -> 0 -- Impossible but handle it anyway
                        _               -> h `div` 2
            i <- indexOfSolAbove gap
            f <- fromMark <$> askMarks
            markPointA f .= i
            return True


-- | Move to @n@ lines down from top of screen
downFromTosB :: Int -> BufferM ()
downFromTosB n = do
  moveTo =<< use . markPointA =<< fromMark <$> askMarks
  replicateM_ n lineDown

-- | Move to @n@ lines up from the bottom of the screen
upFromBosB :: Int -> BufferM ()
upFromBosB n = do
  r <- winRegionB
  moveTo (regionEnd r - 1)
  moveToSol
  replicateM_ n lineUp

-- | Move to middle line in screen
middleB :: BufferM ()
middleB = do
  w <- ask
  f <- fromMark <$> askMarks
  moveTo =<< use (markPointA f)
  replicateM_ (actualLines w `div` 2) lineDown

pointInWindowB :: Point -> BufferM Bool
pointInWindowB p = nearRegion p <$> winRegionB

-----------------------------
-- Region-related operations

-- | Return the region between point and mark
getRawestSelectRegionB :: BufferM Region
getRawestSelectRegionB = do
  m <- getSelectionMarkPointB
  p <- pointB
  return $ mkRegion p m

-- | Return the empty region if the selection is not visible.
getRawSelectRegionB :: BufferM Region
getRawSelectRegionB = do
  s <- use highlightSelectionA
  if s then getRawestSelectRegionB else do
     p <- pointB
     return $ mkRegion p p

-- | Get the current region boundaries. Extended to the current selection unit.
getSelectRegionB :: BufferM Region
getSelectRegionB = do
  regionStyle <- getRegionStyle
  r <- getRawSelectRegionB
  convertRegionToStyleB r regionStyle

-- | Select the given region: set the selection mark at the 'regionStart'
-- and the current point at the 'regionEnd'.
setSelectRegionB :: Region -> BufferM ()
setSelectRegionB region = do
  highlightSelectionA .= True
  setSelectionMarkPointB $ regionStart region
  moveTo $ regionEnd region

------------------------------------------
-- Some line related movements/operations

deleteBlankLinesB :: BufferM ()
deleteBlankLinesB = do
  isThisBlank <- isBlank <$> readLnB
  when isThisBlank $ do
    p <- pointB
    -- go up to the 1st blank line in the group
    void $ whileB (R.null <$> getNextLineB Backward) lineUp
    q <- pointB
    -- delete the whole blank region.
    deleteRegionB $ mkRegion p q

-- | Get a (lazy) stream of lines in the buffer, starting at the /next/ line
-- in the given direction.
lineStreamB :: Direction -> BufferM [YiString]
lineStreamB dir = fmap rev . R.lines <$> (streamB dir =<< pointB)
  where
    rev = case dir of
      Forward -> id
      Backward -> R.reverse

-- | Get the next line of text in the given direction. This returns
-- simply 'Nothing' if there no such line.
getMaybeNextLineB :: Direction -> BufferM (Maybe YiString)
getMaybeNextLineB dir = listToMaybe <$> lineStreamB dir

-- | The same as 'getMaybeNextLineB' but avoids the use of the 'Maybe'
-- type in the return by returning the empty string if there is no
-- next line.
getNextLineB :: Direction -> BufferM YiString
getNextLineB dir = fromMaybe R.empty <$> getMaybeNextLineB dir

-- | Get closest line to the current line (not including the current
-- line) in the given direction which satisfies the given condition.
-- Returns 'Nothing' if there is no line which satisfies the
-- condition.
getNextLineWhichB :: Direction -> (YiString -> Bool) -> BufferM (Maybe YiString)
getNextLineWhichB dir cond = listToMaybe . filter cond <$> lineStreamB dir

-- | Returns the closest line to the current line which is non-blank,
-- in the given direction. Returns the empty string if there is no
-- such line (for example if we are on the top line already).
getNextNonBlankLineB :: Direction -> BufferM YiString
getNextNonBlankLineB dir =
  fromMaybe R.empty <$> getNextLineWhichB dir (not . R.null)

------------------------------------------------
-- Some more utility functions involving
-- regions (generally that which is selected)

modifyExtendedSelectionB :: TextUnit -> (R.YiString -> R.YiString) -> BufferM ()
modifyExtendedSelectionB unit transform
    = modifyRegionB transform =<< unitWiseRegion unit =<< getSelectRegionB

-- | Prefix each line in the selection using the given string.
linePrefixSelectionB :: R.YiString -- ^ The string that starts a line comment
                     ->  BufferM ()
linePrefixSelectionB s =
  modifyExtendedSelectionB Line . overInit $ mapLines (s <>)

-- | Uncomments the selection using the given line comment
-- starting string. This only works for the comments which
-- begin at the start of the line.
unLineCommentSelectionB :: R.YiString -- ^ The string which begins a
                                      -- line comment
                        -> R.YiString -- ^ A potentially shorter
                                      -- string that begins a comment
                        -> BufferM ()
unLineCommentSelectionB s1 s2 =
  modifyExtendedSelectionB Line $ mapLines unCommentLine
  where
  (l1, l2) = (R.length s1, R.length s2)

  unCommentLine :: R.YiString -> R.YiString
  unCommentLine line = case (R.splitAt l1 line, R.splitAt l2 line) of
    ((f, s) , (f', s')) | s1 == f   -> s
                        | s2 == f'  -> s'
                        | otherwise -> line

-- | Just like 'toggleCommentSelectionB' but automatically inserts a
-- whitespace suffix to the inserted comment string. In fact:
toggleCommentB :: R.YiString -> BufferM ()
toggleCommentB c = toggleCommentSelectionB (c `R.snoc` ' ') c

-- | Toggle line comments in the selection by adding or removing a
-- prefix to each line.
toggleCommentSelectionB :: R.YiString -> R.YiString -> BufferM ()
toggleCommentSelectionB insPrefix delPrefix = do
  l <- readUnitB Line
  if delPrefix == R.take (R.length delPrefix) l
    then unLineCommentSelectionB insPrefix delPrefix
    else linePrefixSelectionB insPrefix

-- | Replace the contents of the buffer with some string
replaceBufferContent :: YiString -> BufferM ()
replaceBufferContent newvalue = do
  r <- regionOfB Document
  replaceRegionB r newvalue

-- | Fill the text in the region so it fits nicely 80 columns.
fillRegion :: Region -> BufferM ()
fillRegion = modifyRegionB (R.unlines . fillText 80)

fillParagraph :: BufferM ()
fillParagraph = fillRegion =<< regionOfB unitParagraph

-- | Sort the lines of the region.
sortLines :: BufferM ()
sortLines = modifyExtendedSelectionB Line (onLines sort)

-- | Forces an extra newline into the region (if one exists)
modifyExtendedLRegion :: Region -> (R.YiString -> R.YiString) -> BufferM ()
modifyExtendedLRegion region transform = do
    reg <- unitWiseRegion Line region
    modifyRegionB transform (fixR reg)
  where fixR reg = mkRegion (regionStart reg) $ regionEnd reg + 1

sortLinesWithRegion :: Region -> BufferM ()
sortLinesWithRegion region = modifyExtendedLRegion region (onLines sort')
    where sort' [] = []
          sort' lns =
              if hasnl (last lns)
                  then sort lns
                  else over _last
                      -- should be completely safe since every element contains newline
                      (fromMaybe (error "sortLinesWithRegion fromMaybe") . R.init) . sort $
                          over _last (`R.snoc` '\n') lns
          hasnl t | R.last t == Just '\n' = True
                  | otherwise = False

-- | Helper function: revert the buffer contents to its on-disk version
revertB :: YiString -> UTCTime -> BufferM ()
revertB s now = do
  r <- regionOfB Document
  replaceRegionB r s
  markSavedB now

-- get lengths of parts covered by block region
--
-- Consider block region starting at 'o' and ending at 'z':
--
--    start
--      |
--     \|/
-- def foo(bar):
--     baz
--
--     ab
--     xyz0
--      /|\
--       |
--     finish
--
-- shapeOfBlockRegionB returns (regionStart, [2, 2, 0, 1, 2])
-- TODO: accept stickToEol flag
shapeOfBlockRegionB :: Region -> BufferM (Point, [Int])
shapeOfBlockRegionB reg = savingPointB $ do
    (l0, c0) <- getLineAndColOfPoint $ regionStart reg
    (l1, c1) <- getLineAndColOfPoint $ regionEnd reg
    let (left, top, bottom, right) = (min c0 c1, min l0 l1, max l0 l1, max c0 c1)
    lengths <- forM [top .. bottom] $ \l -> do
        void $ gotoLn l
        moveToColB left
        currentLeft <- curCol
        if currentLeft /= left
        then return 0
        else do
            moveToColB right
            rightAtEol <- atEol
            leftOnEol
            currentRight <- curCol
            return $ if currentRight == 0 && rightAtEol
                     then 0
                     else currentRight - currentLeft + 1
    startingPoint <- pointOfLineColB top left
    return (startingPoint, lengths)

leftEdgesOfRegionB :: RegionStyle -> Region -> BufferM [Point]
leftEdgesOfRegionB Block reg = savingPointB $ do
    (l0, _) <- getLineAndColOfPoint $ regionStart reg
    (l1, _) <- getLineAndColOfPoint $ regionEnd reg
    moveTo $ regionStart reg
    fmap catMaybes $ forM [0 .. abs (l0 - l1)] $ \i -> savingPointB $ do
        void $ lineMoveRel i
        p <- pointB
        eol <- atEol
        return (if not eol then Just p else Nothing)
leftEdgesOfRegionB LineWise reg = savingPointB $ do
    lastSol <- do
        moveTo $ regionEnd reg
        moveToSol
        pointB
    let  go acc p = do moveTo p
                       moveToSol
                       edge <- pointB
                       if edge >= lastSol
                       then return $ reverse (edge:acc)
                       else do
                           void $ lineMoveRel 1
                           go (edge:acc) =<< pointB
    go [] (regionStart reg)
leftEdgesOfRegionB _ r = return [regionStart r]

rightEdgesOfRegionB :: RegionStyle -> Region -> BufferM [Point]
rightEdgesOfRegionB Block reg = savingPointB $ do
    (l0, _) <- getLineAndColOfPoint $ regionStart reg
    (l1, _) <- getLineAndColOfPoint $ regionEnd reg
    moveTo $ 1 + regionEnd reg
    fmap reverse $ forM [0 .. abs (l0 - l1)] $ \i -> savingPointB $ do
        void $ lineMoveRel $ -i
        pointB
rightEdgesOfRegionB LineWise reg = savingPointB $ do
    lastEol <- do
        moveTo $ regionEnd reg
        moveToEol
        pointB
    let  go acc p = do moveTo p
                       moveToEol
                       edge <- pointB
                       if edge >= lastEol
                       then return $ reverse (edge:acc)
                       else do
                           void $ lineMoveRel 1
                           go (edge:acc) =<< pointB
    go [] (regionStart reg)
rightEdgesOfRegionB _ reg = savingPointB $ do
    moveTo $ regionEnd reg
    leftOnEol
    fmap return pointB

splitBlockRegionToContiguousSubRegionsB :: Region -> BufferM [Region]
splitBlockRegionToContiguousSubRegionsB reg = savingPointB $ do
    (start, lengths) <- shapeOfBlockRegionB reg
    forM (zip [0..] lengths) $ \(i, l) -> do
        moveTo start
        void $ lineMoveRel i
        p0 <- pointB
        moveXorEol l
        p1 <- pointB
        let subRegion = mkRegion p0 p1
        return subRegion

-- Return list containing a single point for all non-block styles.
-- For Block return all the points along the left edge of the region
deleteRegionWithStyleB :: Region -> RegionStyle -> BufferM (NonEmpty Point)
deleteRegionWithStyleB reg Block = savingPointB $ do
    (start, lengths) <- shapeOfBlockRegionB reg
    moveTo start
    points <- forM (zip [1..] lengths) $ \(i, l) -> do
        deleteN l
        p <- pointB
        moveTo start
        lineMoveRel i
        return (if l == 0 then Nothing else Just p)
    return $ start :| drop 1 (catMaybes points)

deleteRegionWithStyleB reg style = savingPointB $ do
    effectiveRegion <- convertRegionToStyleB reg style
    deleteRegionB effectiveRegion
    return $! pure (regionStart effectiveRegion)

readRegionRopeWithStyleB :: Region -> RegionStyle -> BufferM YiString
readRegionRopeWithStyleB reg Block = savingPointB $ do
    (start, lengths) <- shapeOfBlockRegionB reg
    moveTo start
    chunks <- forM lengths $ \l ->
        if l == 0
        then lineMoveRel 1 >> return mempty
        else do
            p <- pointB
            r <- readRegionB $ mkRegion p (p +~ Size l)
            void $ lineMoveRel 1
            return r
    return $ R.intersperse '\n' chunks
readRegionRopeWithStyleB reg style = readRegionB =<< convertRegionToStyleB reg style

insertRopeWithStyleB :: YiString -> RegionStyle -> BufferM ()
insertRopeWithStyleB rope Block = savingPointB $ do
  let ls = R.lines rope
      advanceLine = atLastLine >>= \case
        False -> void $ lineMoveRel 1
        True -> do
          col <- curCol
          moveToEol
          newlineB
          insertN $ R.replicateChar col ' '

  sequence_ $ intersperse advanceLine $ fmap (savingPointB . insertN) ls
insertRopeWithStyleB rope LineWise = do
    moveToSol
    savingPointB $ insertN rope
insertRopeWithStyleB rope _ = insertN rope

-- consider the following buffer content
--
-- 123456789
-- qwertyuio
-- asdfgh
--
-- The following examples use characters from that buffer as points.
-- h' denotes the newline after h
--
-- 1 r -> 4 q
-- 9 q -> 1 o
-- q h -> y a
-- a o -> h' q
-- o a -> q h'
-- 1 a -> 1 a
--
-- property: fmap swap (flipRectangleB a b) = flipRectangleB b a
flipRectangleB :: Point -> Point -> BufferM (Point, Point)
flipRectangleB p0 p1 = savingPointB $ do
    (_, c0) <- getLineAndColOfPoint p0
    (_, c1) <- getLineAndColOfPoint p1
    case compare c0 c1 of
        EQ -> return (p0, p1)
        GT -> swap <$> flipRectangleB p1 p0
        LT -> do
            -- now we know that c0 < c1
            moveTo p0
            moveXorEol $ c1 - c0
            flippedP0 <- pointB
            return (flippedP0, p1 -~ Size (c1 - c0))

movePercentageFileB :: Int -> BufferM ()
movePercentageFileB i = do
    let f :: Double
        f = case fromIntegral i / 100.0 of
               x | x > 1.0 -> 1.0
                 | x < 0.0 -> 0.0 -- Impossible?
                 | otherwise -> x
    lineCount <- lineCountB
    void $ gotoLn $ floor (fromIntegral lineCount * f)
    firstNonSpaceB

findMatchingPairB :: BufferM ()
findMatchingPairB = do
    let go dir a b = goUnmatchedB dir a b >> return True
        goToMatch = do
          c <- readB
          case c of '(' -> go Forward  '(' ')'
                    ')' -> go Backward '(' ')'
                    '{' -> go Forward  '{' '}'
                    '}' -> go Backward '{' '}'
                    '[' -> go Forward  '[' ']'
                    ']' -> go Backward '[' ']'
                    _   -> otherChar
        otherChar = do eof <- atEof
                       eol <- atEol
                       if eof || eol
                           then return False
                           else rightB >> goToMatch
    p <- pointB
    foundMatch <- goToMatch
    unless foundMatch $ moveTo p

-- Vim numbers

-- | Increase (or decrease if negative) next number on line by n.
incrementNextNumberByB :: Int -> BufferM ()
incrementNextNumberByB n = do
    start <- pointB
    untilB_ (not <$> isNumberB) $ moveXorSol 1
    untilB_          isNumberB  $ moveXorEol 1
    begin <- pointB
    beginIsEol <- atEol
    untilB_ (not <$> isNumberB) $ moveXorEol 1
    end <- pointB
    if beginIsEol then moveTo start
    else do modifyRegionB (increment n) (mkRegion begin end)
            moveXorSol 1

-- | Increment number in string by n.
increment :: Int -> R.YiString -> R.YiString
increment n l = R.fromString $ go (R.toString l)
  where
    go ('0':'x':xs) = (\ys -> '0':'x':ys) . (`showHex` "") . (+ n) . fst . head . readHex $ xs
    go ('0':'o':xs) = (\ys -> '0':'o':ys) . (`showOct` "") . (+ n) . fst . head . readOct $ xs
    go s            = show . (+ n) . (\x -> read x :: Int) $ s

-- | Is character under cursor a number.
isNumberB :: BufferM Bool
isNumberB = do
    eol <- atEol
    sol <- atSol
    if sol then isDigit <$> readB
    else if eol then return False
         else test3CharB

-- | Used by isNumber to test if current character under cursor is a number.
test3CharB :: BufferM Bool
test3CharB = do
    moveXorSol 1
    previous <- readB
    moveXorEol 2
    next <- readB
    moveXorSol 1
    current <- readB
    if | previous == '0' && current == 'o' && isOctDigit next -> return True  -- octal format
       | previous == '0' && current == 'x' && isHexDigit next -> return True  -- hex format
       |                    current == '-' && isDigit next    -> return True  -- negative numbers
       |                    isDigit current                   -> return True  -- all decimal digits
       |                    isHexDigit current                -> testHexB     -- ['a'..'f'] for hex
       | otherwise                                            -> return False

-- | Characters ['a'..'f'] are part of a hex number only if preceded by 0x.
-- Test if the current occurence of ['a'..'f'] is part of a hex number.
testHexB :: BufferM Bool
testHexB = savingPointB $ do
    untilB_ (not . isHexDigit <$> readB) (moveXorSol 1)
    leftChar <- readB
    moveXorSol 1
    leftToLeftChar <- readB
    if leftChar == 'x' && leftToLeftChar == '0'
    then return True
    else return False

-- | Move point down by @n@ lines
-- If line extends past width of window, count moving
-- a single line as moving width points to the right.
lineMoveVisRel :: Int -> BufferM ()
lineMoveVisRel = movingToPrefVisCol . lineMoveVisRelUp

lineMoveVisRelUp :: Int -> BufferM ()
lineMoveVisRelUp 0 = return ()
lineMoveVisRelUp n | n < 0 = lineMoveVisRelDown $ negate n
                   | otherwise = do
    wid <- width <$> use lastActiveWindowA
    col <- curCol
    len <- pointB >>= eolPointB >>= colOf
    let jumps = (len `div` wid) - (col `div` wid)
        next = n - jumps
    if next <= 0
        then moveXorEol (n * wid)
        else do moveXorEol (jumps * wid)
                void $ gotoLnFrom 1
                lineMoveVisRelUp $ next - 1

lineMoveVisRelDown :: Int -> BufferM ()
lineMoveVisRelDown 0 = return ()
lineMoveVisRelDown n | n < 0 = lineMoveVisRelUp $ negate n
                     | otherwise = do
    wid <- width <$> use lastActiveWindowA
    col <- curCol
    let jumps = col `div` wid
        next = n - jumps
    if next <= 0
        then leftN (n * wid)
        else do leftN (jumps * wid)
                void $ gotoLnFrom $ -1
                moveToEol
                lineMoveVisRelDown $ next - 1

-- | Implements the same logic that emacs' `mark-word` does.
-- Checks the mark point and moves it forth (or backward) for one word.
markWord :: BufferM ()
markWord = do
    curPos <- pointB
    curMark <- getSelectionMarkPointB
    isVisible <- getVisibleSelection

    savingPointB $ do
        if not isVisible
        then nextWordB
        else do
            moveTo curMark
            if curMark < curPos
            then prevWordB
            else nextWordB

        setVisibleSelection True
        pointB >>= setSelectionMarkPointB