|
| 1 | +{-# LANGUAGE DeriveGeneric, RankNTypes #-} |
| 2 | +module Source.Range |
| 3 | +( Range(..) |
| 4 | +, point |
| 5 | +, rangeLength |
| 6 | +, subtractRange |
| 7 | + -- * Lenses |
| 8 | +, start_ |
| 9 | +, end_ |
| 10 | +) where |
| 11 | + |
| 12 | +import Control.DeepSeq (NFData) |
| 13 | +import Data.Hashable (Hashable) |
| 14 | +import Data.Semilattice.Lower (Lower(..)) |
| 15 | +import GHC.Generics (Generic) |
| 16 | + |
| 17 | +-- | A 0-indexed, half-open interval of integers, defined by start & end indices. |
| 18 | +data Range = Range |
| 19 | + { start :: {-# UNPACK #-} !Int |
| 20 | + , end :: {-# UNPACK #-} !Int |
| 21 | + } |
| 22 | + deriving (Eq, Generic, Ord, Show) |
| 23 | + |
| 24 | +instance Hashable Range |
| 25 | +instance NFData Range |
| 26 | + |
| 27 | +-- $ |
| 28 | +-- prop> a <> (b <> c) === (a <> b) <> (c :: Range) |
| 29 | +instance Semigroup Range where |
| 30 | + Range start1 end1 <> Range start2 end2 = Range (min start1 start2) (max end1 end2) |
| 31 | + |
| 32 | +instance Lower Range where |
| 33 | + lowerBound = Range 0 0 |
| 34 | + |
| 35 | + |
| 36 | +-- | Construct a 'Range' with a given value for both its start and end indices. |
| 37 | +point :: Int -> Range |
| 38 | +point i = Range i i |
| 39 | + |
| 40 | +-- | Return the length of the range. |
| 41 | +rangeLength :: Range -> Int |
| 42 | +rangeLength range = end range - start range |
| 43 | + |
| 44 | +subtractRange :: Range -> Range -> Range |
| 45 | +subtractRange range1 range2 = Range (start range1) (end range1 - rangeLength (Range (start range2) (max (end range1) (end range2)))) |
| 46 | + |
| 47 | + |
| 48 | +start_, end_ :: Lens' Range Int |
| 49 | +start_ = lens start (\r s -> r { start = s }) |
| 50 | +end_ = lens end (\r e -> r { end = e }) |
| 51 | + |
| 52 | + |
| 53 | +type Lens' s a = forall f . Functor f => (a -> f a) -> (s -> f s) |
| 54 | + |
| 55 | +lens :: (s -> a) -> (s -> a -> s) -> Lens' s a |
| 56 | +lens get put afa s = fmap (put s) (afa (get s)) |
| 57 | +{-# INLINE lens #-} |
| 58 | + |
| 59 | + |
| 60 | +-- $setup |
| 61 | +-- >>> import Test.QuickCheck |
| 62 | +-- >>> instance Arbitrary Range where arbitrary = Range <$> arbitrary <*> arbitrary ; shrink (Range s e) = Range <$> shrink s <*> shrink e |
0 commit comments