loc 0.1.4.1 → 0.2.0.0
raw patch · 16 files changed
+997/−1406 lines, 16 filesdep +integer-typesdep ~basePVP ok
version bump matches the API change (PVP)
Dependencies added: integer-types
Dependency ranges changed: base
API changes (from Hackage documentation)
- Data.Loc: class ToNat a
- Data.Loc: data Pos
- Data.Loc: toNat :: ToNat a => a -> Natural
- Data.Loc.Area: instance Data.Data.Data Data.Loc.Area.Area
- Data.Loc.Area: instance Data.Data.Data Data.Loc.Area.Terminus
- Data.Loc.Loc: instance Data.Data.Data Data.Loc.Loc.Loc
- Data.Loc.Pos: class ToNat a
- Data.Loc.Pos: data Pos
- Data.Loc.Pos: instance Data.Data.Data Data.Loc.Pos.Column
- Data.Loc.Pos: instance Data.Data.Data Data.Loc.Pos.Line
- Data.Loc.Pos: instance Data.Data.Data Data.Loc.Pos.Pos
- Data.Loc.Pos: instance Data.Loc.Pos.ToNat Data.Loc.Pos.Column
- Data.Loc.Pos: instance Data.Loc.Pos.ToNat Data.Loc.Pos.Line
- Data.Loc.Pos: instance Data.Loc.Pos.ToNat Data.Loc.Pos.Pos
- Data.Loc.Pos: instance GHC.Classes.Eq Data.Loc.Pos.Pos
- Data.Loc.Pos: instance GHC.Classes.Ord Data.Loc.Pos.Pos
- Data.Loc.Pos: instance GHC.Enum.Enum Data.Loc.Pos.Pos
- Data.Loc.Pos: instance GHC.Num.Num Data.Loc.Pos.Pos
- Data.Loc.Pos: instance GHC.Read.Read Data.Loc.Pos.Column
- Data.Loc.Pos: instance GHC.Read.Read Data.Loc.Pos.Line
- Data.Loc.Pos: instance GHC.Read.Read Data.Loc.Pos.Pos
- Data.Loc.Pos: instance GHC.Real.Real Data.Loc.Pos.Pos
- Data.Loc.Pos: instance GHC.Show.Show Data.Loc.Pos.Pos
- Data.Loc.Pos: posReadPrec :: ReadPrec Pos
- Data.Loc.Pos: posShowsPrec :: Int -> Pos -> ShowS
- Data.Loc.Pos: toNat :: ToNat a => a -> Natural
- Data.Loc.Span: instance Data.Data.Data Data.Loc.Span.Span
- Data.Loc.SpanOrLoc: instance Data.Data.Data Data.Loc.SpanOrLoc.SpanOrLoc
- Data.Loc.Types: data Pos
+ Data.Loc: data Positive
+ Data.Loc.Pos: instance GHC.Real.Integral Data.Loc.Pos.Column
+ Data.Loc.Pos: instance GHC.Real.Integral Data.Loc.Pos.Line
Files
- changelog.md +11/−0
- loc.cabal +6/−9
- src/Data/Loc.hs +152/−152
- src/Data/Loc/Area.hs +223/−291
- src/Data/Loc/Exception.hs +2/−3
- src/Data/Loc/Internal/Map.hs +24/−47
- src/Data/Loc/Internal/Prelude.hs +26/−11
- src/Data/Loc/List/OneToTwo.hs +29/−33
- src/Data/Loc/List/ZeroToTwo.hs +15/−15
- src/Data/Loc/Loc.hs +42/−56
- src/Data/Loc/Pos.hs +8/−184
- src/Data/Loc/Span.hs +191/−230
- src/Data/Loc/SpanOrLoc.hs +25/−33
- src/Data/Loc/Types.hs +3/−9
- test/Gen.hs +84/−147
- test/Main.hs +156/−186
changelog.md view
@@ -1,3 +1,14 @@+### 0.2.0.0 (2023-06-26)++Remove `Pos` type; using `Positive` from the `integer-types` package instead++Remove `ToNat` class++Removed all `Data` instances. (Because I don't care; if you need this, ask+for it to be restored.)++`Line` and `Column` now have `Integral` instances+ ### 0.1.4.1 (2023-01-10) Support GHC 9.4
loc.cabal view
@@ -1,7 +1,7 @@ cabal-version: 3.0 name: loc-version: 0.1.4.1+version: 0.2.0.0 synopsis: Line and column positions and ranges in text files category: Data Structures, Text @@ -31,20 +31,17 @@ location: git://github.com/typeclasses/loc.git common base- default-language: Haskell2010+ default-language: GHC2021 default-extensions: BlockArguments- DeriveDataTypeable- DeriveFoldable- DeriveFunctor- GeneralizedNewtypeDeriving+ DerivingStrategies LambdaCase NoImplicitPrelude- ScopedTypeVariables ghc-options: -Wall build-depends:- , base ^>= 4.14 || ^>= 4.15 || ^>= 4.16 || ^>= 4.17+ , base ^>= 4.16 || ^>= 4.17 || ^>= 4.18 , containers ^>= 0.6.4+ , integer-types ^>= 0.1.2 library import: base@@ -72,7 +69,7 @@ main-is: Main.hs other-modules: Gen build-depends:- , hspec ^>= 2.8.5 || ^>= 2.9 || ^>= 2.10+ , hspec ^>= 2.8.5 || ^>= 2.9 || ^>= 2.10 || ^>= 2.11 , hspec-hedgehog ^>= 0.0.1 , hedgehog ^>= 1.0.5 || ^>= 1.1 || ^>= 1.2 , loc
src/Data/Loc.hs view
@@ -1,74 +1,96 @@ module Data.Loc- (- -- * Concepts+ ( -- * Concepts -- $concepts -- * Imports -- $imports -- * Core types- Line, Column, Loc, Span, SpanOrLoc, Area,+ Line,+ Column,+ Loc,+ Span,+ SpanOrLoc,+ Area, -- * Constructing+ -- ** Loc- loc, origin,+ loc,+ origin,+ -- ** Span- spanFromTo, spanFromToMay,+ spanFromTo,+ spanFromToMay,+ -- ** SpanOrLoc spanOrLocFromTo,+ -- ** Area- areaFromTo, spanArea,+ areaFromTo,+ spanArea, -- * Deconstructing+ -- ** Loc- locLine, locColumn,+ locLine,+ locColumn,+ -- ** Span- spanStart, spanEnd,+ spanStart,+ spanEnd,+ -- ** SpanOrLoc- spanOrLocStart, spanOrLocEnd,+ spanOrLocStart,+ spanOrLocEnd,+ -- ** Area- areaStart, areaEnd, areaSpansAsc,+ areaStart,+ areaEnd,+ areaSpansAsc, -- * Combining+ -- ** Span- spanUnion, spanDifference,+ spanUnion,+ spanDifference,+ -- ** Area- areaUnion, areaDifference,+ areaUnion,+ areaDifference, -- * Miscellaneous- Pos, OneToTwo, ZeroToTwo, ToNat (..), LocException (..),+ Positive,+ OneToTwo,+ ZeroToTwo,+ LocException (..), )- where--import Data.Loc.Internal.Prelude+where import Data.Loc.Area (Area)+import Data.Loc.Area qualified as Area import Data.Loc.Exception (LocException (..))+import Data.Loc.Internal.Prelude import Data.Loc.List.OneToTwo (OneToTwo) import Data.Loc.List.ZeroToTwo (ZeroToTwo) import Data.Loc.Loc (Loc)-import Data.Loc.Pos (Column, Line, Pos, ToNat (..))+import Data.Loc.Loc qualified as Loc+import Data.Loc.Pos (Column, Line) import Data.Loc.Span (Span)+import Data.Loc.Span qualified as Span import Data.Loc.SpanOrLoc (SpanOrLoc)--import qualified Data.Loc.Area as Area-import qualified Data.Loc.Loc as Loc-import qualified Data.Loc.Span as Span-import qualified Data.Loc.SpanOrLoc as SpanOrLoc--{- |-The smallest location: @'loc' 1 1@.+import Data.Loc.SpanOrLoc qualified as SpanOrLoc+import Integer.Positive (Positive) -/This is an alias for 'Loc.origin'./--}+-- | The smallest location: @'loc' 1 1@+--+-- /This is an alias for 'Loc.origin'./ origin :: Loc origin = Loc.origin -{- |-Create a 'Loc' from a line number and column number.--/This is an alias for 'Loc.loc'./--}+-- | Create a 'Loc' from a line number and column number+--+-- /This is an alias for 'Loc.loc'./ loc :: Line -> Column -> Loc loc = Loc.loc @@ -80,38 +102,34 @@ locColumn :: Loc -> Column locColumn = Loc.column -{- |-Attempt to construct a 'Span' from two 'Loc's. The lesser loc will be the-start, and the greater loc will be the end. The two locs must not be equal,-or else this throws 'EmptySpan'.--/The safe version of this function is 'spanFromToMay'./--/This is an alias for 'Span.fromTo'./--}+-- | Attempt to construct a 'Span' from two 'Loc's+--+-- The lesser loc will be the start, and the greater loc will be the end.+-- The two locs must not be equal, or else this throws 'EmptySpan'.+--+-- /The safe version of this function is 'spanFromToMay'./+--+-- /This is an alias for 'Span.fromTo'./ spanFromTo :: Loc -> Loc -> Span spanFromTo = Span.fromTo -{- |-Attempt to construct a 'Span' from two 'Loc's. The lesser loc will be the-start, and the greater loc will be the end. If the two locs are equal,-the result is 'Nothing', because a span cannot be empty.--/This is the safe version of 'spanFromTo', which throws an exception instead./--/This is an alias for 'Span.fromToMay'./--}+-- | Attempt to construct a 'Span' from two 'Loc's+--+-- The lesser loc will be the start, and the greater loc will be the end.+-- If the two locs are equal, the result is 'Nothing', because a span cannot be empty.+--+-- /This is the safe version of 'spanFromTo', which throws an exception instead./+--+-- /This is an alias for 'Span.fromToMay'./ spanFromToMay :: Loc -> Loc -> Maybe Span spanFromToMay = Span.fromToMay -{- |--Construct a 'SpanOrLoc' from two 'Loc's. If the two locs are not equal,-the lesser loc will be the start, and the greater loc will be the end.--/This is an alias for 'SpanOrLoc.fromTo'./---}+-- | Construct a 'SpanOrLoc' from two 'Loc's+--+-- If the two locs are not equal, the lesser loc will be the start,+-- and the greater loc will be the end.+--+-- /This is an alias for 'SpanOrLoc.fromTo'./ spanOrLocFromTo :: Loc -> Loc -> SpanOrLoc spanOrLocFromTo = SpanOrLoc.fromTo @@ -123,131 +141,113 @@ spanOrLocEnd :: SpanOrLoc -> Loc spanOrLocEnd = SpanOrLoc.end -{- |-Construct a contiguous 'Area' consisting of a single 'Span' specified by two-'Loc's. The lesser loc will be the start, and the greater loc will be the end.-If the two locs are equal, the area will be empty.--/This is an alias for 'Area.fromTo'./--}+-- | Construct a contiguous 'Area' consisting of a single 'Span' specified by two 'Loc's+--+-- The lesser loc will be the start, and the greater loc will be the end.+-- If the two locs are equal, the area will be empty.+--+-- /This is an alias for 'Area.fromTo'./ areaFromTo :: Loc -> Loc -> Area areaFromTo = Area.fromTo -{- |-The union of two 'Area's. Spans that overlap or abut will be merged in the-result.--/This is an alias for 'Area.+'./--}+-- | The union of two 'Area's+--+-- Spans that overlap or abut will be merged in the result.+--+-- /This is an alias for 'Area.+'./ areaUnion :: Area -> Area -> Area areaUnion = (Area.+) -{- |-The difference between two 'Area's. @a `'areaDifference'` b@ contains what is-covered by @a@ and not covered by @b@.--/This is an alias for 'Area.-'./--}+-- | The difference between two 'Area's+--+-- @a `'areaDifference'` b@ contains what is covered by @a@ and not covered by @b@.+--+-- /This is an alias for 'Area.-'./ areaDifference :: Area -> Area -> Area areaDifference = (Area.-) -{- |-A list of the 'Span's that constitute an 'Area', sorted in ascending order.--/This is an alias for 'Area.spansAsc'./--}+-- | A list of the 'Span's that constitute an 'Area', sorted in ascending order+--+-- /This is an alias for 'Area.spansAsc'./ areaSpansAsc :: Area -> [Span] areaSpansAsc = Area.spansAsc -{- |-Construct an 'Area' consisting of a single 'Span'.--/This is an alias for 'Area.spanArea'./--}+-- | Construct an 'Area' consisting of a single 'Span'+--+-- /This is an alias for 'Area.spanArea'./ spanArea :: Span -> Area spanArea = Area.spanArea -{- |-Combine two 'Span's, merging them if they abut or overlap.--/This is an alias for 'Span.+'./--}+-- | Combine two 'Span's, merging them if they abut or overlap+--+-- /This is an alias for 'Span.+'./ spanUnion :: Span -> Span -> OneToTwo Span spanUnion = (Span.+) -{- |-The difference between two 'Spans's. @a '-' b@ contains what is covered by-@a@ and not covered by @b@.--/This is an alias for 'Span.-'./--}+-- | The difference between two 'Spans's+--+-- @a '-' b@ contains what is covered by @a@ and not covered by @b@.+--+-- /This is an alias for 'Span.-'./ spanDifference :: Span -> Span -> ZeroToTwo Span spanDifference = (Span.-) -{- |-/This is an alias for 'Span.start'./--}+-- |+-- /This is an alias for 'Span.start'./ spanStart :: Span -> Loc spanStart = Span.start -{- |-/This is an alias for 'Span.end'./--}+-- |+-- /This is an alias for 'Span.end'./ spanEnd :: Span -> Loc spanEnd = Span.end -{- |-/This is an alias for 'Area.start'./--}+-- |+-- /This is an alias for 'Area.start'./ areaStart :: Area -> Maybe Loc areaStart = Area.start -{- |-/This is an alias for 'Area.end'./--}+-- |+-- /This is an alias for 'Area.end'./ areaEnd :: Area -> Maybe Loc areaEnd = Area.end -{- $concepts--'Line' and 'Column' are positive integers representing line and column numbers.--The product of 'Line' and 'Column' is a 'Loc', which represents a position-between characters in multiline text. The smallest loc is 'origin': line 1,-column 1.--Here's a small piece of text for illustration:--> 1 2-> 12345678901234567890123456789-> ┌───────────────────────────────┐-> 1 │ I have my reasons, you │-> 2 │ have yours. What's obvious │-> 3 │ to me isn't to everyone else, │-> 4 │ and vice versa. │-> └───────────────────────────────┘--In this example, the word “obvious” starts at line 2, column 20, and it ends at-line 2, column 27. The 'Show' instance uses a shorthand notation denoting-these locs as @2:20@ and @2:27@.--A 'Span' is a nonempty contiguous region of text between two locs; think of it-like a highlighted area in a simple text editor. In the above example, a span-that covers the word “obvious” starts at @2:20@ and ends at @2:27@. The 'Show'-instance describes this tersely as @2:20-2:27@.--Multiple non-overlapping regions form an 'Area'. You may also think of an-area like a span that can be empty or have “gaps”. In the example above, the-first three words “I have my”, and not the spaces between them, are covered by-the area @[1:1-1:2,1:3-1:7,1:8-1:10]@.---}--{- $imports--Recommended import:--> import Data.Loc.Types-> import qualified Data.Loc as Loc+-- $concepts+--+-- 'Line' and 'Column' are positive integers representing line and column numbers.+--+-- The product of 'Line' and 'Column' is a 'Loc', which represents a position+-- between characters in multiline text. The smallest loc is 'origin': line 1,+-- column 1.+--+-- Here's a small piece of text for illustration:+--+-- > 1 2+-- > 12345678901234567890123456789+-- > ┌───────────────────────────────┐+-- > 1 │ I have my reasons, you │+-- > 2 │ have yours. What's obvious │+-- > 3 │ to me isn't to everyone else, │+-- > 4 │ and vice versa. │+-- > └───────────────────────────────┘+--+-- In this example, the word “obvious” starts at line 2, column 20, and it ends at+-- line 2, column 27. The 'Show' instance uses a shorthand notation denoting+-- these locs as @2:20@ and @2:27@.+--+-- A 'Span' is a nonempty contiguous region of text between two locs; think of it+-- like a highlighted area in a simple text editor. In the above example, a span+-- that covers the word “obvious” starts at @2:20@ and ends at @2:27@. The 'Show'+-- instance describes this tersely as @2:20-2:27@.+--+-- Multiple non-overlapping regions form an 'Area'. You may also think of an+-- area like a span that can be empty or have “gaps”. In the example above, the+-- first three words “I have my”, and not the spaces between them, are covered by+-- the area @[1:1-1:2,1:3-1:7,1:8-1:10]@. --}+-- $imports+--+-- Recommended import:+--+-- > import Data.Loc.Types+-- > import qualified Data.Loc as Loc
src/Data/Loc/Area.hs view
@@ -1,383 +1,315 @@ module Data.Loc.Area- (- Area,+ ( Area, -- * Constructing- fromTo, spanArea,+ fromTo,+ spanArea, -- * Combining- (+), (-), addSpan,+ (+),+ (-),+ addSpan, -- * Querying- firstSpan, lastSpan,- start, end,- areaSpan, spansAsc, spanCount,+ firstSpan,+ lastSpan,+ start,+ end,+ areaSpan,+ spansAsc,+ spanCount, -- * Show and Read- areaShowsPrec, areaReadPrec,+ areaShowsPrec,+ areaReadPrec, )- where+where +import Data.Foldable qualified as Foldable+import Data.Loc.Internal.Map qualified as Map import Data.Loc.Internal.Prelude- import Data.Loc.Loc (Loc) import Data.Loc.Span (Span)--import qualified Data.Loc.Internal.Map as Map-import qualified Data.Loc.Span as Span--import Data.Data (Data)-import qualified Data.Foldable as Foldable-import qualified Data.Set as Set+import Data.Loc.Span qualified as Span+import Data.Set qualified as Set data Terminus = Start | End- deriving (Data, Eq, Ord)--{- |--A set of non-overlapping, non-abutting 'Span's. You may also think of an 'Area'-like a span that can be empty or have “gaps”.--Construct and combine areas using 'mempty', 'spanArea', 'fromTo', '+', and '-'.+ deriving (Eq, Ord) --}+-- | A set of non-overlapping, non-abutting 'Span's+--+-- You may also think of an 'Area' like a span that can be empty or have “gaps.”+--+-- Construct and combine areas using 'mempty', 'spanArea', 'fromTo', '+', and '-'. newtype Area = Area (Map Loc Terminus)- deriving (Data, Eq, Ord)+ deriving (Eq, Ord) -- | 'showsPrec' = 'areaShowsPrec'-instance Show Area- where-- showsPrec = areaShowsPrec+instance Show Area where+ showsPrec = areaShowsPrec -- | 'readPrec' = 'areaReadPrec'-instance Read Area- where-- readPrec = areaReadPrec--instance Monoid Area- where+instance Read Area where+ readPrec = areaReadPrec - mempty = Area Map.empty+instance Monoid Area where+ mempty = Area Map.empty -- | '<>' = '+'-instance Semigroup Area- where- (<>) = (+)+instance Semigroup Area where+ (<>) = (+) areaShowsPrec :: Int -> Area -> ShowS areaShowsPrec _ a = showList (spansAsc a) -{- |-->>> readPrec_to_S areaReadPrec minPrec "[]"-[([],"")]-->>> readPrec_to_S areaReadPrec minPrec "[3:2-5:5,8:3-11:4]"-[([3:2-5:5,8:3-11:4],"")]-->>> readPrec_to_S areaReadPrec minPrec "[3:2-5:5,11:4-8:3]"-[([3:2-5:5,8:3-11:4],"")]-->>> readPrec_to_S areaReadPrec minPrec "[3:2-5:5,8:3-8:3]"-[]---}+-- |+--+-- >>> readPrec_to_S areaReadPrec minPrec "[]"+-- [([],"")]+--+-- >>> readPrec_to_S areaReadPrec minPrec "[3:2-5:5,8:3-11:4]"+-- [([3:2-5:5,8:3-11:4],"")]+--+-- >>> readPrec_to_S areaReadPrec minPrec "[3:2-5:5,11:4-8:3]"+-- [([3:2-5:5,8:3-11:4],"")]+--+-- >>> readPrec_to_S areaReadPrec minPrec "[3:2-5:5,8:3-8:3]"+-- [] areaReadPrec :: ReadPrec Area areaReadPrec = foldMap spanArea <$> readListPrec -{- |--Construct a contiguous 'Area' consisting of a single 'Span' specified by two-'Loc's. The lesser loc will be the start, and the greater loc will be the end.-If the two locs are equal, the area will be empty.---}-fromTo- :: Loc -- ^ Start- -> Loc -- ^ End- -> Area+-- | Construct a contiguous 'Area' consisting of a single 'Span' specified+-- by two 'Loc's+--+-- The lesser loc will be the start, and the greater loc will be the end.+-- If the two locs are equal, the area will be empty.+fromTo ::+ -- | Start+ Loc ->+ -- | End+ Loc ->+ Area fromTo a b- | a == b = mempty+ | a == b = mempty | otherwise = spanArea (Span.fromTo a b) -{- |--Construct an 'Area' consisting of a single 'Span'.-->>> spanArea (read "4:5-6:3")-[4:5-6:3]---}+-- | Construct an 'Area' consisting of a single 'Span'+--+-- >>> spanArea (read "4:5-6:3")+-- [4:5-6:3] spanArea :: Span -> Area spanArea s = Area (Map.fromList locs) where- locs = [ (Span.start s, Start)- , (Span.end s, End )- ]--{- |--A 'Span' from 'start' to 'end', or 'Nothing' if the 'Area' is empty.-->>> areaSpan mempty-Nothing-->>> areaSpan (read "[3:4-7:2]")-Just 3:4-7:2-->>> areaSpan (read "[3:4-7:2,15:6-17:9]")-Just 3:4-17:9+ locs =+ [ (Span.start s, Start),+ (Span.end s, End)+ ] --}+-- | A 'Span' from 'start' to 'end', or 'Nothing' if the 'Area' is empty+--+-- >>> areaSpan mempty+-- Nothing+--+-- >>> areaSpan (read "[3:4-7:2]")+-- Just 3:4-7:2+--+-- >>> areaSpan (read "[3:4-7:2,15:6-17:9]")+-- Just 3:4-17:9 areaSpan :: Area -> Maybe Span areaSpan x = start x >>= \a ->- end x <&> \b ->- Span.fromTo a b--{- |--A list of the 'Span's that constitute an 'Area', sorted in ascending order.-->>> spansAsc mempty-[]-->>> spansAsc (read "[3:4-7:2,15:6-17:9]")-[3:4-7:2,15:6-17:9]+ end x <&> \b ->+ Span.fromTo a b --}+-- | A list of the 'Span's that constitute an 'Area', sorted in ascending order+--+-- >>> spansAsc mempty+-- []+--+-- >>> spansAsc (read "[3:4-7:2,15:6-17:9]")+-- [3:4-7:2,15:6-17:9] spansAsc :: Area -> [Span] spansAsc (Area m) =- mapAccumL f Nothing (Map.keys m) & snd & catMaybes+ mapAccumL f Nothing (Map.keys m) & snd & catMaybes where- f Nothing l = (Just l, Nothing)+ f Nothing l = (Just l, Nothing) f (Just l) l' = (Nothing, Just $ Span.fromTo l l') -{- |-->>> spanCount mempty-0-->>> spanCount (read "[3:4-7:2]")-1-->>> spanCount (read "[3:4-7:2,15:6-17:9]")-2---}+-- |+--+-- >>> spanCount mempty+-- 0+--+-- >>> spanCount (read "[3:4-7:2]")+-- 1+--+-- >>> spanCount (read "[3:4-7:2,15:6-17:9]")+-- 2 spanCount :: Area -> Natural spanCount (Area locs) = fromIntegral (Foldable.length locs `div` 2) -{- |--The first contiguous 'Span' in the 'Area', or 'Nothing' if the area is empty.-->>> firstSpan mempty-Nothing-->>> firstSpan (read "[3:4-7:2]")-Just 3:4-7:2-->>> firstSpan (read "[3:4-7:2,15:6-17:9]")-Just 3:4-7:2---}+-- | The first contiguous 'Span' in the 'Area', or 'Nothing' if the area is empty+--+-- >>> firstSpan mempty+-- Nothing+--+-- >>> firstSpan (read "[3:4-7:2]")+-- Just 3:4-7:2+--+-- >>> firstSpan (read "[3:4-7:2,15:6-17:9]")+-- Just 3:4-7:2 firstSpan :: Area -> Maybe Span firstSpan (Area m) = case Set.toAscList (Map.keysSet m) of- a:b:_ -> Just (Span.fromTo a b)- _ -> Nothing--{- |--The last contiguous 'Span' in the 'Area', or 'Nothing' if the area is empty.-->>> lastSpan mempty-Nothing-->>> lastSpan (read "[3:4-7:2]")-Just 3:4-7:2-->>> lastSpan (read "[3:4-7:2,15:6-17:9]")-Just 15:6-17:9+ a : b : _ -> Just (Span.fromTo a b)+ _ -> Nothing --}+-- | The last contiguous 'Span' in the 'Area', or 'Nothing' if the area is empty+--+-- >>> lastSpan mempty+-- Nothing+--+-- >>> lastSpan (read "[3:4-7:2]")+-- Just 3:4-7:2+--+-- >>> lastSpan (read "[3:4-7:2,15:6-17:9]")+-- Just 15:6-17:9 lastSpan :: Area -> Maybe Span lastSpan (Area m) = case Set.toDescList (Map.keysSet m) of- b:a:_ -> Just (Span.fromTo a b)- _ -> Nothing--{- |--The 'Loc' at which the 'Area' starts, or 'Nothing' if the 'Area' is empty.-->>> start mempty-Nothing-->>> start (read "[3:4-7:2]")-Just 3:4-->>> start (read "[3:4-7:2,15:6-17:9]")-Just 3:4+ b : a : _ -> Just (Span.fromTo a b)+ _ -> Nothing --}+-- | The 'Loc' at which the 'Area' starts, or 'Nothing' if the 'Area' is empty+--+-- >>> start mempty+-- Nothing+--+-- >>> start (read "[3:4-7:2]")+-- Just 3:4+--+-- >>> start (read "[3:4-7:2,15:6-17:9]")+-- Just 3:4 start :: Area -> Maybe Loc start (Area m) = case Map.minViewWithKey m of Just ((l, _), _) -> Just l- Nothing -> Nothing--{- |--The 'Loc' at which the 'Area' ends, or 'Nothing' if the 'Area' is empty.-->>> end mempty-Nothing-->>> end (read "[3:4-7:2]")-Just 7:2-->>> end (read "[3:4-7:2,15:6-17:9]")-Just 17:9+ Nothing -> Nothing --}+-- | The 'Loc' at which the 'Area' ends, or 'Nothing' if the 'Area' is empty+--+-- >>> end mempty+-- Nothing+--+-- >>> end (read "[3:4-7:2]")+-- Just 7:2+--+-- >>> end (read "[3:4-7:2,15:6-17:9]")+-- Just 17:9 end :: Area -> Maybe Loc end (Area locs) = case Map.maxViewWithKey locs of Just ((l, _), _) -> Just l- Nothing -> Nothing--{- |--The union of two 'Area's. Spans that overlap or abut will be merged in the-result.-->>> read "[1:1-1:2]" + mempty-[1:1-1:2]-->>> read "[1:1-1:2]" + read "[1:2-1:3]"-[1:1-1:3]-->>> read "[1:1-1:2]" + read "[1:1-3:1]"-[1:1-3:1]-->>> read "[1:1-1:2]" + read "[1:1-11:1]"-[1:1-11:1]-->>> read "[1:1-3:1,6:1-6:2]" + read "[1:1-6:1]"-[1:1-6:2]-->>> read "[1:1-3:1]" + read "[5:1-6:2]"-[1:1-3:1,5:1-6:2]+ Nothing -> Nothing --}+-- | The union of two 'Area's+--+-- Spans that overlap or abut will be merged in the result.+--+-- >>> read "[1:1-1:2]" + mempty+-- [1:1-1:2]+--+-- >>> read "[1:1-1:2]" + read "[1:2-1:3]"+-- [1:1-1:3]+--+-- >>> read "[1:1-1:2]" + read "[1:1-3:1]"+-- [1:1-3:1]+--+-- >>> read "[1:1-1:2]" + read "[1:1-11:1]"+-- [1:1-11:1]+--+-- >>> read "[1:1-3:1,6:1-6:2]" + read "[1:1-6:1]"+-- [1:1-6:2]+--+-- >>> read "[1:1-3:1]" + read "[5:1-6:2]"+-- [1:1-3:1,5:1-6:2] (+) :: Area -> Area -> Area a + b | spanCount a >= spanCount b = foldr addSpan a (spansAsc b)- | otherwise = b + a--{- |--@'addSpan' s a@ is the union of @'Area' a@ and @'Span' s@.-->>> addSpan (read "1:1-6:1") (read "[1:1-3:1,6:1-6:2]")-[1:1-6:2]+ | otherwise = b + a --}+-- | @'addSpan' s a@ is the union of @'Area' a@ and @'Span' s@+--+-- >>> addSpan (read "1:1-6:1") (read "[1:1-3:1,6:1-6:2]")+-- [1:1-6:2] addSpan :: Span -> Area -> Area addSpan b (Area as) =-- let- -- Spans lower than b that do not abut or overlap b.- -- These spans will remain completely intact in the result.- unmodifiedSpansBelow :: Map Loc Terminus-- -- Spans greater than b that do not abut or overlap b.- -- These spans will remain completely intact in the result.- unmodifiedSpansAbove :: Map Loc Terminus-- -- The start location of a span that starts below b but doesn't end below b,- -- if such a span exists. This span will be merged into the 'middle'.- startBelow :: Maybe Loc-- -- The end location of a span that ends above b but doesn't start above b,- -- if such a span exists. This span will be merged into the 'middle'.- endAbove :: Maybe Loc-- -- b, plus any spans it abuts or overlaps.- middle :: Map Loc Terminus+ let -- Spans lower than b that do not abut or overlap b.+ -- These spans will remain completely intact in the result.+ unmodifiedSpansBelow :: Map Loc Terminus - (unmodifiedSpansBelow, startBelow) =- let- below = Map.below (Span.start b) as- in- case Map.maxViewWithKey below of- Just ((l, Start), xs) -> (xs, Just l)- _ -> (below, Nothing)+ -- Spans greater than b that do not abut or overlap b.+ -- These spans will remain completely intact in the result.+ unmodifiedSpansAbove :: Map Loc Terminus + -- The start location of a span that starts below b but doesn't end below b,+ -- if such a span exists. This span will be merged into the 'middle'.+ startBelow :: Maybe Loc - (unmodifiedSpansAbove, endAbove) =- let- above = Map.above (Span.end b) as- in- case Map.minViewWithKey above of- Just ((l, End), xs) -> (xs, Just l)- _ -> (above, Nothing)+ -- The end location of a span that ends above b but doesn't start above b,+ -- if such a span exists. This span will be merged into the 'middle'.+ endAbove :: Maybe Loc - middle = Map.fromList- [ (minimum $ Foldable.toList startBelow <> [Span.start b], Start)- , (maximum $ Foldable.toList endAbove <> [Span.end b], End)- ]+ -- b, plus any spans it abuts or overlaps.+ middle :: Map Loc Terminus - in- Area $ unmodifiedSpansBelow <> middle <> unmodifiedSpansAbove+ (unmodifiedSpansBelow, startBelow) =+ let below = Map.below (Span.start b) as+ in case Map.maxViewWithKey below of+ Just ((l, Start), xs) -> (xs, Just l)+ _ -> (below, Nothing) -{- |+ (unmodifiedSpansAbove, endAbove) =+ let above = Map.above (Span.end b) as+ in case Map.minViewWithKey above of+ Just ((l, End), xs) -> (xs, Just l)+ _ -> (above, Nothing) -The difference between two 'Area's. @a '-' b@ contains what is covered by @a@-and not covered by @b@.+ middle =+ Map.fromList+ [ (minimum $ Foldable.toList startBelow <> [Span.start b], Start),+ (maximum $ Foldable.toList endAbove <> [Span.end b], End)+ ]+ in Area $ unmodifiedSpansBelow <> middle <> unmodifiedSpansAbove --}+-- | The difference between two 'Area's+--+-- @a '-' b@ contains what is covered by @a@ and not covered by @b@. (-) :: Area -> Area -> Area a - b = foldr subtractSpan a (spansAsc b) -{- |--@'subtractSpan' s a@ is the subset of 'Area' @a@ that is not covered by 'Span'-@s@.---}+-- | @'subtractSpan' s a@ is the subset of 'Area' @a@ that is not+-- covered by 'Span' @s@ subtractSpan :: Span -> Area -> Area subtractSpan b (Area as) =-- let- resultBelow :: Map Loc Terminus =- let- below = Map.belowInclusive (Span.start b) as- in- case Map.maxViewWithKey below of- Just ((l, Start), xs) ->- if l == Span.start b- then xs- else below & Map.insert (Span.start b) End- _ -> below-- resultAbove :: Map Loc Terminus =- let- above = Map.aboveInclusive (Span.end b) as- in- case Map.minViewWithKey above of- Just ((l, End), xs) ->- if l == Span.end b- then xs- else above & Map.insert (Span.end b) Start- _ -> above+ let resultBelow :: Map Loc Terminus =+ let below = Map.belowInclusive (Span.start b) as+ in case Map.maxViewWithKey below of+ Just ((l, Start), xs) ->+ if l == Span.start b+ then xs+ else below & Map.insert (Span.start b) End+ _ -> below - in- Area $ resultBelow <> resultAbove+ resultAbove :: Map Loc Terminus =+ let above = Map.aboveInclusive (Span.end b) as+ in case Map.minViewWithKey above of+ Just ((l, End), xs) ->+ if l == Span.end b+ then xs+ else above & Map.insert (Span.end b) Start+ _ -> above+ in Area $ resultBelow <> resultAbove
src/Data/Loc/Exception.hs view
@@ -1,8 +1,7 @@ module Data.Loc.Exception- (- LocException (..),+ ( LocException (..), )- where+where import Data.Loc.Internal.Prelude
src/Data/Loc/Internal/Map.hs view
@@ -1,64 +1,41 @@ module Data.Loc.Internal.Map- (- module Data.Map,- below, above, belowInclusive, aboveInclusive,+ ( module Data.Map,+ below,+ above,+ belowInclusive,+ aboveInclusive, )- where+where import Data.Loc.Internal.Prelude- import Data.Map -{- |--@'below' k m@ is the subset of 'Map' @m@ whose keys are less than @k@.---}+-- | @'below' k m@ is the subset of 'Map' @m@ whose keys are less than @k@ below :: Ord k => k -> Map k a -> Map k a below k m =- let- (x, _) = split k m- in- x--{- |--@'below' k m@ is the subset of 'Map' @m@ whose keys are greater than @k@.+ let (x, _) = split k m+ in x --}+-- | @'below' k m@ is the subset of 'Map' @m@ whose keys are greater than @k@ above :: Ord k => k -> Map k a -> Map k a above k m =- let- (_, x) = split k m- in- x--{- |--@'belowInclusive' k m@ is the subset of 'Map' @m@ whose keys are less than or-equal to @k@.+ let (_, x) = split k m+ in x --}+-- | @'belowInclusive' k m@ is the subset of 'Map' @m@ whose keys are less+-- than or equal to @k@ belowInclusive :: Ord k => k -> Map k a -> Map k a belowInclusive k m =- let- (x, at, _) = splitLookup k m- in- case at of- Nothing -> x- Just v -> insert k v x--{- |--@'aboveInclusive' k m@ is the subset of 'Map' @m@ whose keys are greater than-or equal to @k@.+ let (x, at, _) = splitLookup k m+ in case at of+ Nothing -> x+ Just v -> insert k v x --}+-- | @'aboveInclusive' k m@ is the subset of 'Map' @m@ whose keys are+-- greater than or equal to @k@ aboveInclusive :: Ord k => k -> Map k a -> Map k a aboveInclusive k m =- let- (_, at, x) = splitLookup k m- in- case at of- Nothing -> x- Just v -> insert k v x+ let (_, at, x) = splitLookup k m+ in case at of+ Nothing -> x+ Just v -> insert k v x
src/Data/Loc/Internal/Prelude.hs view
@@ -1,10 +1,9 @@ module Data.Loc.Internal.Prelude- (- module X,+ ( module X, (<&>), readPrecChar, )- where+where import Control.Applicative as X (empty, pure, (*>), (<*), (<*>)) import Control.Arrow as X ((<<<), (>>>))@@ -27,22 +26,38 @@ import Data.Traversable as X (mapAccumL, sequenceA, traverse) import Data.Tuple as X (fst, snd) import Numeric.Natural as X (Natural)-import Prelude as X (Double, Enum (..), Int, Integral, Real (..), String, div,- fromIntegral, print, quotRem, round, sqrt, toInteger,- undefined, (/)) import System.Exit as X (exitFailure) import System.IO as X (IO)-import Text.ParserCombinators.ReadPrec as X (minPrec, readP_to_Prec,- readPrec_to_S)+import Text.ParserCombinators.ReadP qualified as ReadP+import Text.ParserCombinators.ReadPrec as X+ ( minPrec,+ readP_to_Prec,+ readPrec_to_S,+ ) import Text.Read as X (Read (..), ReadPrec, read) import Text.Show as X (Show (..), ShowS, showString, shows)--import qualified Text.ParserCombinators.ReadP as ReadP+import Prelude as X+ ( Double,+ Enum (..),+ Int,+ Integral,+ Real (..),+ String,+ div,+ fromIntegral,+ print,+ quotRem,+ round,+ sqrt,+ toInteger,+ undefined,+ (/),+ ) -- | '<&>' = flip 'fmap' (<&>) :: Functor f => f a -> (a -> b) -> f b (<&>) = flip fmap --- | A precedence parser that reads a single specific character.+-- | A precedence parser that reads a single specific character readPrecChar :: Char -> ReadPrec () readPrecChar = void . readP_to_Prec . const . ReadP.char
src/Data/Loc/List/OneToTwo.hs view
@@ -1,59 +1,55 @@ module Data.Loc.List.OneToTwo- (- -- * Imports+ ( -- * Imports -- $imports -- * Type OneToTwo (..), -- * Tuple conversion- toTuple, toTuple',+ toTuple,+ toTuple', )- where+where import Data.Loc.Internal.Prelude --- | List of length 1 or 2.+-- | List of length 1 or 2 data OneToTwo a- = One a -- ^ List of length 1- | Two a a -- ^ List of length 2+ = -- | List of length 1+ One a+ | -- | List of length 2+ Two a a deriving (Eq, Ord, Show, Read, Foldable, Functor) -{- |-->>> toTuple (One 1)-(1,Nothing)-->>> toTuple (Two 1 2)-(1,Just 2)---}+-- |+--+-- >>> toTuple (One 1)+-- (1,Nothing)+--+-- >>> toTuple (Two 1 2)+-- (1,Just 2) toTuple :: OneToTwo a -> (a, Maybe a) toTuple = \case One a -> (a, Nothing) Two a b -> (a, Just b) -{- |-->>> toTuple' (One 1)-(Nothing,1)-->>> toTuple' (Two 1 2)-(Just 1,2)---}+-- |+--+-- >>> toTuple' (One 1)+-- (Nothing,1)+--+-- >>> toTuple' (Two 1 2)+-- (Just 1,2) toTuple' :: OneToTwo a -> (Maybe a, a) toTuple' = \case One a -> (Nothing, a) Two a b -> (Just a, b) -{- $imports--Recommended import:--> import Data.Loc.List.OneToTwo (OneToTwo)-> import qualified Data.Loc.List.OneToTwo as OneToTwo---}+-- $imports+--+-- Recommended import:+--+-- > import Data.Loc.List.OneToTwo (OneToTwo)+-- > import qualified Data.Loc.List.OneToTwo as OneToTwo
src/Data/Loc/List/ZeroToTwo.hs view
@@ -1,27 +1,27 @@ module Data.Loc.List.ZeroToTwo- (- -- Imports+ ( -- Imports -- $imports -- * Type ZeroToTwo (..), )- where+where import Data.Loc.Internal.Prelude --- | List of length 0, 1, or 2.+-- | List of length 0, 1, or 2 data ZeroToTwo a- = Zero -- ^ List of length 0- | One a -- ^ List of length 1- | Two a a -- ^ List of length 2+ = -- | List of length 0+ Zero+ | -- | List of length 1+ One a+ | -- | List of length 2+ Two a a deriving (Eq, Ord, Show, Read, Foldable, Functor) -{- $imports--Recommended import:--> import Data.Loc.List.ZeroToTwo (ZeroToTwo)-> import qualified Data.Loc.List.ZeroToTwo as ZeroToTwo---}+-- $imports+--+-- Recommended import:+--+-- > import Data.Loc.List.ZeroToTwo (ZeroToTwo)+-- > import qualified Data.Loc.List.ZeroToTwo as ZeroToTwo
src/Data/Loc/Loc.hs view
@@ -1,85 +1,71 @@ module Data.Loc.Loc- (- Loc,+ ( Loc, -- * Constructing- loc, origin,+ loc,+ origin, -- * Querying- line, column,+ line,+ column, -- * Show and Read- locShowsPrec, locReadPrec,-- ) where--import Data.Loc.Pos (Column, Line)+ locShowsPrec,+ locReadPrec,+ )+where import Data.Loc.Internal.Prelude--import Data.Data (Data)--{- |--Stands for /location/. Consists of a 'Line' and a 'Column'. You can think of a-'Loc' like a caret position in a text editor. Following the normal convention-for text editors and such, line and column numbers start with 1.+import Data.Loc.Pos (Column, Line)+import Integer.Positive (Positive) --}+-- | Stands for /location/, consists of a 'Line' and a 'Column'+--+-- You can think of a 'Loc' like a caret position in a text editor.+-- Following the normal convention for text editors and such, line+-- and column numbers start with 1. data Loc = Loc- { line :: Line- , column :: Column+ { line :: Line,+ column :: Column }- deriving (Data, Eq, Ord)+ deriving (Eq, Ord) -- | 'showsPrec' = 'locShowsPrec'-instance Show Loc- where-- showsPrec = locShowsPrec+instance Show Loc where+ showsPrec = locShowsPrec -- | 'readPrec' = 'locReadPrec'-instance Read Loc- where-- readPrec = locReadPrec--{- |-->>> locShowsPrec minPrec (loc 3 14) ""-"3:14"+instance Read Loc where+ readPrec = locReadPrec --}+-- |+--+-- >>> locShowsPrec minPrec (loc 3 14) ""+-- "3:14" locShowsPrec :: Int -> Loc -> ShowS locShowsPrec _ (Loc l c) =- shows l .- showString ":" .- shows c--{- |-->>> readPrec_to_S locReadPrec minPrec "3:14"-[(3:14,"")]+ shows l+ . showString ":"+ . shows c --}+-- |+--+-- >>> readPrec_to_S locReadPrec minPrec "3:14"+-- [(3:14,"")] locReadPrec :: ReadPrec Loc locReadPrec =- Loc <$>- readPrec <*- readPrecChar ':' <*>- readPrec+ Loc+ <$> (fromIntegral <$> readPrec @Positive)+ <* readPrecChar ':'+ <*> (fromIntegral <$> readPrec @Positive) -- | Create a 'Loc' from a line number and column number. loc :: Line -> Column -> Loc loc = Loc -{- |--The smallest location: @'loc' 1 1@.-->>> origin-1:1---}+-- | The smallest location: @'loc' 1 1@+--+-- >>> origin+-- 1:1 origin :: Loc origin = loc 1 1
src/Data/Loc/Pos.hs view
@@ -1,199 +1,23 @@ module Data.Loc.Pos- (- Pos, Line, Column, ToNat (..),-- -- * Show and Read- posShowsPrec, posReadPrec,+ ( Line,+ Column, )- where+where import Data.Loc.Internal.Prelude-+import Integer (Positive) import Prelude (Num (..)) -import Data.Data (Data)--{- |--'Pos' stands for /positive integer/. You can also think of it as /position/,-because we use it to represent line and column numbers ('Line' and 'Column').--'Pos' has instances of several of the standard numeric typeclasses, although-many of the operations throw 'Underflow' when non-positive values result.-'Pos' does /not/ have an 'Integral' instance, because there is no sensible-way to implement 'quotRem'.---}-newtype Pos = Pos Natural- deriving (Data, Eq, Ord)--instance ToNat Pos- where-- toNat (Pos n) = n--instance Show Pos- where-- showsPrec = posShowsPrec--instance Read Pos- where-- readPrec = posReadPrec--{- |-->>> fromInteger 3 :: Pos-3-->>> fromInteger 0 :: Pos-*** Exception: arithmetic underflow-->>> 2 + 3 :: Pos-5-->>> 3 - 2 :: Pos-1-->>> 3 - 3 :: Pos-*** Exception: arithmetic underflow-->>> 2 * 3 :: Pos-6-->>> negate 3 :: Pos-*** Exception: arithmetic underflow---}-instance Num Pos- where-- fromInteger = Pos . checkForUnderflow . fromInteger-- Pos x + Pos y = Pos (x + y)-- Pos x - Pos y = Pos (checkForUnderflow (x - y))-- Pos x * Pos y = Pos (x * y)-- abs = id-- signum _ = Pos 1-- negate _ = throw Underflow--instance Real Pos- where-- toRational (Pos n) = toRational n--{- |-->>> toEnum 3 :: Pos-3-->>> toEnum 0 :: Pos-*** Exception: arithmetic underflow-->>> fromEnum (3 :: Pos)-3---}-instance Enum Pos- where-- toEnum = Pos . checkForUnderflow . toEnum-- fromEnum (Pos n) = fromEnum n--checkForUnderflow :: Natural -> Natural-checkForUnderflow n =- if n == 0 then throw Underflow else n--{- |-->>> posShowsPrec minPrec 1 ""-"1"-->>> posShowsPrec minPrec 42 ""-"42"---}-posShowsPrec :: Int -> Pos -> ShowS-posShowsPrec i (Pos n) =- showsPrec i n--{- |-->>> readPrec_to_S posReadPrec minPrec "1"-[(1,"")]-->>> readPrec_to_S posReadPrec minPrec "42"-[(42,"")]-->>> readPrec_to_S posReadPrec minPrec "0"-[]-->>> readPrec_to_S posReadPrec minPrec "-1"-[]---}-posReadPrec :: ReadPrec Pos-posReadPrec =- Pos <$> mfilter (/= 0) readPrec-- ----------------------------------------------------------------------------------- ToNat-----------------------------------------------------------------------------------{- |--Types that can be converted to 'Natural'.--This class mostly exists so that 'toNat' can be used in situations that would-normally call for 'toInteger' (which we cannot use because 'Pos' does not have-an instance of 'Integral').---}-class ToNat a- where-- toNat :: a -> Natural----------------------------------------------------------------------------------- -- Line -------------------------------------------------------------------------------- -newtype Line = Line Pos- deriving (Data, Eq, Ord, Num, Real, Enum, ToNat)--instance Show Line- where-- showsPrec i (Line pos) = showsPrec i pos--instance Read Line- where-- readPrec = Line <$> readPrec-+newtype Line = Line Positive+ deriving newtype (Eq, Ord, Num, Integral, Real, Enum, Show) -------------------------------------------------------------------------------- -- Column -------------------------------------------------------------------------------- -newtype Column = Column Pos- deriving (Data, Eq, Ord, Num, Real, Enum, ToNat)--instance Show Column- where-- showsPrec i (Column pos) = showsPrec i pos--instance Read Column- where-- readPrec = Column <$> readPrec+newtype Column = Column Positive+ deriving newtype (Eq, Ord, Num, Integral, Real, Enum, Show)
src/Data/Loc/Span.hs view
@@ -1,119 +1,107 @@ module Data.Loc.Span- (- Span,+ ( Span, -- * Constructing- fromTo, fromToMay,+ fromTo,+ fromToMay, -- * Querying- start, end,+ start,+ end, -- * Calculations lines,- overlapping, linesOverlapping, touching,- join, joinAsc,- (+), (-),+ overlapping,+ linesOverlapping,+ touching,+ join,+ joinAsc,+ (+),+ (-), -- * Show and Read- spanShowsPrec, spanReadPrec,+ spanShowsPrec,+ spanReadPrec, )- where--import Data.Loc.Internal.Prelude+where +import Data.Foldable qualified as Foldable+import Data.List.NonEmpty qualified as NonEmpty import Data.Loc.Exception (LocException (..))+import Data.Loc.Internal.Prelude import Data.Loc.List.OneToTwo (OneToTwo)+import Data.Loc.List.OneToTwo qualified as OneToTwo import Data.Loc.List.ZeroToTwo (ZeroToTwo)+import Data.Loc.List.ZeroToTwo qualified as ZeroToTwo import Data.Loc.Loc (Loc, locReadPrec, locShowsPrec)+import Data.Loc.Loc qualified as Loc import Data.Loc.Pos (Line) -import qualified Data.Loc.List.OneToTwo as OneToTwo-import qualified Data.Loc.List.ZeroToTwo as ZeroToTwo-import qualified Data.Loc.Loc as Loc--import Data.Data (Data)-import qualified Data.Foldable as Foldable-import qualified Data.List.NonEmpty as NonEmpty--{- |--A 'Span' consists of a start location ('start') and an end location ('end').-The end location must be greater than the start location; in other words, empty-or backwards spans are not permitted.--Construct and combine spans using 'fromTo', 'fromToMay', '+', and '-'.---}+-- | A 'Span' consists of a start location ('start') and an end location ('end')+--+-- The end location must be greater than the start location; in other words, empty+-- or backwards spans are not permitted.+--+-- Construct and combine spans using 'fromTo', 'fromToMay', '+', and '-'. data Span = Span- { start :: Loc- , end :: Loc- } deriving (Data, Eq, Ord)+ { start :: Loc,+ end :: Loc+ }+ deriving (Eq, Ord) -- | 'showsPrec' = 'spanShowsPrec'-instance Show Span- where-- showsPrec = spanShowsPrec+instance Show Span where+ showsPrec = spanShowsPrec -- | 'readPrec' = 'spanReadPrec'-instance Read Span- where-- readPrec = spanReadPrec---{- |-->>> spanShowsPrec minPrec (fromTo (read "3:14") (read "6:5")) ""-"3:14-6:5"+instance Read Span where+ readPrec = spanReadPrec --}+-- |+--+-- >>> spanShowsPrec minPrec (fromTo (read "3:14") (read "6:5")) ""+-- "3:14-6:5" spanShowsPrec :: Int -> Span -> ShowS spanShowsPrec _ (Span a b) =- locShowsPrec 10 a .- showString "-" .- locShowsPrec 10 b--{- |-->>> readPrec_to_S spanReadPrec minPrec "3:14-6:5"-[(3:14-6:5,"")]-->>> readPrec_to_S spanReadPrec minPrec "6:5-3:14"-[(3:14-6:5,"")]-->>> readPrec_to_S spanReadPrec minPrec "6:5-6:5"-[]+ locShowsPrec 10 a+ . showString "-"+ . locShowsPrec 10 b --}+-- |+--+-- >>> readPrec_to_S spanReadPrec minPrec "3:14-6:5"+-- [(3:14-6:5,"")]+--+-- >>> readPrec_to_S spanReadPrec minPrec "6:5-3:14"+-- [(3:14-6:5,"")]+--+-- >>> readPrec_to_S spanReadPrec minPrec "6:5-6:5"+-- [] spanReadPrec :: ReadPrec Span spanReadPrec =- locReadPrec >>= \a ->- readPrecChar '-' *>- locReadPrec >>= \b ->- maybe empty pure (fromToMay a b)--{- |--Attempt to construct a 'Span' from two 'Loc's. The lesser loc will be the-start, and the greater loc will be the end. The two locs must not be equal,-or else this throws 'EmptySpan'.--/The safe version of this function is 'fromToMay'./+ locReadPrec >>= \a ->+ readPrecChar '-'+ *> locReadPrec+ >>= \b ->+ maybe empty pure (fromToMay a b) --}+-- | Attempt to construct a 'Span' from two 'Loc's+--+-- The lesser loc will be the start, and the greater loc will be the end.+-- The two locs must not be equal, or else this throws 'EmptySpan'.+--+-- /The safe version of this function is 'fromToMay'./ fromTo :: Loc -> Loc -> Span fromTo a b = fromMaybe (throw EmptySpan) (fromToMay a b) -{- |--Attempt to construct a 'Span' from two 'Loc's. The lesser loc will be the-start, and the greater loc will be the end. If the two locs are equal,-the result is 'Nothing', because a span cannot be empty.--/This is the safe version of 'fromTo', which throws an exception instead./--}+-- | Attempt to construct a 'Span' from two 'Loc's+--+-- The lesser loc will be the start, and the greater loc will be the end.+-- If the two locs are equal, the result is 'Nothing', because a span cannot+-- be empty.+--+-- /This is the safe version of 'fromTo', which throws an exception instead./ fromToMay :: Loc -> Loc -> Maybe Span fromToMay a b = case compare a b of@@ -121,190 +109,163 @@ GT -> Just (Span b a) EQ -> Nothing -{- |--All of the lines that a span touches.-->>> NonEmpty.toList (lines (read "2:6-2:10"))-[2]-->>> NonEmpty.toList (lines (read "2:6-8:4"))-[2,3,4,5,6,7,8]---}+-- | All of the lines that a span touches+--+-- >>> NonEmpty.toList (lines (read "2:6-2:10"))+-- [2]+--+-- >>> NonEmpty.toList (lines (read "2:6-8:4"))+-- [2,3,4,5,6,7,8] lines :: Span -> NonEmpty Line lines s = NonEmpty.fromList [Loc.line (start s) .. Loc.line (end s)] -{- |--Spans that are directly abutting do not count as overlapping.-->>> overlapping (read "1:5-1:8") (read "1:8-1:12")-False--But these spans overlap by a single character:-->>> overlapping (read "1:5-1:9") (read "1:8-1:12")-True--Spans are overlapping if one is contained entirely within another.-->>> overlapping (read "1:5-1:15") (read "1:6-1:10")-True--Spans are overlapping if they are identical.-->>> overlapping (read "1:5-1:15") (read "1:5-1:15")-True---}+-- | Spans that are directly abutting do not count as overlapping+--+-- >>> overlapping (read "1:5-1:8") (read "1:8-1:12")+-- False+--+-- But these spans overlap by a single character:+--+-- >>> overlapping (read "1:5-1:9") (read "1:8-1:12")+-- True+--+-- Spans are overlapping if one is contained entirely within another.+--+-- >>> overlapping (read "1:5-1:15") (read "1:6-1:10")+-- True+--+-- Spans are overlapping if they are identical.+--+-- >>> overlapping (read "1:5-1:15") (read "1:5-1:15")+-- True overlapping :: Span -> Span -> Bool overlapping a b = not (end a <= start b || end b <= start a) -{- |--Determines whether the two spans touch any of the same lines.-->>> linesOverlapping (read "1:1-1:2") (read "1:1-1:2")-True-->>> linesOverlapping (read "1:1-1:2") (read "1:1-2:1")-True-->>> linesOverlapping (read "1:1-1:2") (read "2:1-2:2")-False---}+-- | Determines whether the two spans touch any of the same lines+--+-- >>> linesOverlapping (read "1:1-1:2") (read "1:1-1:2")+-- True+--+-- >>> linesOverlapping (read "1:1-1:2") (read "1:1-2:1")+-- True+--+-- >>> linesOverlapping (read "1:1-1:2") (read "2:1-2:2")+-- False linesOverlapping :: Span -> Span -> Bool linesOverlapping a b = not $- (Loc.line . end) a < (Loc.line . start) b ||- (Loc.line . end) b < (Loc.line . start) a--{- |--Two spans are considered to "touch" if they are overlapping or abutting;-in other words, if there is no space between them.-->>> touching (read "1:1-1:2") (read "1:2-1:3")-True-->>> touching (read "1:1-1:2") (read "1:1-1:3")-True-->>> touching (read "1:1-1:2") (read "1:3-1:4")-False+ (Loc.line . end) a < (Loc.line . start) b+ || (Loc.line . end) b < (Loc.line . start) a --}+-- | Two spans are considered to "touch" if they are overlapping+-- or abutting; in other words, if there is no space between them+--+-- >>> touching (read "1:1-1:2") (read "1:2-1:3")+-- True+--+-- >>> touching (read "1:1-1:2") (read "1:1-1:3")+-- True+--+-- >>> touching (read "1:1-1:2") (read "1:3-1:4")+-- False touching :: Span -> Span -> Bool touching a b = not (end a < start b || end b < start a) -{- |-->>> join (read "1:1-1:2") (read "1:2-1:3")-1:1-1:3-->>> join (read "1:1-1:2") (read "1:1-1:3")-1:1-1:3---}+-- |+--+-- >>> join (read "1:1-1:2") (read "1:2-1:3")+-- 1:1-1:3+--+-- >>> join (read "1:1-1:2") (read "1:1-1:3")+-- 1:1-1:3 join :: Span -> Span -> Span join a b =- Span (min (start a) (start b))- (max (end a) (end b))--{- |--Combine two 'Span's, merging them if they abut or overlap.-->>> read "1:1-1:2" + read "1:2-1:3"-One 1:1-1:3-->>> read "1:1-1:2" + read "1:1-3:1"-One 1:1-3:1-->>> read "1:1-1:2" + read "1:1-11:1"-One 1:1-11:1--If the spans are not overlapping or abutting, they are returned unmodified-in the same order in which they were given as parameters.-->>> read "1:1-1:2" + read "2:1-2:5"-Two 1:1-1:2 2:1-2:5-->>> read "2:1-2:5" + read "1:1-1:2"-Two 2:1-2:5 1:1-1:2+ Span+ (min (start a) (start b))+ (max (end a) (end b)) --}+-- | Combine two 'Span's, merging them if they abut or overlap+--+-- >>> read "1:1-1:2" + read "1:2-1:3"+-- One 1:1-1:3+--+-- >>> read "1:1-1:2" + read "1:1-3:1"+-- One 1:1-3:1+--+-- >>> read "1:1-1:2" + read "1:1-11:1"+-- One 1:1-11:1+--+-- If the spans are not overlapping or abutting, they are returned unmodified+-- in the same order in which they were given as parameters.+--+-- >>> read "1:1-1:2" + read "2:1-2:5"+-- Two 1:1-1:2 2:1-2:5+--+-- >>> read "2:1-2:5" + read "1:1-1:2"+-- Two 2:1-2:5 1:1-1:2 (+) :: Span -> Span -> OneToTwo Span a + b | touching a b = OneToTwo.One (join a b)- | otherwise = OneToTwo.Two a b--{- |--The difference between two 'Spans's. @a '-' b@ contains what is covered by-@a@ and not covered by @b@.-->>> read "2:5-4:1" - read "2:9-3:5"-Two 2:5-2:9 3:5-4:1-->>> read "2:5-4:1" - read "2:5-3:5"-One 3:5-4:1-->>> read "2:5-4:1" - read "2:2-3:5"-One 3:5-4:1--Subtracting a thing from itself yields nothing.-->>> let x = read "2:5-4:1" in x - x-Zero-->>> read "2:5-4:1" - read "2:2-4:4"-Zero-->>> read "1:1-8:1" - read "1:2-8:1"-One 1:1-1:2+ | otherwise = OneToTwo.Two a b --}+-- | The difference between two 'Spans's+--+-- @a '-' b@ contains what is covered by @a@ and not covered by @b@.+--+-- >>> read "2:5-4:1" - read "2:9-3:5"+-- Two 2:5-2:9 3:5-4:1+--+-- >>> read "2:5-4:1" - read "2:5-3:5"+-- One 3:5-4:1+--+-- >>> read "2:5-4:1" - read "2:2-3:5"+-- One 3:5-4:1+--+-- Subtracting a thing from itself yields nothing.+--+-- >>> let x = read "2:5-4:1" in x - x+-- Zero+--+-- >>> read "2:5-4:1" - read "2:2-4:4"+-- Zero+--+-- >>> read "1:1-8:1" - read "1:2-8:1"+-- One 1:1-1:2 (-) :: Span -> Span -> ZeroToTwo Span a - b-- -- [ a ] [ b ]+ -- [ a ] [ b ] | not (overlapping a b) = ZeroToTwo.One a-- -- [ a ]- -- [ b ]+ -- [ a ]+ -- [ b ] | start b > start a && end b < end a =- ZeroToTwo.Two (Span (start a) (start b))- (Span (end b) (end a))-- -- [ a ]- -- [ b ]+ ZeroToTwo.Two+ (Span (start a) (start b))+ (Span (end b) (end a))+ -- [ a ]+ -- [ b ] | start b <= start a && end b < end a = ZeroToTwo.One (Span (end b) (end a))-- -- [ a ]- -- [ b ]+ -- [ a ]+ -- [ b ] | start b > start a && end b >= end a = ZeroToTwo.One (Span (start a) (start b))- | otherwise = ZeroToTwo.Zero --- | Given an ascending list of 'Span's, combine those which abut or overlap.-joinAsc- :: [Span] -- ^ A list of 'Spans' sorted in ascending order.- --- -- /This precondition is not checked./- -> [Span]+-- | Given an ascending list of 'Span's, combine those which abut or overlap+joinAsc ::+ -- | A list of 'Spans' sorted in ascending order.+ --+ -- /This precondition is not checked./+ [Span] ->+ [Span] joinAsc = \case- x:y:zs ->+ x : y : zs -> let (r, s) = OneToTwo.toTuple' (x + y)- in Foldable.toList r <> joinAsc (s:zs)+ in Foldable.toList r <> joinAsc (s : zs) xs -> xs
src/Data/Loc/SpanOrLoc.hs view
@@ -1,46 +1,40 @@ module Data.Loc.SpanOrLoc- (- SpanOrLoc,+ ( SpanOrLoc, -- * Constructing- span, loc, fromTo,+ span,+ loc,+ fromTo, -- * Deconstructing spanOrLoc, -- * Querying- start, end,+ start,+ end, )- where+where import Data.Loc.Internal.Prelude- import Data.Loc.Loc (Loc)+import Data.Loc.Loc qualified as Loc import Data.Loc.Span (Span)--import qualified Data.Loc.Loc as Loc-import qualified Data.Loc.Span as Span--import Data.Data (Data)--{- |--A 'SpanOrLoc' consists of a start location and an end location.-The end location must be greater than or equal to the start location;-in other words, backwards spans are not permitted.--If the start and end location are the same, then the value is a 'Loc'.-If they differ, then the value is a 'Span'.+import Data.Loc.Span qualified as Span --}+-- | A 'SpanOrLoc' consists of a start location and an end location+--+-- The end location must be greater than or equal to the start location;+-- in other words, backwards spans are not permitted.+--+-- If the start and end location are the same, then the value is a 'Loc'.+-- If they differ, then the value is a 'Span'. data SpanOrLoc = Span Span | Loc Loc- deriving (Data, Eq, Ord)+ deriving (Eq, Ord) -instance Show SpanOrLoc- where- showsPrec i = \case- Span x -> Span.spanShowsPrec i x- Loc x -> Loc.locShowsPrec i x+instance Show SpanOrLoc where+ showsPrec i = \case+ Span x -> Span.spanShowsPrec i x+ Loc x -> Loc.locShowsPrec i x span :: Span -> SpanOrLoc span = Span@@ -52,12 +46,10 @@ spanOrLoc f _ (Span x) = f x spanOrLoc _ f (Loc x) = f x -{- |--Construct a 'SpanOrLoc' from two 'Loc's. If the two locs are not equal,-the lesser loc will be the start, and the greater loc will be the end.---}+-- | Construct a 'SpanOrLoc' from two 'Loc's+--+-- If the two locs are not equal, the lesser loc will be the start,+-- and the greater loc will be the end. fromTo :: Loc -> Loc -> SpanOrLoc fromTo a b = maybe (Loc a) Span (Span.fromToMay a b)
src/Data/Loc/Types.hs view
@@ -1,18 +1,12 @@-{- |--For convenience, this module exports only the important types from 'Data.Loc'.---}+-- | For convenience, this module exports only the important types from 'Data.Loc' module Data.Loc.Types- (- Pos,- Line,+ ( Line, Column, Loc, Span, SpanOrLoc, Area, )- where+where import Data.Loc
test/Gen.hs view
@@ -1,20 +1,15 @@ module Gen where -import Data.Loc (ToNat (..))+import Data.List qualified as List+import Data.Loc qualified as Loc import Data.Loc.Internal.Prelude import Data.Loc.Types--import qualified Data.Loc as Loc-+import Data.Set qualified as Set import Hedgehog (Gen)+import Hedgehog.Gen qualified as Gen+import Hedgehog.Range qualified as Range import Prelude (Num (..)) -import qualified Data.List as List-import qualified Data.Set as Set-import qualified Hedgehog.Gen as Gen-import qualified Hedgehog.Range as Range-- -------------------------------------------------------------------------------- -- Parameter defaults --------------------------------------------------------------------------------@@ -27,7 +22,6 @@ defMaxColumn :: Column defMaxColumn = 99 - -------------------------------------------------------------------------------- -- Bounds --------------------------------------------------------------------------------@@ -35,185 +29,132 @@ -- | Inclusive lower and upper bounds on a range. type Bounds a = (a, a) -{- |--The size of a range specified by 'Bounds'.--Assumes the upper bound is at least the lower bound.---}+-- | The size of a range specified by 'Bounds'+--+-- Assumes the upper bound is at least the lower bound. boundsSize :: Num n => (n, n) -> n boundsSize (a, b) = 1 + b - a - -------------------------------------------------------------------------------- -- Pos -------------------------------------------------------------------------------- -{- |--@'pos' a b@ generates a number on the linear range /a/ to /b/.---}-pos :: (ToNat n, Num n) =>- Bounds n -- ^ Minimum and maximum value to generate- -> Gen n-pos (a, b) = fromInteger . toInteger <$> Gen.integral range- where- range = Range.linear (toNat a) (toNat b)--{- |--@'line' a b@ generates a line number on the linear range /a/ to /b/.---}+-- | @'line' a b@ generates a line number on the linear range /a/ to /b/ line ::- Bounds Line -- ^ Minimum and maximum line number- -> Gen Line-line = pos--{- |--Generates a line number within the default bounds @(1, 'defMaxLine')@.+ -- | Minimum and maximum line number+ Bounds Line ->+ Gen Line+line (a, b) = Gen.integral (Range.linear a b) --}+-- | Generates a line number within the default bounds @(1, 'defMaxLine')@ line' :: Gen Line line' = line (1, defMaxLine) -{- |--@'column' a b@ generates a column number on the linear range /a/ to /b/.---}+-- | @'column' a b@ generates a column number on the linear range /a/ to /b/ column ::- Bounds Column -- ^ Minimum and maximum column number- -> Gen Column-column = pos--{- |--Generates a column number within the default bounds @(1, 'defMaxColumn')@.+ -- | Minimum and maximum column number+ Bounds Column ->+ Gen Column+column (a, b) = Gen.integral (Range.linear a b) --}+-- | Generates a column number within the default bounds @(1, 'defMaxColumn')@ column' :: Gen Column column' = column (1, defMaxColumn) - -------------------------------------------------------------------------------- -- Loc -------------------------------------------------------------------------------- -{- |--@'loc' lineBounds columnBounds@ generates a 'Loc' with the line number-bounded by @lineBounds@ and column number bounded by @columnBounds@.---}+-- | @'loc' lineBounds columnBounds@ generates a 'Loc' with the line number+-- bounded by @lineBounds@ and column number bounded by @columnBounds@ loc ::- Bounds Line -- ^ Minimum and maximum line number- -> Bounds Column -- ^ Minimum and maximum column number- -> Gen Loc+ -- | Minimum and maximum line number+ Bounds Line ->+ -- | Minimum and maximum column number+ Bounds Column ->+ Gen Loc loc lineBounds columnBounds =- Loc.loc <$> line lineBounds <*> column columnBounds--{- |--Generates a 'Loc' within the default line and column bounds.+ Loc.loc <$> line lineBounds <*> column columnBounds --}+-- | Generates a 'Loc' within the default line and column bounds loc' :: Gen Loc loc' = loc (1, defMaxLine) (1, defMaxColumn) - -------------------------------------------------------------------------------- -- Span -------------------------------------------------------------------------------- -{- |--@'span' lineBounds columnBounds@ generates a 'Span' with start and end-positions whose line numbers are bounded by @lineBounds@ and whose column-numbers are bounded by @columnBounds@.---}+-- | @'span' lineBounds columnBounds@ generates a 'Span' with start and end+-- positions whose line numbers are bounded by @lineBounds@ and whose column+-- numbers are bounded by @columnBounds@ span ::- Bounds Line -- ^ Minimum and maximum line number- -> Bounds Column -- ^ Minimum and maximum column number- -> Gen Span+ -- | Minimum and maximum line number+ Bounds Line ->+ -- | Minimum and maximum column number+ Bounds Column ->+ Gen Span span lineBounds columnBounds@(minColumn, maxColumn) =- let- lines :: Gen (Line, Line)- lines =- line lineBounds >>= \a ->- line lineBounds <&> \b ->- (min a b, max a b)-- columnsDifferentLine :: Gen (Column, Column)- columnsDifferentLine =- column columnBounds >>= \a ->- column columnBounds <&> \b ->- (a, b)-- columnsSameLine :: Gen (Column, Column)- columnsSameLine =- column (minColumn + 1, maxColumn) >>= \a ->- column columnBounds <&> \b ->- case compare a b of- EQ -> (a - 1, b)- LT -> (a, b)- GT -> (b, a)-- in- lines >>= \(startLine, endLine) ->- (if startLine /= endLine- then columnsDifferentLine- else columnsSameLine- ) <&> \(startColumn, endColumn) ->-- let- start = Loc.loc startLine startColumn- end = Loc.loc endLine endColumn-- in- Loc.spanFromTo start end+ let lines :: Gen (Line, Line)+ lines =+ line lineBounds >>= \a ->+ line lineBounds <&> \b ->+ (min a b, max a b) -{- |+ columnsDifferentLine :: Gen (Column, Column)+ columnsDifferentLine =+ column columnBounds >>= \a ->+ column columnBounds <&> \b ->+ (a, b) -Generates a 'Span' with start and end positions within the default line and-column bounds.+ columnsSameLine :: Gen (Column, Column)+ columnsSameLine =+ column (minColumn + 1, maxColumn) >>= \a ->+ column columnBounds <&> \b ->+ case compare a b of+ EQ -> (a - 1, b)+ LT -> (a, b)+ GT -> (b, a)+ in lines >>= \(startLine, endLine) ->+ ( if startLine /= endLine+ then columnsDifferentLine+ else columnsSameLine+ )+ <&> \(startColumn, endColumn) ->+ let start = Loc.loc startLine startColumn+ end = Loc.loc endLine endColumn+ in Loc.spanFromTo start end --}+-- | Generates a 'Span' with start and end positions within the default line and+-- column bounds span' :: Gen Span span' = span (1, defMaxLine) (1, defMaxColumn) - -------------------------------------------------------------------------------- -- Area -------------------------------------------------------------------------------- -{- |--@'area' lineBounds columnBounds@ generates an 'Area' consisting of 'Span's-with start and end positions whose line numbers are bounded by @lineBounds@-and whose column numbers are bounded by @columnBounds@.---}+-- | @'area' lineBounds columnBounds@ generates an 'Area' consisting of 'Span's+-- with start and end positions whose line numbers are bounded by @lineBounds@+-- and whose column numbers are bounded by @columnBounds@ area ::- Bounds Line -- ^ Minimum and maximum line number- -> Bounds Column -- ^ Minimum and maximum column number- -> Gen Area+ -- | Minimum and maximum line number+ Bounds Line ->+ -- | Minimum and maximum column number+ Bounds Column ->+ Gen Area area lineBounds columnBounds =- fold . snd . mapAccumL f Nothing . Set.toAscList . Set.fromList <$> locs-+ fold . snd . mapAccumL f Nothing . Set.toAscList . Set.fromList <$> locs where- gridSize :: Int = fromIntegral $ toNat (boundsSize lineBounds)- `max` toNat (boundsSize columnBounds)+ gridSize :: Int =+ max+ (fromIntegral (boundsSize lineBounds))+ (fromIntegral (boundsSize columnBounds)) locs :: Gen [Loc] = loc lineBounds columnBounds- & List.repeat- & List.take (gridSize `div` 5)- & sequenceA+ & List.repeat+ & List.take (gridSize `div` 5)+ & sequenceA f :: Maybe Loc -> Loc -> (Maybe Loc, Area) f prevLocMay newLoc =@@ -221,11 +162,7 @@ Just prevLoc -> (Nothing, Loc.areaFromTo prevLoc newLoc) Nothing -> (Just newLoc, mempty) -{- |--Generates an 'Area' consisting of 'Span's with start and end positions within-the default line and column bounds.---}+-- | Generates an 'Area' consisting of 'Span's with start and end positions within+-- the default line and column bounds area' :: Gen Area area' = area (1, defMaxLine) (1, defMaxColumn)
test/Main.hs view
@@ -1,237 +1,207 @@ module Main (main) where +import Data.List qualified as List+import Data.List.NonEmpty qualified as NonEmpty import Data.Loc+import Data.Loc.Area qualified as Area import Data.Loc.Internal.Prelude--import qualified Data.Loc.Pos as Pos-import qualified Data.Loc.Loc as Loc-import qualified Data.Loc.Area as Area-import qualified Data.Loc.Span as Span-import qualified Data.Loc.List.OneToTwo as OneToTwo-import qualified Data.Loc.List.ZeroToTwo as ZeroToTwo-+import Data.Loc.List.OneToTwo qualified as OneToTwo+import Data.Loc.List.ZeroToTwo qualified as ZeroToTwo+import Data.Loc.Loc qualified as Loc+import Data.Loc.Span qualified as Span+import Gen qualified import Hedgehog+import Hedgehog.Gen qualified as Gen+import Hedgehog.Range qualified as Range import Test.Hspec import Test.Hspec.Hedgehog -import qualified Data.List as List-import qualified Hedgehog.Gen as Gen-import qualified Hedgehog.Range as Range-import qualified Gen--import Prelude (fromInteger, ($!), Num (..))--import qualified Data.List.NonEmpty as NonEmpty- main :: IO () main = hspec do- posSpec- locSpec- spanSpec- areaSpec--posSpec :: SpecWith ()-posSpec = describe "Pos" do- specify "fromInteger" $ (fromInteger 3 :: Pos) == 3- specify "fromInteger underflow" $ (return $! (fromInteger 0 :: Pos)) `shouldThrow` (== Underflow)- specify "2 + 3" $ (2 + 3 :: Pos) == 5- specify "3 - 2" $ (3 - 2 :: Pos) == 1- specify "(-) underflow" $ (return $! (3 - 3 :: Pos)) `shouldThrow` (== Underflow)- specify "2 * 3" $ (2 * 3 :: Pos) == 6- specify "negate underflow" $ (return $! (negate 3 :: Pos)) `shouldThrow` (== Underflow)- specify "toEnum" $ (toEnum 3 :: Pos) == 3- specify "toEnum underflow" $ (return $! (toEnum 0 :: Pos)) `shouldThrow` (== Underflow)- specify "fromEnum" $ fromEnum (3 :: Pos) == 3- specify "show 1" $ Pos.posShowsPrec minPrec 1 "" == "1"- specify "show 42" $ Pos.posShowsPrec minPrec 42 "" == "42"- specify "read 1" $ readPrec_to_S Pos.posReadPrec minPrec "1" == [(1,"")]- specify "read 42" $ readPrec_to_S Pos.posReadPrec minPrec "42" == [(42,"")]- specify "read 0" $ readPrec_to_S Pos.posReadPrec minPrec "0" == []- specify "read -1" $ readPrec_to_S Pos.posReadPrec minPrec "-1" == []+ locSpec+ spanSpec+ areaSpec locSpec :: SpecWith () locSpec = describe "Loc" do-- specify "read and show" $ hedgehog do- x <- forAll Gen.loc'- read (show x) === x+ specify "read and show" $ hedgehog do+ x <- forAll Gen.loc'+ read (show x) === x - specify "read and show examples" $ hedgehog do- show Loc.origin === "1:1"- Loc.locShowsPrec minPrec (loc 3 14) "" === "3:14"- readPrec_to_S Loc.locReadPrec minPrec "3:14" === [(read "3:14","")]+ specify "read and show examples" $ hedgehog do+ show Loc.origin === "1:1"+ Loc.locShowsPrec minPrec (loc 3 14) "" === "3:14"+ readPrec_to_S Loc.locReadPrec minPrec "3:14" === [(read "3:14", "")] spanSpec :: SpecWith () spanSpec = describe "Span" do-- specify "joinAsc" $ hedgehog do- spans <- forAll (Gen.list (Range.linear 1 10) Gen.span')- areaSpansAsc (foldMap spanArea spans) === Span.joinAsc (List.sort spans)+ specify "joinAsc" $ hedgehog do+ spans <- forAll (Gen.list (Range.linear 1 10) Gen.span')+ areaSpansAsc (foldMap spanArea spans) === Span.joinAsc (List.sort spans) - specify "read and show" $ hedgehog do- x <- forAll Gen.span'- read (show x) === x+ specify "read and show" $ hedgehog do+ x <- forAll Gen.span'+ read (show x) === x - describe "read and show examples" do- specify "show 3:14-6:5" $ Span.spanShowsPrec minPrec (Span.fromTo (read "3:14") (read "6:5")) "" == "3:14-6:5"- specify "read 3:14-6:5" $ show (readPrec_to_S Span.spanReadPrec minPrec "3:14-6:5") == "[(3:14-6:5,\"\")]"- specify "read 6:5-3:14" $ show (readPrec_to_S Span.spanReadPrec minPrec "6:5-3:14") == "[(3:14-6:5,\"\")]"- specify "read 6:5-6:5" $ readPrec_to_S Span.spanReadPrec minPrec "6:5-6:5" == []+ describe "read and show examples" do+ specify "show 3:14-6:5" $ Span.spanShowsPrec minPrec (Span.fromTo (read "3:14") (read "6:5")) "" == "3:14-6:5"+ specify "read 3:14-6:5" $ show (readPrec_to_S Span.spanReadPrec minPrec "3:14-6:5") == "[(3:14-6:5,\"\")]"+ specify "read 6:5-3:14" $ show (readPrec_to_S Span.spanReadPrec minPrec "6:5-3:14") == "[(3:14-6:5,\"\")]"+ specify "read 6:5-6:5" $ readPrec_to_S Span.spanReadPrec minPrec "6:5-6:5" == [] - describe "lines" do- specify "one" $ NonEmpty.toList (Span.lines (read "2:6-2:10")) == [2]- specify "many" $ NonEmpty.toList (Span.lines (read "2:6-8:4")) == [2,3,4,5,6,7,8]+ describe "lines" do+ specify "one" $ NonEmpty.toList (Span.lines (read "2:6-2:10")) == [2]+ specify "many" $ NonEmpty.toList (Span.lines (read "2:6-8:4")) == [2, 3, 4, 5, 6, 7, 8] - describe "overlapping" do- specify "if only touching, no" $ not $ Span.overlapping (read "1:5-1:8") (read "1:8-1:12")- specify "on a single line" $ Span.overlapping (read "1:5-1:9") (read "1:8-1:12")- specify "one contained within another" $ Span.overlapping (read "1:5-1:15") (read "1:6-1:10")- specify "same span" $ hedgehog do- x <- forAll Gen.span'- assert (Span.overlapping x x)+ describe "overlapping" do+ specify "if only touching, no" $ not $ Span.overlapping (read "1:5-1:8") (read "1:8-1:12")+ specify "on a single line" $ Span.overlapping (read "1:5-1:9") (read "1:8-1:12")+ specify "one contained within another" $ Span.overlapping (read "1:5-1:15") (read "1:6-1:10")+ specify "same span" $ hedgehog do+ x <- forAll Gen.span'+ assert (Span.overlapping x x) - describe "linesOverlapping" do- specify "same span" $ hedgehog do- x <- forAll Gen.span'- assert (Span.linesOverlapping x x)- specify "multi line" $ Span.linesOverlapping (read "1:1-1:2") (read "1:1-2:1")- specify "no" $ not $ Span.linesOverlapping (read "1:1-1:2") (read "2:1-2:2")+ describe "linesOverlapping" do+ specify "same span" $ hedgehog do+ x <- forAll Gen.span'+ assert (Span.linesOverlapping x x)+ specify "multi line" $ Span.linesOverlapping (read "1:1-1:2") (read "1:1-2:1")+ specify "no" $ not $ Span.linesOverlapping (read "1:1-1:2") (read "2:1-2:2") - describe "touching" do- specify "same span" $ hedgehog do- x <- forAll Gen.span'- assert (Span.touching x x)- specify "barely" $ Span.touching (read "1:1-1:2") (read "1:2-1:3")- specify "overlapping" $ Span.touching (read "1:1-1:2") (read "1:1-1:3")- specify "no" $ not $ Span.touching (read "1:1-1:2") (read "1:3-1:4")+ describe "touching" do+ specify "same span" $ hedgehog do+ x <- forAll Gen.span'+ assert (Span.touching x x)+ specify "barely" $ Span.touching (read "1:1-1:2") (read "1:2-1:3")+ specify "overlapping" $ Span.touching (read "1:1-1:2") (read "1:1-1:3")+ specify "no" $ not $ Span.touching (read "1:1-1:2") (read "1:3-1:4") - describe "join" do- specify "touching" $ Span.join (read "1:1-1:2") (read "1:2-1:3") == read "1:1-1:3"- specify "overlapping" $ Span.join (read "1:1-1:2") (read "1:1-1:3") == read "1:1-1:3"+ describe "join" do+ specify "touching" $ Span.join (read "1:1-1:2") (read "1:2-1:3") == read "1:1-1:3"+ specify "overlapping" $ Span.join (read "1:1-1:2") (read "1:1-1:3") == read "1:1-1:3" - describe "addition" do- specify "example 1" $ read "1:1-1:2" Span.+ read "1:2-1:3" == OneToTwo.One (read "1:1-1:3")- specify "example 2" $ read "1:1-1:2" Span.+ read "1:1-3:1" == OneToTwo.One (read "1:1-3:1")- specify "example 3" $ read "1:1-1:2" Span.+ read "1:1-11:1" == OneToTwo.One (read "1:1-11:1")- specify "example 4" $ read "1:1-1:2" Span.+ read "2:1-2:5" == OneToTwo.Two (read "1:1-1:2") (read "2:1-2:5")- specify "example 5" $ read "2:1-2:5" Span.+ read "1:1-1:2" == OneToTwo.Two (read "2:1-2:5") (read "1:1-1:2")+ describe "addition" do+ specify "example 1" $ read "1:1-1:2" Span.+ read "1:2-1:3" == OneToTwo.One (read "1:1-1:3")+ specify "example 2" $ read "1:1-1:2" Span.+ read "1:1-3:1" == OneToTwo.One (read "1:1-3:1")+ specify "example 3" $ read "1:1-1:2" Span.+ read "1:1-11:1" == OneToTwo.One (read "1:1-11:1")+ specify "example 4" $ read "1:1-1:2" Span.+ read "2:1-2:5" == OneToTwo.Two (read "1:1-1:2") (read "2:1-2:5")+ specify "example 5" $ read "2:1-2:5" Span.+ read "1:1-1:2" == OneToTwo.Two (read "2:1-2:5") (read "1:1-1:2") - describe "subtraction" do- specify "x - x" $ hedgehog do- x <- forAll Gen.span'- x Span.- x === ZeroToTwo.Zero- specify "example 1" $ read "2:5-4:1" Span.- read "2:9-3:5" == ZeroToTwo.Two (read "2:5-2:9") (read "3:5-4:1")- specify "example 2" $ read "2:5-4:1" Span.- read "2:5-3:5" == ZeroToTwo.One (read "3:5-4:1")- specify "example 3" $ read "2:5-4:1" Span.- read "2:2-3:5" == ZeroToTwo.One (read "3:5-4:1")- specify "example 4" $ read "2:5-4:1" Span.- read "2:2-4:4" == ZeroToTwo.Zero- specify "example 5" $ read "1:1-8:1" Span.- read "1:2-8:1" == ZeroToTwo.One (read "1:1-1:2")+ describe "subtraction" do+ specify "x - x" $ hedgehog do+ x <- forAll Gen.span'+ x Span.- x === ZeroToTwo.Zero+ specify "example 1" $ read "2:5-4:1" Span.- read "2:9-3:5" == ZeroToTwo.Two (read "2:5-2:9") (read "3:5-4:1")+ specify "example 2" $ read "2:5-4:1" Span.- read "2:5-3:5" == ZeroToTwo.One (read "3:5-4:1")+ specify "example 3" $ read "2:5-4:1" Span.- read "2:2-3:5" == ZeroToTwo.One (read "3:5-4:1")+ specify "example 4" $ read "2:5-4:1" Span.- read "2:2-4:4" == ZeroToTwo.Zero+ specify "example 5" $ read "1:1-8:1" Span.- read "1:2-8:1" == ZeroToTwo.One (read "1:1-1:2") areaSpec :: SpecWith () areaSpec = describe "Area" do-- specify "add mempty = id for a single span" $ hedgehog do- a <- forAll Gen.span'- spanArea a Area.+ mempty === spanArea a+ specify "add mempty = id for a single span" $ hedgehog do+ a <- forAll Gen.span'+ spanArea a Area.+ mempty === spanArea a - specify "subtract mempty = id for a single span" $ hedgehog do- a <- forAll Gen.span'- spanArea a Area.- mempty === spanArea a+ specify "subtract mempty = id for a single span" $ hedgehog do+ a <- forAll Gen.span'+ spanArea a Area.- mempty === spanArea a - specify "addition is commutative" $ hedgehog do- a <- forAll Gen.area'- b <- forAll Gen.area'- a Area.+ b === b Area.+ a+ specify "addition is commutative" $ hedgehog do+ a <- forAll Gen.area'+ b <- forAll Gen.area'+ a Area.+ b === b Area.+ a - specify "add mempty = id" $ hedgehog do- a <- forAll Gen.area'- a Area.+ mempty === a+ specify "add mempty = id" $ hedgehog do+ a <- forAll Gen.area'+ a Area.+ mempty === a - specify "subtract mempty = id" $ hedgehog do- a <- forAll Gen.area'- a Area.- mempty === a+ specify "subtract mempty = id" $ hedgehog do+ a <- forAll Gen.area'+ a Area.- mempty === a - specify "addition and subtraction" $ hedgehog do- a <- forAll Gen.area'- b <- forAll Gen.area'- c <- forAll Gen.area'- a Area.- b Area.- c === a Area.- (b Area.+ c)+ specify "addition and subtraction" $ hedgehog do+ a <- forAll Gen.area'+ b <- forAll Gen.area'+ c <- forAll Gen.area'+ a Area.- b Area.- c === a Area.- (b Area.+ c) - specify "addSpan" $ hedgehog do- a <- forAll Gen.area'- s <- forAll Gen.span'- Area.addSpan s a === areaUnion (spanArea s) a+ specify "addSpan" $ hedgehog do+ a <- forAll Gen.area'+ s <- forAll Gen.span'+ Area.addSpan s a === areaUnion (spanArea s) a - specify "fromTo mempty 1" $ hedgehog do- x <- forAll Gen.loc'- y <- forAll Gen.loc'- (Area.fromTo x y == mempty) === (x == y)+ specify "fromTo mempty 1" $ hedgehog do+ x <- forAll Gen.loc'+ y <- forAll Gen.loc'+ (Area.fromTo x y == mempty) === (x == y) - specify "fromTo mempty 2" $ hedgehog do- x <- forAll Gen.loc'- Area.fromTo x x === mempty+ specify "fromTo mempty 2" $ hedgehog do+ x <- forAll Gen.loc'+ Area.fromTo x x === mempty - specify "read and show" $ hedgehog do- x <- forAll Gen.area'- read (show x) === x+ specify "read and show" $ hedgehog do+ x <- forAll Gen.area'+ read (show x) === x - specify "read and show example 1" $ hedgehog do- let x = show (readPrec_to_S Area.areaReadPrec minPrec "[]")- x === "[([],\"\")]"+ specify "read and show example 1" $ hedgehog do+ let x = show (readPrec_to_S Area.areaReadPrec minPrec "[]")+ x === "[([],\"\")]" - specify "read and show example 2" $ hedgehog do- x <- forAll (Gen.element ["[3:2-5:5,8:3-11:4]", "[3:2-5:5,11:4-8:3]"])- let y = show (readPrec_to_S Area.areaReadPrec minPrec x)- y === "[([3:2-5:5,8:3-11:4],\"\")]"+ specify "read and show example 2" $ hedgehog do+ x <- forAll (Gen.element ["[3:2-5:5,8:3-11:4]", "[3:2-5:5,11:4-8:3]"])+ let y = show (readPrec_to_S Area.areaReadPrec minPrec x)+ y === "[([3:2-5:5,8:3-11:4],\"\")]" - specify "read and show example 3" $ hedgehog do- let x = show (readPrec_to_S Area.areaReadPrec minPrec "[3:2-5:5,8:3-8:3]")- x === "[]"+ specify "read and show example 3" $ hedgehog do+ let x = show (readPrec_to_S Area.areaReadPrec minPrec "[3:2-5:5,8:3-8:3]")+ x === "[]" - specify "constructed from a single span" $ hedgehog do- let x = read "4:5-6:3"- spanArea x === read "[4:5-6:3]"+ specify "constructed from a single span" $ hedgehog do+ let x = read "4:5-6:3"+ spanArea x === read "[4:5-6:3]" - specify "converted to a span, maybe" $ hedgehog do- Area.areaSpan mempty === Nothing- Area.areaSpan (read "[3:4-7:2]") === Just (read "3:4-7:2")- Area.areaSpan (read "[3:4-7:2,15:6-17:9]") === Just (read "3:4-17:9")+ specify "converted to a span, maybe" $ hedgehog do+ Area.areaSpan mempty === Nothing+ Area.areaSpan (read "[3:4-7:2]") === Just (read "3:4-7:2")+ Area.areaSpan (read "[3:4-7:2,15:6-17:9]") === Just (read "3:4-17:9") - specify "converted to a list of spans" $ hedgehog do- Area.spansAsc mempty === []- Area.spansAsc (read "[3:4-7:2,15:6-17:9]") === [read "3:4-7:2", read "15:6-17:9"]+ specify "converted to a list of spans" $ hedgehog do+ Area.spansAsc mempty === []+ Area.spansAsc (read "[3:4-7:2,15:6-17:9]") === [read "3:4-7:2", read "15:6-17:9"] - specify "spanCount" $ hedgehog do- Area.spanCount mempty === 0- Area.spanCount (read "[3:4-7:2]") === 1- Area.spanCount (read "[3:4-7:2,15:6-17:9]") === 2+ specify "spanCount" $ hedgehog do+ Area.spanCount mempty === 0+ Area.spanCount (read "[3:4-7:2]") === 1+ Area.spanCount (read "[3:4-7:2,15:6-17:9]") === 2 - specify "firstSpan" $ hedgehog do- Area.firstSpan mempty === Nothing- Area.firstSpan (read "[3:4-7:2]") === Just (read "3:4-7:2")- Area.firstSpan (read "[3:4-7:2,15:6-17:9]") === Just (read "3:4-7:2")+ specify "firstSpan" $ hedgehog do+ Area.firstSpan mempty === Nothing+ Area.firstSpan (read "[3:4-7:2]") === Just (read "3:4-7:2")+ Area.firstSpan (read "[3:4-7:2,15:6-17:9]") === Just (read "3:4-7:2") - specify "lastSpan" $ hedgehog do- Area.lastSpan mempty === Nothing- Area.lastSpan (read "[3:4-7:2]") === Just (read "3:4-7:2")- Area.lastSpan (read "[3:4-7:2,15:6-17:9]") === Just (read "15:6-17:9")+ specify "lastSpan" $ hedgehog do+ Area.lastSpan mempty === Nothing+ Area.lastSpan (read "[3:4-7:2]") === Just (read "3:4-7:2")+ Area.lastSpan (read "[3:4-7:2,15:6-17:9]") === Just (read "15:6-17:9") - specify "start" $ hedgehog do- Area.start mempty === Nothing- Area.start (read "[3:4-7:2]") === Just (read "3:4")- Area.start (read "[3:4-7:2,15:6-17:9]") === Just (read "3:4")+ specify "start" $ hedgehog do+ Area.start mempty === Nothing+ Area.start (read "[3:4-7:2]") === Just (read "3:4")+ Area.start (read "[3:4-7:2,15:6-17:9]") === Just (read "3:4") - specify "end" $ hedgehog do- Area.end mempty === Nothing- Area.end (read "[3:4-7:2]") === Just (read "7:2")- Area.end (read "[3:4-7:2,15:6-17:9]") === Just (read "17:9")+ specify "end" $ hedgehog do+ Area.end mempty === Nothing+ Area.end (read "[3:4-7:2]") === Just (read "7:2")+ Area.end (read "[3:4-7:2,15:6-17:9]") === Just (read "17:9") - specify "addition examples" $ hedgehog do- read "[1:1-1:2]" Area.+ mempty === read "[1:1-1:2]"- read "[1:1-1:2]" Area.+ read "[1:2-1:3]" === read "[1:1-1:3]"- read "[1:1-1:2]" Area.+ read "[1:1-3:1]" === read "[1:1-3:1]"- read "[1:1-1:2]" Area.+ read "[1:1-11:1]" === read "[1:1-11:1]"- read "[1:1-3:1,6:1-6:2]" Area.+ read "[1:1-6:1]" === read "[1:1-6:2]"- read "[1:1-3:1]" Area.+ read "[5:1-6:2]" === read "[1:1-3:1,5:1-6:2]"+ specify "addition examples" $ hedgehog do+ read "[1:1-1:2]" Area.+ mempty === read "[1:1-1:2]"+ read "[1:1-1:2]" Area.+ read "[1:2-1:3]" === read "[1:1-1:3]"+ read "[1:1-1:2]" Area.+ read "[1:1-3:1]" === read "[1:1-3:1]"+ read "[1:1-1:2]" Area.+ read "[1:1-11:1]" === read "[1:1-11:1]"+ read "[1:1-3:1,6:1-6:2]" Area.+ read "[1:1-6:1]" === read "[1:1-6:2]"+ read "[1:1-3:1]" Area.+ read "[5:1-6:2]" === read "[1:1-3:1,5:1-6:2]" - specify "addSpan examples" $ hedgehog do- Area.addSpan (read "1:1-6:1") (read "[1:1-3:1,6:1-6:2]") === read "[1:1-6:2]"+ specify "addSpan examples" $ hedgehog do+ Area.addSpan (read "1:1-6:1") (read "[1:1-3:1,6:1-6:2]") === read "[1:1-6:2]"