module Data.Loc.Area
  ( Area,

    -- * Constructing
    fromTo,
    spanArea,

    -- * Combining
    (+),
    (-),
    addSpan,

    -- * Querying
    firstSpan,
    lastSpan,
    start,
    end,
    areaSpan,
    spansAsc,
    spanCount,

    -- * Show and Read
    areaShowsPrec,
    areaReadPrec,
  )
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 Data.Loc.Span qualified as Span
import Data.Set qualified as Set

data Terminus = Start | End
  deriving (Terminus -> Terminus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Terminus -> Terminus -> Bool
$c/= :: Terminus -> Terminus -> Bool
== :: Terminus -> Terminus -> Bool
$c== :: Terminus -> Terminus -> Bool
Eq, Eq Terminus
Terminus -> Terminus -> Bool
Terminus -> Terminus -> Ordering
Terminus -> Terminus -> Terminus
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Terminus -> Terminus -> Terminus
$cmin :: Terminus -> Terminus -> Terminus
max :: Terminus -> Terminus -> Terminus
$cmax :: Terminus -> Terminus -> Terminus
>= :: Terminus -> Terminus -> Bool
$c>= :: Terminus -> Terminus -> Bool
> :: Terminus -> Terminus -> Bool
$c> :: Terminus -> Terminus -> Bool
<= :: Terminus -> Terminus -> Bool
$c<= :: Terminus -> Terminus -> Bool
< :: Terminus -> Terminus -> Bool
$c< :: Terminus -> Terminus -> Bool
compare :: Terminus -> Terminus -> Ordering
$ccompare :: Terminus -> Terminus -> Ordering
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 (Area -> Area -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Area -> Area -> Bool
$c/= :: Area -> Area -> Bool
== :: Area -> Area -> Bool
$c== :: Area -> Area -> Bool
Eq, Eq Area
Area -> Area -> Bool
Area -> Area -> Ordering
Area -> Area -> Area
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Area -> Area -> Area
$cmin :: Area -> Area -> Area
max :: Area -> Area -> Area
$cmax :: Area -> Area -> Area
>= :: Area -> Area -> Bool
$c>= :: Area -> Area -> Bool
> :: Area -> Area -> Bool
$c> :: Area -> Area -> Bool
<= :: Area -> Area -> Bool
$c<= :: Area -> Area -> Bool
< :: Area -> Area -> Bool
$c< :: Area -> Area -> Bool
compare :: Area -> Area -> Ordering
$ccompare :: Area -> Area -> Ordering
Ord)

-- | 'showsPrec' = 'areaShowsPrec'
instance Show Area where
  showsPrec :: Int -> Area -> ShowS
showsPrec = Int -> Area -> ShowS
areaShowsPrec

-- | 'readPrec' = 'areaReadPrec'
instance Read Area where
  readPrec :: ReadPrec Area
readPrec = ReadPrec Area
areaReadPrec

instance Monoid Area where
  mempty :: Area
mempty = Map Loc Terminus -> Area
Area forall k a. Map k a
Map.empty

-- | '<>' = '+'
instance Semigroup Area where
  <> :: Area -> Area -> Area
(<>) = Area -> Area -> Area
(+)

areaShowsPrec :: Int -> Area -> ShowS
areaShowsPrec :: Int -> Area -> ShowS
areaShowsPrec Int
_ Area
a =
  forall a. Show a => [a] -> ShowS
showList (Area -> [Span]
spansAsc Area
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]"
-- []
areaReadPrec :: ReadPrec Area
areaReadPrec :: ReadPrec Area
areaReadPrec =
  forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Span -> Area
spanArea forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Read a => ReadPrec [a]
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 ::
  -- | Start
  Loc ->
  -- | End
  Loc ->
  Area
fromTo :: Loc -> Loc -> Area
fromTo Loc
a Loc
b
  | Loc
a forall a. Eq a => a -> a -> Bool
== Loc
b = forall a. Monoid a => a
mempty
  | Bool
otherwise = Span -> Area
spanArea (Loc -> Loc -> Span
Span.fromTo Loc
a Loc
b)

-- | Construct an 'Area' consisting of a single 'Span'
--
-- >>> spanArea (read "4:5-6:3")
-- [4:5-6:3]
spanArea :: Span -> Area
spanArea :: Span -> Area
spanArea Span
s = Map Loc Terminus -> Area
Area (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Loc, Terminus)]
locs)
  where
    locs :: [(Loc, Terminus)]
locs =
      [ (Span -> Loc
Span.start Span
s, Terminus
Start),
        (Span -> Loc
Span.end Span
s, Terminus
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 :: Area -> Maybe Span
areaSpan Area
x =
  Area -> Maybe Loc
start Area
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Loc
a ->
    Area -> Maybe Loc
end Area
x forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Loc
b ->
      Loc -> Loc -> Span
Span.fromTo Loc
a Loc
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 -> [Span]
spansAsc (Area Map Loc Terminus
m) =
  forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL Maybe Loc -> Loc -> (Maybe Loc, Maybe Span)
f forall a. Maybe a
Nothing (forall k a. Map k a -> [k]
Map.keys Map Loc Terminus
m) forall a b. a -> (a -> b) -> b
& forall a b. (a, b) -> b
snd forall a b. a -> (a -> b) -> b
& forall a. [Maybe a] -> [a]
catMaybes
  where
    f :: Maybe Loc -> Loc -> (Maybe Loc, Maybe Span)
f Maybe Loc
Nothing Loc
l = (forall a. a -> Maybe a
Just Loc
l, forall a. Maybe a
Nothing)
    f (Just Loc
l) Loc
l' = (forall a. Maybe a
Nothing, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Loc -> Loc -> Span
Span.fromTo Loc
l Loc
l')

-- |
--
-- >>> 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 -> Natural
spanCount (Area Map Loc Terminus
locs) =
  forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
Foldable.length Map Loc Terminus
locs forall a. Integral a => a -> a -> a
`div` Int
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 -> Maybe Span
firstSpan (Area Map Loc Terminus
m) =
  case forall a. Set a -> [a]
Set.toAscList (forall k a. Map k a -> Set k
Map.keysSet Map Loc Terminus
m) of
    Loc
a : Loc
b : [Loc]
_ -> forall a. a -> Maybe a
Just (Loc -> Loc -> Span
Span.fromTo Loc
a Loc
b)
    [Loc]
_ -> forall a. Maybe a
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 -> Maybe Span
lastSpan (Area Map Loc Terminus
m) =
  case forall a. Set a -> [a]
Set.toDescList (forall k a. Map k a -> Set k
Map.keysSet Map Loc Terminus
m) of
    Loc
b : Loc
a : [Loc]
_ -> forall a. a -> Maybe a
Just (Loc -> Loc -> Span
Span.fromTo Loc
a Loc
b)
    [Loc]
_ -> forall a. Maybe a
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 -> Maybe Loc
start (Area Map Loc Terminus
m) =
  case forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.minViewWithKey Map Loc Terminus
m of
    Just ((Loc
l, Terminus
_), Map Loc Terminus
_) -> forall a. a -> Maybe a
Just Loc
l
    Maybe ((Loc, Terminus), Map Loc Terminus)
Nothing -> forall a. Maybe a
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 -> Maybe Loc
end (Area Map Loc Terminus
locs) =
  case forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.maxViewWithKey Map Loc Terminus
locs of
    Just ((Loc
l, Terminus
_), Map Loc Terminus
_) -> forall a. a -> Maybe a
Just Loc
l
    Maybe ((Loc, Terminus), Map Loc Terminus)
Nothing -> forall a. Maybe a
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
Area
a + :: Area -> Area -> Area
+ Area
b
  | Area -> Natural
spanCount Area
a forall a. Ord a => a -> a -> Bool
>= Area -> Natural
spanCount Area
b = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Span -> Area -> Area
addSpan Area
a (Area -> [Span]
spansAsc Area
b)
  | Bool
otherwise = Area
b Area -> Area -> Area
+ Area
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 :: Span -> Area -> Area
addSpan Span
b (Area Map Loc Terminus
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

      (Map Loc Terminus
unmodifiedSpansBelow, Maybe Loc
startBelow) =
        let below :: Map Loc Terminus
below = forall k a. Ord k => k -> Map k a -> Map k a
Map.below (Span -> Loc
Span.start Span
b) Map Loc Terminus
as
         in case forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.maxViewWithKey Map Loc Terminus
below of
              Just ((Loc
l, Terminus
Start), Map Loc Terminus
xs) -> (Map Loc Terminus
xs, forall a. a -> Maybe a
Just Loc
l)
              Maybe ((Loc, Terminus), Map Loc Terminus)
_ -> (Map Loc Terminus
below, forall a. Maybe a
Nothing)

      (Map Loc Terminus
unmodifiedSpansAbove, Maybe Loc
endAbove) =
        let above :: Map Loc Terminus
above = forall k a. Ord k => k -> Map k a -> Map k a
Map.above (Span -> Loc
Span.end Span
b) Map Loc Terminus
as
         in case forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.minViewWithKey Map Loc Terminus
above of
              Just ((Loc
l, Terminus
End), Map Loc Terminus
xs) -> (Map Loc Terminus
xs, forall a. a -> Maybe a
Just Loc
l)
              Maybe ((Loc, Terminus), Map Loc Terminus)
_ -> (Map Loc Terminus
above, forall a. Maybe a
Nothing)

      middle :: Map Loc Terminus
middle =
        forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          [ (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Maybe Loc
startBelow forall a. Semigroup a => a -> a -> a
<> [Span -> Loc
Span.start Span
b], Terminus
Start),
            (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Maybe Loc
endAbove forall a. Semigroup a => a -> a -> a
<> [Span -> Loc
Span.end Span
b], Terminus
End)
          ]
   in Map Loc Terminus -> Area
Area forall a b. (a -> b) -> a -> b
$ Map Loc Terminus
unmodifiedSpansBelow forall a. Semigroup a => a -> a -> a
<> Map Loc Terminus
middle forall a. Semigroup a => a -> a -> a
<> Map Loc Terminus
unmodifiedSpansAbove

-- | The difference between two 'Area's
--
-- @a '-' b@ contains what is covered by @a@ and not covered by @b@.
(-) :: Area -> Area -> Area
Area
a - :: Area -> Area -> Area
- Area
b = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Span -> Area -> Area
subtractSpan Area
a (Area -> [Span]
spansAsc Area
b)

-- | @'subtractSpan' s a@ is the subset of 'Area' @a@ that is not
-- covered by 'Span' @s@
subtractSpan :: Span -> Area -> Area
subtractSpan :: Span -> Area -> Area
subtractSpan Span
b (Area Map Loc Terminus
as) =
  let Map Loc Terminus
resultBelow :: Map Loc Terminus =
        let below :: Map Loc Terminus
below = forall k a. Ord k => k -> Map k a -> Map k a
Map.belowInclusive (Span -> Loc
Span.start Span
b) Map Loc Terminus
as
         in case forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.maxViewWithKey Map Loc Terminus
below of
              Just ((Loc
l, Terminus
Start), Map Loc Terminus
xs) ->
                if Loc
l forall a. Eq a => a -> a -> Bool
== Span -> Loc
Span.start Span
b
                  then Map Loc Terminus
xs
                  else Map Loc Terminus
below forall a b. a -> (a -> b) -> b
& forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Span -> Loc
Span.start Span
b) Terminus
End
              Maybe ((Loc, Terminus), Map Loc Terminus)
_ -> Map Loc Terminus
below

      Map Loc Terminus
resultAbove :: Map Loc Terminus =
        let above :: Map Loc Terminus
above = forall k a. Ord k => k -> Map k a -> Map k a
Map.aboveInclusive (Span -> Loc
Span.end Span
b) Map Loc Terminus
as
         in case forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.minViewWithKey Map Loc Terminus
above of
              Just ((Loc
l, Terminus
End), Map Loc Terminus
xs) ->
                if Loc
l forall a. Eq a => a -> a -> Bool
== Span -> Loc
Span.end Span
b
                  then Map Loc Terminus
xs
                  else Map Loc Terminus
above forall a b. a -> (a -> b) -> b
& forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Span -> Loc
Span.end Span
b) Terminus
Start
              Maybe ((Loc, Terminus), Map Loc Terminus)
_ -> Map Loc Terminus
above
   in Map Loc Terminus -> Area
Area forall a b. (a -> b) -> a -> b
$ Map Loc Terminus
resultBelow forall a. Semigroup a => a -> a -> a
<> Map Loc Terminus
resultAbove