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
2016-05-26 19:58:04 +03:00
import Data.List ( span )
2016-04-15 19:20:27 +03:00
import Data.Semigroup
2016-05-26 22:25:45 +03:00
import Data.String
import Prologue
2017-01-05 22:42:57 +03:00
import Test.LeanCheck
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.
2016-10-13 00:28:27 +03:00
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
2016-02-29 18:00:02 +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.
2016-01-12 19:52:38 +03:00
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.
2016-03-09 09:43:22 +03:00
totalRange :: Foldable f => f a -> Range
totalRange t = Range 0 $ length t
2015-12-04 17:20:23 +03:00
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.
2015-12-14 23:37:30 +03:00
rangesAndWordsFrom :: Int -> String -> [ ( Range , String ) ]
2015-12-15 00:20:42 +03:00
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 )
2015-12-15 01:18:24 +03:00
endFor parsed = startIndex + length parsed
2016-01-13 22:06:59 +03:00
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 [Ruby’ s `\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_
2015-12-14 23:01:38 +03:00
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-14 23:01:38 +03:00
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.
2015-12-21 20:22:20 +03:00
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
2016-05-17 22:20:51 +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 it’ s empty.
2016-03-05 04:10:45 +03:00
unionRanges :: Foldable f => f Range -> Range
2016-03-04 00:00:07 +03:00
unionRanges = unionRangesFrom ( Range 0 0 )
2016-01-13 17:43:44 +03:00
2016-04-15 19:20:27 +03:00
-- | 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 )
2016-03-03 23:59:40 +03:00
-- | Return a range that contains all the ranges in a Foldable, or the passed Range if the Foldable is empty.
2016-03-05 04:07:52 +03:00
unionRangesFrom :: Foldable f => Range -> f Range -> Range
unionRangesFrom range = fromMaybe range . maybeConcat
2016-03-03 23:59:40 +03:00
2016-07-13 22:31:09 +03:00
-- Instances
2016-04-15 19:20:27 +03:00
instance Semigroup Range where
a <> b = unionRange a b
2015-12-30 18:05:31 +03:00
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
2017-01-05 22:42:57 +03:00
instance Listable Range where
tiers = cons2 Range