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

-- |
-- Module      :  Yi.Buffer.Region
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Handles indentation in the keymaps. Includes:
--
--  * (TODO) Auto-indentation to the previous lines indentation
--  * Tab-expansion
--  * Shifting of the indentation for a region of text

module Yi.Buffer.Indent
    ( autoIndentB
    , cycleIndentsB
    , indentAsNextB
    , indentAsPreviousB
    , indentAsTheMostIndentedNeighborLineB
    , indentOfB
    , indentOfCurrentPosB
    , indentSettingsB
    , indentToB
    , modifyIndentB
    , newlineAndIndentB
    , shiftIndentOfRegionB
    , tabB
    ) where

import           Control.Monad       ()
import           Data.Char           (isSpace)
import           Data.List           (nub, sort)
import           Data.Monoid         ((<>))
import           Yi.Buffer.Basic     (Direction (..))
import           Yi.Buffer.HighLevel (firstNonSpaceB, getNextLineB, getNextNonBlankLineB, moveToSol, readLnB)
import           Yi.Buffer.Misc
import           Yi.Buffer.Region    (Region (regionStart), mkRegion, modifyRegionB, readRegionB)
import           Yi.Buffer.TextUnit  (regionWithTwoMovesB)
import           Yi.Rope             (YiString)
import qualified Yi.Rope             as R
import           Yi.String           (mapLines)

{- |
  Return either a \t or the number of spaces specified by tabSize in the
  IndentSettings. Note that if you actually want to insert a tab character
  (for example when editing makefiles) then you should use: @insertB '\t'@.
-}
tabB :: BufferM String
tabB :: BufferM String
tabB = do
  IndentSettings
indentSettings <- BufferM IndentSettings
indentSettingsB
  String -> BufferM String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> BufferM String) -> String -> BufferM String
forall a b. (a -> b) -> a -> b
$ if IndentSettings -> Bool
expandTabs IndentSettings
indentSettings
    then Int -> Char -> String
forall a. Int -> a -> [a]
replicate (IndentSettings -> Int
tabSize IndentSettings
indentSettings) Char
' '
    else String
"\t"

{-|
  A specialisation of 'autoIndentHelperB'.
  This is the most basic and the user is encouraged to
  specialise 'autoIndentHelperB' on their own.
-}
autoIndentB :: IndentBehaviour -> BufferM ()
autoIndentB :: IndentBehaviour -> BufferM ()
autoIndentB = BufferM [Int]
-> (YiString -> BufferM [Int]) -> IndentBehaviour -> BufferM ()
autoIndentHelperB BufferM [Int]
fetchPreviousIndentsB YiString -> BufferM [Int]
indentsOfString
  where
  -- Returns the indentation hints considering the given
  -- string as the line above the current one.
  -- The hints added are:
  --     The indent of the given string
  --     The indent of the given string plus two
  --     The offset of the last open bracket if any in the line.
  indentsOfString :: YiString -> BufferM [Int]
  indentsOfString :: YiString -> BufferM [Int]
indentsOfString YiString
input = do
    Int
indent       <- YiString -> BufferM Int
indentOfB YiString
input
    [Int]
bracketHints <- YiString -> BufferM [Int]
lastOpenBracketHint YiString
input
    IndentSettings
indentSettings <- BufferM IndentSettings
indentSettingsB
    [Int] -> BufferM [Int]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> BufferM [Int]) -> [Int] -> BufferM [Int]
forall a b. (a -> b) -> a -> b
$ Int
indent Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ IndentSettings -> Int
shiftWidth IndentSettings
indentSettings) Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
bracketHints

{-|
  This takes two arguments the first is a function to
  obtain indentation hints from lines above the current one.
  The second is a function to obtain a set of indentation hints
  from the previous line. Both of these are in the 'BufferM'
  monad although the second seems like it is unnecessary.
  However we must take into account the length of tabs which come
  from the the tab settings and hence we must be in the 'BufferM'
  monad.

  To get the straightforward behaviour of the indents of all previous
  lines until one of them has zero indent call this with:
  @autoIndentHelperB fetchPreviousIndentsB (fmap (: []) indentOfB)@
  However commonly we wish to have something more interesting for
  the second argument, in particular we commonly wish to have the
  last opening bracket of the previous line as well as its indent.
-}
autoIndentHelperB :: BufferM [ Int ]
                  -- ^ Action to fetch hints from previous lines
                 -> (YiString -> BufferM [ Int ])
                 -- ^ Action to calculate hints from previous line
                 -> IndentBehaviour
                 -- ^ Sets the indent behaviour,
                 -- see 'Yi.Buffer.IndentBehaviour' for a description
                 -> BufferM ()
autoIndentHelperB :: BufferM [Int]
-> (YiString -> BufferM [Int]) -> IndentBehaviour -> BufferM ()
autoIndentHelperB BufferM [Int]
getUpwards YiString -> BufferM [Int]
getPrevious IndentBehaviour
indentBehave =
  do [Int]
upwardHints   <- BufferM [Int] -> BufferM [Int]
forall a. BufferM a -> BufferM a
savingExcursionB BufferM [Int]
getUpwards
     YiString
previousLine  <- Direction -> BufferM YiString
getNextLineB Direction
Backward
     [Int]
previousHints <- YiString -> BufferM [Int]
getPrevious YiString
previousLine
     let allHints :: [Int]
allHints = [Int]
upwardHints [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
previousHints
     IndentBehaviour -> [Int] -> BufferM ()
cycleIndentsB IndentBehaviour
indentBehave [Int]
allHints

-- | Cycles through the indentation hints. It does this without
-- requiring to set/get any state. We just look at the current
-- indentation of the current line and moving to the largest
-- indent that is
cycleIndentsB :: IndentBehaviour -> [Int] -> BufferM ()
cycleIndentsB :: IndentBehaviour -> [Int] -> BufferM ()
cycleIndentsB IndentBehaviour
_ [] = () -> BufferM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
cycleIndentsB IndentBehaviour
indentBehave [Int]
indents =
    do YiString
currentLine   <- BufferM YiString
readLnB
       Int
currentIndent <- YiString -> BufferM Int
indentOfB YiString
currentLine
       Int -> BufferM ()
indentToB (Int -> BufferM ()) -> Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> Int
chooseIndent Int
currentIndent ([Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall a. Eq a => [a] -> [a]
nub [Int]
indents)
  where
  -- Is the function to choose the indent from the given current
  -- indent to the given list of indentation hints.
  chooseIndent :: Int -> [ Int ] -> Int
  chooseIndent :: Int -> [Int] -> Int
chooseIndent =
    case IndentBehaviour
indentBehave of
      IndentBehaviour
IncreaseCycle -> Int -> [Int] -> Int
chooseIncreaseCycle
      IndentBehaviour
DecreaseCycle -> Int -> [Int] -> Int
chooseDecreaseCycle
      IndentBehaviour
IncreaseOnly  -> Int -> [Int] -> Int
chooseIncreaseOnly
      IndentBehaviour
DecreaseOnly  -> Int -> [Int] -> Int
chooseDecreaseOnly



  -- Choose the indentation hint which is one more than the current
  -- indentation hint unless the current is the largest or larger than
  -- all the indentation hints in which case choose the smallest
  -- (which will often be zero)
  chooseIncreaseCycle :: Int -> [ Int ] -> Int
  chooseIncreaseCycle :: Int -> [Int] -> Int
chooseIncreaseCycle Int
currentIndent [Int]
hints =
    -- Similarly to 'chooseDecreasing' if 'above' is null then
    -- we will go to the first of below which will be the smallest
    -- indentation hint, if above is not null then we are moving to
    -- the indentation hint which is one above the current.
    [Int] -> Int
forall a. [a] -> a
head ([Int]
above [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
below)
    where
    ([Int]
below, [Int]
above) = (Int -> Bool) -> [Int] -> ([Int], [Int])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
currentIndent) [Int]
hints

  -- Note that these functions which follow generally assume that
  -- the list of hints which have been given is already sorted
  -- and that the list is non-empty

  -- Choose the indentation hint one less than the current indentation
  -- unless the current indentation is the smallest (usually zero)
  -- in which case choose the largest indentation hint.
  chooseDecreaseCycle :: Int -> [ Int ] -> Int
  chooseDecreaseCycle :: Int -> [Int] -> Int
chooseDecreaseCycle Int
currentIndent [Int]
hints =
    -- So in particular if 'below' is null then we will
    -- go to the largest indentation, if below is not null
    -- we go to the largest indentation which is *not* higher
    -- than the current one.
    [Int] -> Int
forall a. [a] -> a
last ([Int]
above [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
below)
    where
    ([Int]
below, [Int]
above) = (Int -> Bool) -> [Int] -> ([Int], [Int])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
currentIndent) [Int]
hints

  chooseIncreaseOnly :: Int -> [ Int ] -> Int
  chooseIncreaseOnly :: Int -> [Int] -> Int
chooseIncreaseOnly Int
currentIndent [Int]
hints =
    [Int] -> Int
forall a. [a] -> a
head ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
currentIndent) [Int]
hints [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [ Int
currentIndent ]

  chooseDecreaseOnly :: Int -> [ Int ] -> Int
  chooseDecreaseOnly :: Int -> [Int] -> Int
chooseDecreaseOnly Int
currentIndent [Int]
hints =
    [Int] -> Int
forall a. [a] -> a
last ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Int
currentIndent Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
currentIndent) [Int]
hints

{-|
  A function generally useful as the first argument to
  'autoIndentHelperB'. This searches the lines above
  the current line for the indentations of each line
  until we get to a line which has no indentation
  *and* is not empty. Indicating that we have reached
  the outer scope.
-}
fetchPreviousIndentsB :: BufferM [Int]
fetchPreviousIndentsB :: BufferM [Int]
fetchPreviousIndentsB = do
  -- Move up one line,
  Int
moveOffset <- Int -> BufferM Int
lineMoveRel (-Int
1)
  YiString
line       <- BufferM YiString
readLnB
  Int
indent     <- YiString -> BufferM Int
indentOfB YiString
line
  -- So if we didn't manage to move upwards
  -- or the current offset was zero *and* the line
  -- was non-blank then we return just the current
  -- indent (it might be the first line but indented some.)
  if Int
moveOffset Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| (Int
indent Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& (Char -> Bool) -> YiString -> Bool
R.any (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) YiString
line)
    then [Int] -> BufferM [Int]
forall (m :: * -> *) a. Monad m => a -> m a
return [ Int
indent ]
    else (Int
indent Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) ([Int] -> [Int]) -> BufferM [Int] -> BufferM [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM [Int]
fetchPreviousIndentsB

-- | Returns the position of the last opening bracket on the
-- line which is not closed on the same line.
-- Note that if we have unmatched parentheses such as "( ]"
-- then we may not get the correct answer, but in that case
-- then arguably we don't really care if we get the correct
-- answer (at least if we get it wrong the user may notice
-- their error).
-- We return a list here as it's a convenient way of returning
-- no hint in the case of there being no non-closed bracket
-- and normally such a hint will be part of a list of hints
-- anyway.
-- NOTE: this could be easily modified to return the indentations
-- of *all* the non-closed opening brackets. But I think this is
-- not what you generally want.
-- TODO: we also do not care whether or not the bracket is within
-- a string or escaped. If someone feels up to caring about that
-- by all means please fix this.
lastOpenBracketHint :: YiString -> BufferM [ Int ]
lastOpenBracketHint :: YiString -> BufferM [Int]
lastOpenBracketHint YiString
input =
  case Int -> YiString -> Maybe YiString
getOpen Int
0 (YiString -> Maybe YiString) -> YiString -> Maybe YiString
forall a b. (a -> b) -> a -> b
$ YiString -> YiString
R.reverse YiString
input of
    Maybe YiString
Nothing -> [Int] -> BufferM [Int]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Just YiString
s  -> Int -> [Int]
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> [Int]) -> BufferM Int -> BufferM [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> YiString -> BufferM Int
spacingOfB YiString
s
  where
  -- We get the last open bracket by counting through
  -- the reversed line, when we see a closed bracket we
  -- add one to the count. When we see an opening bracket
  -- decrease the count. If we see an opening bracket when the
  -- count is 0 we return the remaining (reversed) string
  -- as the part of the line which preceds the last opening bracket.
  -- This can then be turned into an indentation by calling 'spacingOfB'
  -- on it so that tabs are counted as tab length.
  -- NOTE: that this will work even if tab occur in the middle of the line
  getOpen :: Int -> YiString -> Maybe YiString
  getOpen :: Int -> YiString -> Maybe YiString
getOpen Int
i YiString
s = let rest :: YiString
rest = Int -> YiString -> YiString
R.drop Int
1 YiString
s in case YiString -> Maybe Char
R.head YiString
s of
    Maybe Char
Nothing -> Maybe YiString
forall a. Maybe a
Nothing
    Just Char
c
        -- If it is opening and we have no closing to match
        -- then we return the rest of the line
      | Char -> Bool
isOpening Char
c Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> YiString -> Maybe YiString
forall a. a -> Maybe a
Just YiString
rest
        -- If i is not zero then we have matched one of the
        -- closing parentheses and we can decrease the nesting count.
      | Char -> Bool
isOpening Char
c           -> Int -> YiString -> Maybe YiString
getOpen (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) YiString
rest
        -- If the character is a closing bracket then we must increase
        -- the nesting count
      | Char -> Bool
isClosing Char
c           -> Int -> YiString -> Maybe YiString
getOpen (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) YiString
rest
        -- If it is just a normal character forget about it and move on.
      | Bool
otherwise             -> Int -> YiString -> Maybe YiString
getOpen Int
i YiString
rest

  isOpening :: Char -> Bool
  isOpening :: Char -> Bool
isOpening Char
'(' = Bool
True
  isOpening Char
'[' = Bool
True
  isOpening Char
'{' = Bool
True
  isOpening Char
_   = Bool
False

  isClosing :: Char -> Bool
  isClosing :: Char -> Bool
isClosing Char
')' = Bool
True
  isClosing Char
']' = Bool
True
  isClosing Char
'}' = Bool
True
  isClosing Char
_   = Bool
False

-- | Returns the indentation of a given string. Note that this depends
-- on the current indentation settings.
indentOfB :: YiString -> BufferM Int
indentOfB :: YiString -> BufferM Int
indentOfB = YiString -> BufferM Int
spacingOfB (YiString -> BufferM Int)
-> (YiString -> YiString) -> YiString -> BufferM Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> YiString -> YiString
R.takeWhile Char -> Bool
isSpace

makeIndentString :: Int -> BufferM YiString
makeIndentString :: Int -> BufferM YiString
makeIndentString Int
level = do
  IndentSettings Bool
et Int
_ Int
sw <- BufferM IndentSettings
indentSettingsB
  let (Int
q, Int
r) = Int
level Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
sw
  if Bool
et
  then YiString -> BufferM YiString
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> YiString -> YiString
R.replicate Int
level YiString
" ")
  else YiString -> BufferM YiString
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> YiString -> YiString
R.replicate Int
q YiString
"\t" YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> Int -> YiString -> YiString
R.replicate Int
r YiString
" ")

-- | Returns the length of a given string taking into account the
-- white space and the indentation settings.
spacingOfB :: YiString -> BufferM Int
spacingOfB :: YiString -> BufferM Int
spacingOfB YiString
text = do
  IndentSettings
indentSettings <- BufferM IndentSettings
indentSettingsB
  Int -> BufferM Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> BufferM Int) -> Int -> BufferM Int
forall a b. (a -> b) -> a -> b
$ IndentSettings -> YiString -> Int
countIndent IndentSettings
indentSettings YiString
text

{-| Indents the current line to the given indentation level.
    In addition moves the point according to where it was on the
    line originally. If we were somewhere within the indentation
    (ie at the start of the line or on an empty line) then we want
    to just go to the end of the (new) indentation.
    However if we are currently pointing somewhere within the text
    of the line then we wish to remain pointing to the same character.
-}
indentToB :: Int -> BufferM ()
indentToB :: Int -> BufferM ()
indentToB = (Int -> Int) -> BufferM ()
modifyIndentB ((Int -> Int) -> BufferM ())
-> (Int -> Int -> Int) -> Int -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a b. a -> b -> a
const

-- | Modifies current line indent measured in visible spaces.
-- Respects indent settings. Calling this with value (+ 4)
-- will turn "\t" into "\t\t" if shiftwidth is 4 and into
-- "\t    " if shiftwidth is 8
-- If current line is empty nothing happens.
modifyIndentB :: (Int -> Int) -> BufferM ()
modifyIndentB :: (Int -> Int) -> BufferM ()
modifyIndentB Int -> Int
f = do
  Region
leadingSpaces <- BufferM () -> BufferM () -> BufferM Region
forall a b. BufferM a -> BufferM b -> BufferM Region
regionWithTwoMovesB BufferM ()
moveToSol BufferM ()
firstNonSpaceB
  YiString
newLeadinSpaces <-
    Region -> BufferM YiString
readRegionB Region
leadingSpaces BufferM YiString -> (YiString -> BufferM Int) -> BufferM Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= YiString -> BufferM Int
indentOfB BufferM Int -> (Int -> BufferM YiString) -> BufferM YiString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> BufferM YiString
makeIndentString (Int -> BufferM YiString)
-> (Int -> Int) -> Int -> BufferM YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
f
  (YiString -> YiString) -> Region -> BufferM ()
modifyRegionB (YiString -> YiString -> YiString
forall a b. a -> b -> a
const YiString
newLeadinSpaces) Region
leadingSpaces

-- | Indent as much as the previous line
indentAsPreviousB :: BufferM ()
indentAsPreviousB :: BufferM ()
indentAsPreviousB = Direction -> BufferM ()
indentAsNeighborLineB Direction
Backward

-- | Indent as much as the next line
indentAsNextB :: BufferM ()
indentAsNextB :: BufferM ()
indentAsNextB = Direction -> BufferM ()
indentAsNeighborLineB Direction
Forward

indentAsTheMostIndentedNeighborLineB :: BufferM ()
indentAsTheMostIndentedNeighborLineB :: BufferM ()
indentAsTheMostIndentedNeighborLineB = do
  YiString
prevLine <- Direction -> BufferM YiString
getNextNonBlankLineB Direction
Backward
  YiString
nextLine <- Direction -> BufferM YiString
getNextNonBlankLineB Direction
Forward
  Int
prevIndent <- YiString -> BufferM Int
indentOfB YiString
prevLine
  Int
nextIndent <- YiString -> BufferM Int
indentOfB YiString
nextLine
  Int -> BufferM ()
indentToB (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
prevIndent Int
nextIndent)

indentAsNeighborLineB :: Direction -> BufferM ()
indentAsNeighborLineB :: Direction -> BufferM ()
indentAsNeighborLineB Direction
dir = do
  YiString
otherLine   <- Direction -> BufferM YiString
getNextNonBlankLineB Direction
dir
  Int
otherIndent <- YiString -> BufferM Int
indentOfB YiString
otherLine
  Int -> BufferM ()
indentToB Int
otherIndent

-- | Insert a newline at point and indent the new line as the previous one.
newlineAndIndentB :: BufferM ()
newlineAndIndentB :: BufferM ()
newlineAndIndentB = BufferM ()
newlineB BufferM () -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM ()
indentAsPreviousB

-- | Set the padding of the string to newCount, filling in tabs if
-- expandTabs is set in the buffers IndentSettings
rePadString :: IndentSettings -> Int -> R.YiString -> R.YiString
rePadString :: IndentSettings -> Int -> YiString -> YiString
rePadString IndentSettings
indentSettings Int
newCount YiString
input
    | Int
newCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = YiString
rest
    | IndentSettings -> Bool
expandTabs IndentSettings
indentSettings = Int -> Char -> YiString
R.replicateChar Int
newCount Char
' ' YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString
rest
    | Bool
otherwise = YiString
tabs YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString
spaces YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString
rest
    where (YiString
_indents,YiString
rest) = (Char -> Bool) -> YiString -> (YiString, YiString)
R.span Char -> Bool
isSpace YiString
input
          tabs :: YiString
tabs   = Int -> Char -> YiString
R.replicateChar (Int
newCount Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` IndentSettings -> Int
tabSize IndentSettings
indentSettings) Char
'\t'
          spaces :: YiString
spaces = Int -> Char -> YiString
R.replicateChar (Int
newCount Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` IndentSettings -> Int
tabSize IndentSettings
indentSettings) Char
' '

-- | Counts the size of the indent in the given text.
--
-- Assumes nothing but tabs and spaces: uses 'isSpace'.
countIndent :: IndentSettings -> R.YiString -> Int
countIndent :: IndentSettings -> YiString -> Int
countIndent IndentSettings
i YiString
t = (Int -> Char -> Int) -> Int -> YiString -> Int
forall a. (a -> Char -> a) -> a -> YiString -> a
R.foldl' (\Int
i' Char
c -> Int
i' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
spacing Char
c) Int
0 YiString
indents
  where
    (YiString
indents, YiString
_) = (Char -> Bool) -> YiString -> (YiString, YiString)
R.span Char -> Bool
isSpace YiString
t

    spacing :: Char -> Int
spacing Char
'\t' = IndentSettings -> Int
tabSize IndentSettings
i
    spacing Char
_    = Int
1

-- | shifts right (or left if num is negative) num times, filling in tabs if
-- expandTabs is set in the buffers IndentSettings
indentString :: IndentSettings -> Int -> R.YiString -> R.YiString
indentString :: IndentSettings -> Int -> YiString -> YiString
indentString IndentSettings
is Int
numOfShifts YiString
i = IndentSettings -> Int -> YiString -> YiString
rePadString IndentSettings
is Int
newCount YiString
i
    where
      newCount :: Int
newCount = IndentSettings -> YiString -> Int
countIndent IndentSettings
is YiString
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (IndentSettings -> Int
shiftWidth IndentSettings
is Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
numOfShifts)

-- | Increases the indentation on the region by the given amount of shiftWidth
shiftIndentOfRegionB :: Int -> Region -> BufferM ()
shiftIndentOfRegionB :: Int -> Region -> BufferM ()
shiftIndentOfRegionB Int
shiftCount Region
region = do
    IndentSettings
is <- BufferM IndentSettings
indentSettingsB
    let indentFn :: R.YiString -> R.YiString
        indentFn :: YiString -> YiString
indentFn YiString
line = if Bool -> Bool
not (YiString -> Bool
R.null YiString
line) Bool -> Bool -> Bool
&& YiString
line YiString -> YiString -> Bool
forall a. Eq a => a -> a -> Bool
/= YiString
"\n"
            then IndentSettings -> Int -> YiString -> YiString
indentString IndentSettings
is Int
shiftCount YiString
line
            else YiString
line
    (YiString -> YiString) -> Region -> BufferM ()
modifyRegionB ((YiString -> YiString) -> YiString -> YiString
mapLines YiString -> YiString
indentFn) Region
region
    Point -> BufferM ()
moveTo (Point -> BufferM ()) -> Point -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Region -> Point
regionStart Region
region
    BufferM ()
firstNonSpaceB

-- | Return the number of spaces at the beginning of the line, up to
-- the point.
indentOfCurrentPosB :: BufferM Int
indentOfCurrentPosB :: BufferM Int
indentOfCurrentPosB = do
  Point
p <- BufferM Point
pointB
  BufferM ()
moveToSol
  Point
sol <- BufferM Point
pointB
  Point -> BufferM ()
moveTo Point
p
  let region :: Region
region = Point -> Point -> Region
mkRegion Point
p Point
sol
  Region -> BufferM YiString
readRegionB Region
region BufferM YiString -> (YiString -> BufferM Int) -> BufferM Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= YiString -> BufferM Int
spacingOfB