github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-24 08:54:07 +03:00
Code Issues Projects Releases Wiki Activity

Define lenses for the starts/ends of Range.

Browse Source
This commit is contained in:
Rob Rix 2019-09-20 16:27:11 -04:00
parent a00a78e522
commit bb204715a1
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7
1 changed files with 16 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
semantic-source/src/Source/Range.hs
View File

@ -1,8 +1,11 @@
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric, RankNTypes #-}
module Source.Range module Source.Range
( Range(..) ( Range(..)
, rangeLength , rangeLength
, subtractRange , subtractRange
-- * Lenses
, start_
, end_
) where ) where
import Control.DeepSeq (NFData) import Control.DeepSeq (NFData)
@ -37,6 +40,18 @@ subtractRange :: Range -> Range -> Range
subtractRange range1 range2 = Range (start range1) (end range1 - rangeLength (Range (start range2) (max (end range1) (end range2)))) subtractRange range1 range2 = Range (start range1) (end range1 - rangeLength (Range (start range2) (max (end range1) (end range2))))
start_, end_ :: Lens' Range Int
start_ = lens start (\r s -> r { start = s })
end_ = lens end (\r e -> r { end = e })
type Lens' s a = forall f . Functor f => (a -> f a) -> (s -> f s)
lens :: (s -> a) -> (s -> a -> s) -> Lens' s a
lens get put afa s = fmap (put s) (afa (get s))
{-# INLINE lens #-}
-- $setup -- $setup
-- >>> import Test.QuickCheck -- >>> import Test.QuickCheck
-- >>> instance Arbitrary Range where arbitrary = Range <$> arbitrary <*> arbitrary ; shrink (Range s e) = Range <$> shrink s <*> shrink e -- >>> instance Arbitrary Range where arbitrary = Range <$> arbitrary <*> arbitrary ; shrink (Range s e) = Range <$> shrink s <*> shrink e