module Rasa.Ext.Cursors.Internal.Base
( rangeDo
, rangeDo_
, overRanges
, getRanges
, setRanges
, overEachRange
, addRange
, setStyleProvider
) where
import Rasa.Ext
import Control.Monad.State
import Control.Lens
import Data.Typeable
import Data.List
import Data.Default
import qualified Yi.Rope as Y
data Cursors =
Cursors [CrdRange]
deriving (Typeable, Show)
instance Default Cursors where
def = Cursors [Range (Coord 0 0) (Coord 0 1)]
ensureSize :: CrdRange -> CrdRange
ensureSize r@(Range start end)
| start == end =
if start^.coordCol == 0 then r & rEnd %~ moveCursorByN 1
else r & rStart %~ moveCursorByN (1)
| otherwise = r
cleanRanges :: Y.YiString -> [CrdRange] -> [CrdRange]
cleanRanges txt = fmap (ensureSize . clampRange txt) . reverse . nub . sort
getRanges :: BufAction [CrdRange]
getRanges = do
Cursors ranges <- getBufExt
return ranges
setRanges :: [CrdRange] -> BufAction ()
setRanges new = do
txt <- getText
setBufExt . Cursors $ cleanRanges txt new
overRanges :: ([CrdRange] -> [CrdRange]) -> BufAction ()
overRanges f = getRanges >>= setRanges . f
rangeDo :: (CrdRange -> BufAction a) -> BufAction [a]
rangeDo f = getRanges >>= mapM f
rangeDo_ :: (CrdRange -> BufAction a) -> BufAction ()
rangeDo_ = void . rangeDo
overEachRange :: (CrdRange -> BufAction CrdRange) -> BufAction ()
overEachRange f = rangeDo f >>= setRanges
addRange :: CrdRange -> BufAction ()
addRange r = overRanges (++[r])
setStyleProvider :: BufAction ()
setStyleProvider = void . addStyleProvider $ rangeDo setStyle
where
setStyle :: CrdRange -> BufAction (Span CrdRange Style)
setStyle r = return $ Span r (flair ReverseVideo)