1
1
mirror of https://github.com/github/semantic.git synced 2024-12-23 06:41:45 +03:00
semantic/src/Range.hs

93 lines
3.6 KiB
Haskell
Raw Normal View History

2015-12-03 05:40:34 +03:00
module Range where
2015-12-14 20:44:48 +03:00
import qualified Data.Char as Char
import Data.List (span)
import Data.Semigroup
import Data.String
import Prologue
2017-01-05 22:42:57 +03:00
import Test.LeanCheck
2016-07-13 22:33:44 +03:00
import Test.QuickCheck
2016-08-22 04:51:48 +03:00
2015-12-14 20:44:48 +03:00
2015-12-21 20:23:21 +03:00
-- | A half-open interval of integers, defined by start & end indices.
data Range = Range { start :: Int, end :: Int }
2016-11-04 01:09:28 +03:00
deriving (Eq, Show, Generic)
2015-12-03 05:40:34 +03:00
-- | Make a range at a given index.
rangeAt :: Int -> Range
rangeAt a = Range a a
2016-01-13 22:38:57 +03:00
-- | Return the length of the range.
rangeLength :: Range -> Int
rangeLength range = end range - start range
2016-01-13 22:38:57 +03:00
-- | Return a range that covers the entire text.
totalRange :: Foldable f => f a -> Range
totalRange t = Range 0 $ length t
2016-01-13 22:38:57 +03:00
-- | Break a string down into words and sequences of punctuation. Return a list
-- | strings with ranges, assuming that the first character in the string is
-- | at the given index.
rangesAndWordsFrom :: Int -> String -> [(Range, String)]
rangesAndWordsFrom _ "" = []
2016-01-13 20:39:52 +03:00
rangesAndWordsFrom startIndex string = fromMaybe [] $ take isWord <|> take isPunctuation <|> skip Char.isSpace
2015-12-14 20:44:48 +03:00
where
2016-01-13 21:54:49 +03:00
save parsed = (Range startIndex $ endFor parsed, parsed)
2016-01-13 21:55:09 +03:00
take = parse (Just . save)
skip = parse (const Nothing)
endFor parsed = startIndex + length parsed
parse transform predicate = case span predicate string of
2015-12-15 00:07:49 +03:00
([], _) -> Nothing
2016-07-13 22:33:53 +03:00
(parsed, rest) -> Just . maybe identity (:) (transform parsed) $ rangesAndWordsFrom (endFor parsed) rest
2015-12-14 23:02:09 +03:00
-- | Is this a word character?
-- | Word characters are defined as in [Rubys `\p{Word}` syntax](http://ruby-doc.org/core-2.1.1/Regexp.html#class-Regexp-label-Character+Properties), i.e.:
-- | > A member of one of the following Unicode general category _Letter_, _Mark_, _Number_, _Connector_Punctuation_
isWord c = Char.isLetter c || Char.isNumber c || Char.isMark c || Char.generalCategory c == Char.ConnectorPunctuation
2016-01-13 20:39:52 +03:00
isPunctuation c = not (Char.isSpace c || isWord c)
2015-12-21 20:22:52 +03:00
-- | Return Just the last index from a non-empty range, or if the range is empty, Nothing.
maybeLastIndex :: Range -> Maybe Int
maybeLastIndex (Range start end) | start == end = Nothing
maybeLastIndex (Range _ end) = Just $ end - 1
2015-12-14 20:44:48 +03:00
2016-04-15 16:34:58 +03:00
-- | Test two ranges for intersection.
2016-04-15 16:34:34 +03:00
intersectsRange :: Range -> Range -> Bool
2016-06-02 03:52:24 +03:00
intersectsRange range1 range2 = start range1 < end range2 && start range2 < end range1
2016-04-15 16:34:34 +03:00
-- Return the (possibly empty, possibly ill-formed) intersection of two ranges.
intersectionRange :: Range -> Range -> Range
intersectionRange range1 range2 = Range (max (start range1) (start range2)) (min (end range1) (end range2))
2016-01-13 22:38:57 +03:00
-- | Return a range that contains both the given ranges.
2016-01-13 17:49:50 +03:00
unionRange :: Range -> Range -> Range
unionRange (Range start1 end1) (Range start2 end2) = Range (min start1 start2) (max end1 end2)
2016-03-03 23:58:48 +03:00
-- | Return a range that contains all the ranges in a Foldable, or Range 0 0 if its empty.
unionRanges :: Foldable f => f Range -> Range
unionRanges = unionRangesFrom (Range 0 0)
-- | Return Just the concatenation of any elements in a Foldable, or Nothing if it is empty.
maybeConcat :: (Foldable f, Semigroup a) => f a -> Maybe a
maybeConcat = getOption . foldMap (Option . Just)
-- | Return a range that contains all the ranges in a Foldable, or the passed Range if the Foldable is empty.
unionRangesFrom :: Foldable f => Range -> f Range -> Range
unionRangesFrom range = fromMaybe range . maybeConcat
2016-07-13 22:31:09 +03:00
-- Instances
instance Semigroup Range where
a <> b = unionRange a b
2015-12-03 05:40:34 +03:00
instance Ord Range where
a <= b = start a <= start b
2016-07-13 22:33:44 +03:00
instance Arbitrary Range where
arbitrary = Range <$> arbitrary <*> arbitrary
shrink s = Range <$> shrink (start s) <*> shrink (end s)
2017-01-05 22:42:57 +03:00
instance Listable Range where
tiers = cons2 Range