module Rasa.Internal.Range
( Coord
, Coord'(..)
, overRow
, overCol
, overBoth
, coordRow
, coordCol
, Offset(..)
, asCoord
, clampCoord
, clampRange
, Range(..)
, CrdRange
, range
, rStart
, rEnd
, sizeOf
, sizeOfR
, moveRange
, moveRangeByN
, moveCursorByN
, moveCursor
, Span(..)
, combineSpans
, clamp
, beforeC
, afterC
) where
import Rasa.Internal.Text
import Control.Lens
import Data.Maybe
import Data.Monoid
import Data.List
import Data.Bifunctor
import Data.Biapplicative
import Data.Bitraversable
import Data.Bifoldable
import qualified Yi.Rope as Y
data Range a b = Range
{ _rStart :: a
, _rEnd :: b
} deriving (Eq)
makeLenses ''Range
instance (Show a, Show b) => Show (Range a b) where
show (Range a b) = "(Range (start " ++ show a ++ ") (end " ++ show b ++ "))"
instance Bifunctor Range where
bimap f g (Range a b) = Range (f a) (g b)
instance Bifoldable Range where
bifoldMap f g (Range a b) = f a `mappend` g b
instance Bitraversable Range where
bitraverse f g (Range a b) = Range <$> f a <*> g b
instance (Ord a, Ord b) => Ord (Range a b) where
Range start end <= Range start' end'
| end == end' = start <= start'
| otherwise = end <= end'
data Coord' a b = Coord
{ _coordRow::a
, _coordCol::b
} deriving (Eq)
makeLenses ''Coord'
instance (Show a, Show b) => Show (Coord' a b) where
show (Coord a b) = "(Coord (row " ++ show a ++ ") (col " ++ show b ++ "))"
type Coord = Coord' Int Int
type CrdRange = Range Coord Coord
instance Bifunctor Coord' where
bimap f g (Coord a b) = Coord (f a) (g b)
overRow :: (Int -> Int) -> Coord -> Coord
overRow = first
overCol :: (Int -> Int) -> Coord -> Coord
overCol = second
overBoth :: Bifunctor f => (a -> b) -> f a a -> f b b
overBoth f = bimap f f
instance Biapplicative Coord' where
bipure = Coord
Coord f g <<*>> Coord a b = Coord (f a) (g b)
instance (Ord a, Ord b) => Ord (Coord' a b) where
Coord a b <= Coord a' b'
| a < a' = True
| a > a' = False
| otherwise = b <= b'
newtype Offset =
Offset Int
deriving (Show, Eq)
data Span a b =
Span a b
deriving (Show, Eq, Functor)
instance Bifunctor Span where
bimap f g (Span a b) = Span (f a) (g b)
moveRange :: Coord -> CrdRange -> CrdRange
moveRange amt = overBoth (moveCursor amt)
moveRangeByN :: Int -> CrdRange -> CrdRange
moveRangeByN amt = overBoth (moveCursorByN amt)
moveCursorByN :: Int -> Coord -> Coord
moveCursorByN amt = overCol (+amt)
moveCursor :: Coord -> Coord -> Coord
moveCursor = biliftA2 (+) (+)
instance (Num a, Num b) => Num (Coord' a b) where
Coord row col + Coord row' col' = Coord (row + row') (col + col')
Coord row col Coord row' col' = Coord (row row') (col col')
Coord row col * Coord row' col' = Coord (row * row') (col * col')
abs (Coord row col) = Coord (abs row) (abs col)
fromInteger i = Coord 0 (fromInteger i)
signum (Coord row col) = Coord (signum row) (signum col)
asCoord :: Y.YiString -> Iso' Offset Coord
asCoord txt = iso (toCoord txt) (toOffset txt)
toOffset :: Y.YiString -> Coord -> Offset
toOffset txt (Coord row col) = Offset $ lenRows + col
where
lenRows = Y.length . Y.concat . take row . Y.lines' $ txt
toCoord :: Y.YiString -> Offset -> Coord
toCoord txt (Offset offset) = Coord numRows numColumns
where
numRows = Y.countNewLines . Y.take offset $ txt
numColumns = (offset ) . Y.length . Y.concat . take numRows . Y.lines' $ txt
clampCoord :: Y.YiString -> Coord -> Coord
clampCoord txt (Coord row col) =
Coord (clamp 0 maxRow row) (clamp 0 maxColumn col)
where
maxRow = Y.countNewLines txt
maxColumn = fromMaybe col (txt ^? asLines . ix row . to Y.length)
clampRange :: Y.YiString -> CrdRange -> CrdRange
clampRange txt = overBoth (clampCoord txt)
data Marker
= Start
| End
deriving (Show, Eq)
type ID = Int
combineSpans
:: forall a.
Monoid a
=> [Span CrdRange a] -> [(Coord, a)]
combineSpans spans = combiner [] $ sortOn (view _3) (splitStartEnd idSpans)
where
idSpans :: [(ID, Span CrdRange a)]
idSpans = zip [1 ..] spans
splitStartEnd :: [(ID, Span CrdRange a)] -> [(Marker, ID, Coord, a)]
splitStartEnd [] = []
splitStartEnd ((i, Span (Range s e) d):rest) =
(Start, i, s, d) : (End, i, e, d) : splitStartEnd rest
withoutId :: ID -> [(ID, a)] -> [(ID, a)]
withoutId i = filter ((/= i) . fst)
combiner :: [(ID, a)] -> [(Marker, ID, Coord, a)] -> [(Coord, a)]
combiner _ [] = []
combiner cur ((Start, i, crd, mData):rest) =
let dataSum = foldMap snd cur <> mData
newData = (i, mData) : cur
in (crd, dataSum) : combiner newData rest
combiner cur ((End, i, crd, _):rest) =
let dataSum = foldMap snd newData
newData = withoutId i cur
in (crd, dataSum) : combiner newData rest
clamp :: Int -> Int -> Int -> Int
clamp mn mx n
| n < mn = mn
| n > mx = mx
| otherwise = n
sizeOfR :: CrdRange -> Coord
sizeOfR (Range start end) = end start
sizeOf :: Y.YiString -> Coord
sizeOf txt = Coord (Y.countNewLines txt) (Y.length (txt ^. asLines . _last))
beforeC :: Coord -> Lens' Y.YiString Y.YiString
beforeC c@(Coord row col) = lens getter setter
where getter txt =
txt ^.. asLines . taking (row + 1) traverse
& _last %~ Y.take col
& Y.concat
setter old new = let suffix = old ^. afterC c
in new <> suffix
afterC :: Coord -> Lens' Y.YiString Y.YiString
afterC c@(Coord row col) = lens getter setter
where getter txt =
txt ^.. asLines . dropping row traverse
& _head %~ Y.drop col
& Y.concat
setter old new = let prefix = old ^. beforeC c
in prefix <> new
range :: CrdRange -> Lens' Y.YiString Y.YiString
range (Range start end) = lens getter setter
where getter = view (beforeC end . afterC start)
setter old new = result
where
setBefore = old & beforeC end .~ new
result = old & afterC start .~ setBefore