packages feed

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 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]"