{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables #-}

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.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

data Terminus = Start | End
  deriving (Typeable Terminus
DataType
Constr
Typeable Terminus
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Terminus -> c Terminus)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Terminus)
-> (Terminus -> Constr)
-> (Terminus -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Terminus))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Terminus))
-> ((forall b. Data b => b -> b) -> Terminus -> Terminus)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Terminus -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Terminus -> r)
-> (forall u. (forall d. Data d => d -> u) -> Terminus -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Terminus -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Terminus -> m Terminus)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Terminus -> m Terminus)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Terminus -> m Terminus)
-> Data Terminus
Terminus -> DataType
Terminus -> Constr
(forall b. Data b => b -> b) -> Terminus -> Terminus
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Terminus -> c Terminus
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Terminus
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Terminus -> u
forall u. (forall d. Data d => d -> u) -> Terminus -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Terminus -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Terminus -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Terminus -> m Terminus
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Terminus -> m Terminus
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Terminus
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Terminus -> c Terminus
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Terminus)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Terminus)
$cEnd :: Constr
$cStart :: Constr
$tTerminus :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Terminus -> m Terminus
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Terminus -> m Terminus
gmapMp :: (forall d. Data d => d -> m d) -> Terminus -> m Terminus
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Terminus -> m Terminus
gmapM :: (forall d. Data d => d -> m d) -> Terminus -> m Terminus
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Terminus -> m Terminus
gmapQi :: Int -> (forall d. Data d => d -> u) -> Terminus -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Terminus -> u
gmapQ :: (forall d. Data d => d -> u) -> Terminus -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Terminus -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Terminus -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Terminus -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Terminus -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Terminus -> r
gmapT :: (forall b. Data b => b -> b) -> Terminus -> Terminus
$cgmapT :: (forall b. Data b => b -> b) -> Terminus -> Terminus
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Terminus)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Terminus)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Terminus)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Terminus)
dataTypeOf :: Terminus -> DataType
$cdataTypeOf :: Terminus -> DataType
toConstr :: Terminus -> Constr
$ctoConstr :: Terminus -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Terminus
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Terminus
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Terminus -> c Terminus
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Terminus -> c Terminus
$cp1Data :: Typeable Terminus
Data, Terminus -> Terminus -> Bool
(Terminus -> Terminus -> Bool)
-> (Terminus -> Terminus -> Bool) -> Eq Terminus
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
Eq Terminus
-> (Terminus -> Terminus -> Ordering)
-> (Terminus -> Terminus -> Bool)
-> (Terminus -> Terminus -> Bool)
-> (Terminus -> Terminus -> Bool)
-> (Terminus -> Terminus -> Bool)
-> (Terminus -> Terminus -> Terminus)
-> (Terminus -> Terminus -> Terminus)
-> Ord 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
$cp1Ord :: Eq Terminus
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 (Typeable Area
DataType
Constr
Typeable Area
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Area -> c Area)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Area)
-> (Area -> Constr)
-> (Area -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Area))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Area))
-> ((forall b. Data b => b -> b) -> Area -> Area)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Area -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Area -> r)
-> (forall u. (forall d. Data d => d -> u) -> Area -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Area -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Area -> m Area)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Area -> m Area)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Area -> m Area)
-> Data Area
Area -> DataType
Area -> Constr
(forall b. Data b => b -> b) -> Area -> Area
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Area -> c Area
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Area
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Area -> u
forall u. (forall d. Data d => d -> u) -> Area -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Area -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Area -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Area -> m Area
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Area -> m Area
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Area
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Area -> c Area
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Area)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Area)
$cArea :: Constr
$tArea :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Area -> m Area
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Area -> m Area
gmapMp :: (forall d. Data d => d -> m d) -> Area -> m Area
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Area -> m Area
gmapM :: (forall d. Data d => d -> m d) -> Area -> m Area
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Area -> m Area
gmapQi :: Int -> (forall d. Data d => d -> u) -> Area -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Area -> u
gmapQ :: (forall d. Data d => d -> u) -> Area -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Area -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Area -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Area -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Area -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Area -> r
gmapT :: (forall b. Data b => b -> b) -> Area -> Area
$cgmapT :: (forall b. Data b => b -> b) -> Area -> Area
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Area)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Area)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Area)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Area)
dataTypeOf :: Area -> DataType
$cdataTypeOf :: Area -> DataType
toConstr :: Area -> Constr
$ctoConstr :: Area -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Area
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Area
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Area -> c Area
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Area -> c Area
$cp1Data :: Typeable Area
Data, Area -> Area -> Bool
(Area -> Area -> Bool) -> (Area -> Area -> Bool) -> Eq Area
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
Eq Area
-> (Area -> Area -> Ordering)
-> (Area -> Area -> Bool)
-> (Area -> Area -> Bool)
-> (Area -> Area -> Bool)
-> (Area -> Area -> Bool)
-> (Area -> Area -> Area)
-> (Area -> Area -> Area)
-> Ord 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
$cp1Ord :: Eq Area
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 Map Loc Terminus
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 =
  [Span] -> ShowS
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 =
  (Span -> Area) -> [Span] -> Area
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Span -> Area
spanArea ([Span] -> Area) -> ReadPrec [Span] -> ReadPrec Area
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec [Span]
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
  :: Loc -- ^ Start
  -> Loc -- ^ End
  -> Area
fromTo :: Loc -> Loc -> Area
fromTo Loc
a Loc
b
  | Loc
a Loc -> Loc -> Bool
forall a. Eq a => a -> a -> Bool
== Loc
b    = Area
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 ([(Loc, Terminus)] -> Map Loc Terminus
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 Maybe Loc -> (Loc -> Maybe Span) -> Maybe Span
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Loc
a ->
  Area -> Maybe Loc
end Area
x   Maybe Loc -> (Loc -> Span) -> Maybe Span
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) =
    (Maybe Loc -> Loc -> (Maybe Loc, Maybe Span))
-> Maybe Loc -> [Loc] -> (Maybe Loc, [Maybe Span])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL Maybe Loc -> Loc -> (Maybe Loc, Maybe Span)
f Maybe Loc
forall a. Maybe a
Nothing (Map Loc Terminus -> [Loc]
forall k a. Map k a -> [k]
Map.keys Map Loc Terminus
m) (Maybe Loc, [Maybe Span])
-> ((Maybe Loc, [Maybe Span]) -> [Maybe Span]) -> [Maybe Span]
forall a b. a -> (a -> b) -> b
& (Maybe Loc, [Maybe Span]) -> [Maybe Span]
forall a b. (a, b) -> b
snd [Maybe Span] -> ([Maybe Span] -> [Span]) -> [Span]
forall a b. a -> (a -> b) -> b
& [Maybe Span] -> [Span]
forall a. [Maybe a] -> [a]
catMaybes
  where
    f :: Maybe Loc -> Loc -> (Maybe Loc, Maybe Span)
f Maybe Loc
Nothing  Loc
l  = (Loc -> Maybe Loc
forall a. a -> Maybe a
Just Loc
l,  Maybe Span
forall a. Maybe a
Nothing)
    f (Just Loc
l) Loc
l' = (Maybe Loc
forall a. Maybe a
Nothing, Span -> Maybe Span
forall a. a -> Maybe a
Just (Span -> Maybe Span) -> Span -> Maybe Span
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) =
  Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Map Loc Terminus -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Foldable.length Map Loc Terminus
locs Int -> Int -> Int
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 Set Loc -> [Loc]
forall a. Set a -> [a]
Set.toAscList (Map Loc Terminus -> Set Loc
forall k a. Map k a -> Set k
Map.keysSet Map Loc Terminus
m) of
    Loc
a:Loc
b:[Loc]
_ -> Span -> Maybe Span
forall a. a -> Maybe a
Just (Loc -> Loc -> Span
Span.fromTo Loc
a Loc
b)
    [Loc]
_     -> Maybe Span
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 Set Loc -> [Loc]
forall a. Set a -> [a]
Set.toDescList (Map Loc Terminus -> Set Loc
forall k a. Map k a -> Set k
Map.keysSet Map Loc Terminus
m) of
    Loc
b:Loc
a:[Loc]
_ -> Span -> Maybe Span
forall a. a -> Maybe a
Just (Loc -> Loc -> Span
Span.fromTo Loc
a Loc
b)
    [Loc]
_     -> Maybe Span
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 Map Loc Terminus -> Maybe ((Loc, Terminus), Map Loc Terminus)
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
_) -> Loc -> Maybe Loc
forall a. a -> Maybe a
Just Loc
l
    Maybe ((Loc, Terminus), Map Loc Terminus)
Nothing          -> Maybe Loc
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 Map Loc Terminus -> Maybe ((Loc, Terminus), Map Loc Terminus)
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
_) -> Loc -> Maybe Loc
forall a. a -> Maybe a
Just Loc
l
    Maybe ((Loc, Terminus), Map Loc Terminus)
Nothing          -> Maybe Loc
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 Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
>= Area -> Natural
spanCount Area
b = (Span -> Area -> Area) -> Area -> [Span] -> Area
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 = Loc -> Map Loc Terminus -> Map Loc Terminus
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 Map Loc Terminus -> Maybe ((Loc, Terminus), Map Loc Terminus)
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, Loc -> Maybe Loc
forall a. a -> Maybe a
Just Loc
l)
          Maybe ((Loc, Terminus), Map Loc Terminus)
_ -> (Map Loc Terminus
below, Maybe Loc
forall a. Maybe a
Nothing)


    (Map Loc Terminus
unmodifiedSpansAbove, Maybe Loc
endAbove) =
      let
        above :: Map Loc Terminus
above = Loc -> Map Loc Terminus -> Map Loc Terminus
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 Map Loc Terminus -> Maybe ((Loc, Terminus), Map Loc Terminus)
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, Loc -> Maybe Loc
forall a. a -> Maybe a
Just Loc
l)
          Maybe ((Loc, Terminus), Map Loc Terminus)
_ -> (Map Loc Terminus
above, Maybe Loc
forall a. Maybe a
Nothing)

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

  in
    Map Loc Terminus -> Area
Area (Map Loc Terminus -> Area) -> Map Loc Terminus -> Area
forall a b. (a -> b) -> a -> b
$ Map Loc Terminus
unmodifiedSpansBelow Map Loc Terminus -> Map Loc Terminus -> Map Loc Terminus
forall a. Semigroup a => a -> a -> a
<> Map Loc Terminus
middle Map Loc Terminus -> Map Loc Terminus -> Map Loc Terminus
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 = (Span -> Area -> Area) -> Area -> [Span] -> Area
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 = Loc -> Map Loc Terminus -> Map Loc Terminus
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 Map Loc Terminus -> Maybe ((Loc, Terminus), Map Loc Terminus)
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 Loc -> Loc -> Bool
forall a. Eq a => a -> a -> Bool
== Span -> Loc
Span.start Span
b
              then Map Loc Terminus
xs
              else Map Loc Terminus
below Map Loc Terminus
-> (Map Loc Terminus -> Map Loc Terminus) -> Map Loc Terminus
forall a b. a -> (a -> b) -> b
& Loc -> Terminus -> Map Loc Terminus -> Map Loc Terminus
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 = Loc -> Map Loc Terminus -> Map Loc Terminus
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 Map Loc Terminus -> Maybe ((Loc, Terminus), Map Loc Terminus)
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 Loc -> Loc -> Bool
forall a. Eq a => a -> a -> Bool
== Span -> Loc
Span.end Span
b
              then Map Loc Terminus
xs
              else Map Loc Terminus
above Map Loc Terminus
-> (Map Loc Terminus -> Map Loc Terminus) -> Map Loc Terminus
forall a b. a -> (a -> b) -> b
& Loc -> Terminus -> Map Loc Terminus -> Map Loc Terminus
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 (Map Loc Terminus -> Area) -> Map Loc Terminus -> Area
forall a b. (a -> b) -> a -> b
$ Map Loc Terminus
resultBelow Map Loc Terminus -> Map Loc Terminus -> Map Loc Terminus
forall a. Semigroup a => a -> a -> a
<> Map Loc Terminus
resultAbove