module Text.Pandoc.Filter.EmphasizeCode.Range
( Range
, rangeStart
, rangeEnd
, mkRange
, rangeToTuple
, rangeToTuples
, lineIntersectsWithRange
, Ranges
, rangesToList
, RangesError(..)
, mkRanges
, LineRange
, lineRangeLine
, lineRangeStart
, lineRangeEnd
, mkLineRange
, splitRanges
) where
#if MIN_VERSION_base(4,8,0)
import Data.Semigroup ((<>))
#else
import Control.Applicative
import Data.Monoid
#endif
import Control.Monad (foldM_, when)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.List (sortOn)
import Text.Pandoc.Filter.EmphasizeCode.Position
data Range = Range
{ rangeStart :: Position
, rangeEnd :: Position
} deriving (Eq, Show)
mkRange :: Position -> Position -> Maybe Range
mkRange s e
| s < e = Just (Range s e)
| otherwise = Nothing
rangeToTuple :: Range -> (Position, Position)
rangeToTuple (Range p1 p2) = (p1, p2)
rangeToTuples :: Range -> ((Line, Column), (Line, Column))
rangeToTuples r =
let (p1, p2) = rangeToTuple r
in (positionToTuple p1, positionToTuple p2)
rangesAreDisjoint :: Range -> Range -> Bool
rangesAreDisjoint (Range s1 e1) (Range s2 e2) =
(s1 < s2 && e1 < e2) || (s2 < s1 && e2 < e1)
rangeIntersects :: Range -> Range -> Bool
rangeIntersects r1 r2 = not (rangesAreDisjoint r1 r2)
lineIntersectsWithRange :: Line -> Range -> Bool
lineIntersectsWithRange l (Range start end) = line start <= l && line end >= l
newtype Ranges =
Ranges [Range]
deriving (Eq, Show)
rangesToList :: Ranges -> [Range]
rangesToList (Ranges rs) = rs
data RangesError
= EmptyRanges
| Overlap Range
Range
deriving (Show, Eq)
mkRanges :: [Range] -> Either RangesError Ranges
mkRanges [] = Left EmptyRanges
mkRanges ranges = do
let sorted = sortOn rangeStart ranges
foldM_ checkOverlap Nothing sorted
pure (Ranges sorted)
where
checkOverlap (Just last') this = do
when (last' `rangeIntersects` this) $ Left (Overlap last' this)
return (Just this)
checkOverlap Nothing this = return (Just this)
data LineRange = LineRange
{ lineRangeLine :: Line
, lineRangeStart :: Column
, lineRangeEnd :: Maybe Column
} deriving (Eq, Show)
mkLineRange :: Line -> Column -> Maybe Column -> Maybe LineRange
mkLineRange line' start (Just end)
| line' > 0 && start < end = Just (LineRange line' start (Just end))
mkLineRange line' start Nothing
| line' > 0 = Just (LineRange line' start Nothing)
mkLineRange _ _ _ = Nothing
rangeToLineRanges :: Range -> [LineRange]
rangeToLineRanges r@Range {rangeStart = p1, rangeEnd = p2}
| line p1 == line p2 = [LineRange (line p1) (column p1) (Just (column p2))]
| line p2 > line p1 =
let startLine = LineRange (line p1) (column p1) Nothing
endLine = LineRange (line p2) 1 (Just (column p2))
middleLines =
[LineRange n 1 Nothing | n <- [succ (line p1) .. pred (line p2)]]
in startLine : middleLines ++ [endLine]
| otherwise = error ("'Range' has invalid positions: " ++ show r)
splitRanges :: Ranges -> HashMap Line [LineRange]
splitRanges ranges =
HashMap.fromListWith
(flip (<>))
[ (lineRangeLine lr, [lr])
| lr <- concatMap rangeToLineRanges (rangesToList ranges)
]