module Data.Loc.Span
  (
    Span,

    -- * Constructing
    fromTo, fromToMay,

    -- * Querying
    start, end,

    -- * Calculations
    lines,
    overlapping, linesOverlapping, touching,
    join, joinAsc,
    (+), (-),

    -- * Show and Read
    spanShowsPrec, spanReadPrec,
  )
  where

import Data.Loc.Internal.Prelude

import Data.Loc.Exception (LocException (..))
import Data.Loc.List.OneToTwo (OneToTwo)
import Data.Loc.List.ZeroToTwo (ZeroToTwo)
import Data.Loc.Loc (Loc, locReadPrec, locShowsPrec)
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 '-'.

-}
data Span = Span
  { Span -> Loc
start :: Loc
  , Span -> Loc
end   :: Loc
  } deriving (Typeable Span
Span -> DataType
Span -> Constr
(forall b. Data b => b -> b) -> Span -> Span
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) -> Span -> u
forall u. (forall d. Data d => d -> u) -> Span -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Span -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Span -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Span -> m Span
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Span -> m Span
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Span
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Span -> c Span
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Span)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Span)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Span -> m Span
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Span -> m Span
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Span -> m Span
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Span -> m Span
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Span -> m Span
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Span -> m Span
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Span -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Span -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Span -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Span -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Span -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Span -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Span -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Span -> r
gmapT :: (forall b. Data b => b -> b) -> Span -> Span
$cgmapT :: (forall b. Data b => b -> b) -> Span -> Span
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Span)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Span)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Span)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Span)
dataTypeOf :: Span -> DataType
$cdataTypeOf :: Span -> DataType
toConstr :: Span -> Constr
$ctoConstr :: Span -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Span
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Span
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Span -> c Span
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Span -> c Span
Data, Span -> Span -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Span -> Span -> Bool
$c/= :: Span -> Span -> Bool
== :: Span -> Span -> Bool
$c== :: Span -> Span -> Bool
Eq, Eq Span
Span -> Span -> Bool
Span -> Span -> Ordering
Span -> Span -> Span
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 :: Span -> Span -> Span
$cmin :: Span -> Span -> Span
max :: Span -> Span -> Span
$cmax :: Span -> Span -> Span
>= :: Span -> Span -> Bool
$c>= :: Span -> Span -> Bool
> :: Span -> Span -> Bool
$c> :: Span -> Span -> Bool
<= :: Span -> Span -> Bool
$c<= :: Span -> Span -> Bool
< :: Span -> Span -> Bool
$c< :: Span -> Span -> Bool
compare :: Span -> Span -> Ordering
$ccompare :: Span -> Span -> Ordering
Ord)

-- | 'showsPrec' = 'spanShowsPrec'
instance Show Span
  where

    showsPrec :: Int -> Span -> ShowS
showsPrec = Int -> Span -> ShowS
spanShowsPrec

-- | 'readPrec' = 'spanReadPrec'
instance Read Span
  where

    readPrec :: ReadPrec Span
readPrec = ReadPrec Span
spanReadPrec


{- |

>>> spanShowsPrec minPrec (fromTo (read "3:14") (read "6:5")) ""
"3:14-6:5"

-}
spanShowsPrec :: Int -> Span -> ShowS
spanShowsPrec :: Int -> Span -> ShowS
spanShowsPrec Int
_ (Span Loc
a Loc
b) =
  Int -> Loc -> ShowS
locShowsPrec Int
10 Loc
a forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  String -> ShowS
showString String
"-" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Int -> Loc -> ShowS
locShowsPrec Int
10 Loc
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 :: ReadPrec Span
spanReadPrec =
  ReadPrec Loc
locReadPrec      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Loc
a ->
  Char -> ReadPrec ()
readPrecChar Char
'-' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
  ReadPrec Loc
locReadPrec      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Loc
b ->
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (f :: * -> *) a. Alternative f => f a
empty forall (f :: * -> *) a. Applicative f => a -> f a
pure (Loc -> Loc -> Maybe Span
fromToMay Loc
a Loc
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 :: Loc -> Loc -> Span
fromTo Loc
a Loc
b =
  forall a. a -> Maybe a -> a
fromMaybe (forall a e. Exception e => e -> a
throw LocException
EmptySpan) (Loc -> Loc -> Maybe Span
fromToMay Loc
a Loc
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./
-}
fromToMay :: Loc -> Loc -> Maybe Span
fromToMay :: Loc -> Loc -> Maybe Span
fromToMay Loc
a Loc
b =
  case forall a. Ord a => a -> a -> Ordering
compare Loc
a Loc
b of
    Ordering
LT -> forall a. a -> Maybe a
Just (Loc -> Loc -> Span
Span Loc
a Loc
b)
    Ordering
GT -> forall a. a -> Maybe a
Just (Loc -> Loc -> Span
Span Loc
b Loc
a)
    Ordering
EQ -> forall a. Maybe a
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]

-}
lines :: Span -> NonEmpty Line
lines :: Span -> NonEmpty Line
lines Span
s =
  forall a. [a] -> NonEmpty a
NonEmpty.fromList [Loc -> Line
Loc.line (Span -> Loc
start Span
s) .. Loc -> Line
Loc.line (Span -> Loc
end Span
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

-}
overlapping :: Span -> Span -> Bool
overlapping :: Span -> Span -> Bool
overlapping Span
a Span
b =
  Bool -> Bool
not (Span -> Loc
end Span
a forall a. Ord a => a -> a -> Bool
<= Span -> Loc
start Span
b Bool -> Bool -> Bool
|| Span -> Loc
end Span
b forall a. Ord a => a -> a -> Bool
<= Span -> Loc
start Span
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

-}
linesOverlapping :: Span -> Span -> Bool
linesOverlapping :: Span -> Span -> Bool
linesOverlapping Span
a Span
b =
  Bool -> Bool
not forall a b. (a -> b) -> a -> b
$
    (Loc -> Line
Loc.line forall b c a. (b -> c) -> (a -> b) -> a -> c
. Span -> Loc
end) Span
a forall a. Ord a => a -> a -> Bool
< (Loc -> Line
Loc.line forall b c a. (b -> c) -> (a -> b) -> a -> c
. Span -> Loc
start) Span
b Bool -> Bool -> Bool
||
    (Loc -> Line
Loc.line forall b c a. (b -> c) -> (a -> b) -> a -> c
. Span -> Loc
end) Span
b forall a. Ord a => a -> a -> Bool
< (Loc -> Line
Loc.line forall b c a. (b -> c) -> (a -> b) -> a -> c
. Span -> Loc
start) Span
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 :: Span -> Span -> Bool
touching Span
a Span
b =
  Bool -> Bool
not (Span -> Loc
end Span
a forall a. Ord a => a -> a -> Bool
< Span -> Loc
start Span
b Bool -> Bool -> Bool
|| Span -> Loc
end Span
b forall a. Ord a => a -> a -> Bool
< Span -> Loc
start Span
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 :: Span -> Span -> Span
join :: Span -> Span -> Span
join Span
a Span
b =
  Loc -> Loc -> Span
Span (forall a. Ord a => a -> a -> a
min (Span -> Loc
start Span
a) (Span -> Loc
start Span
b))
       (forall a. Ord a => a -> a -> a
max (Span -> Loc
end   Span
a) (Span -> Loc
end   Span
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
Span
a + :: Span -> Span -> OneToTwo Span
+ Span
b
  | Span -> Span -> Bool
touching Span
a Span
b = forall a. a -> OneToTwo a
OneToTwo.One (Span -> Span -> Span
join Span
a Span
b)
  | Bool
otherwise    = forall a. a -> a -> OneToTwo a
OneToTwo.Two Span
a Span
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
Span
a - :: Span -> Span -> ZeroToTwo Span
- Span
b

    -- [   a   ]   [   b   ]
  | Bool -> Bool
not (Span -> Span -> Bool
overlapping Span
a Span
b) =
      forall a. a -> ZeroToTwo a
ZeroToTwo.One Span
a

    -- [   a   ]
    --   [ b ]
  | Span -> Loc
start Span
b forall a. Ord a => a -> a -> Bool
> Span -> Loc
start Span
a Bool -> Bool -> Bool
&& Span -> Loc
end Span
b forall a. Ord a => a -> a -> Bool
< Span -> Loc
end Span
a =
      forall a. a -> a -> ZeroToTwo a
ZeroToTwo.Two (Loc -> Loc -> Span
Span (Span -> Loc
start Span
a) (Span -> Loc
start Span
b))
                    (Loc -> Loc -> Span
Span (Span -> Loc
end Span
b) (Span -> Loc
end Span
a))

    --    [   a   ]
    -- [   b    ]
  | Span -> Loc
start Span
b forall a. Ord a => a -> a -> Bool
<= Span -> Loc
start Span
a Bool -> Bool -> Bool
&& Span -> Loc
end Span
b forall a. Ord a => a -> a -> Bool
< Span -> Loc
end Span
a =
      forall a. a -> ZeroToTwo a
ZeroToTwo.One (Loc -> Loc -> Span
Span (Span -> Loc
end Span
b) (Span -> Loc
end Span
a))

    -- [   a   ]
    --    [   b   ]
  | Span -> Loc
start Span
b forall a. Ord a => a -> a -> Bool
> Span -> Loc
start Span
a Bool -> Bool -> Bool
&& Span -> Loc
end Span
b forall a. Ord a => a -> a -> Bool
>= Span -> Loc
end Span
a =
      forall a. a -> ZeroToTwo a
ZeroToTwo.One (Loc -> Loc -> Span
Span (Span -> Loc
start Span
a) (Span -> Loc
start Span
b))

  | Bool
otherwise =
      forall a. ZeroToTwo a
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]
joinAsc :: [Span] -> [Span]
joinAsc =
  \case
    Span
x:Span
y:[Span]
zs ->
      let (Maybe Span
r, Span
s) = forall a. OneToTwo a -> (Maybe a, a)
OneToTwo.toTuple' (Span
x Span -> Span -> OneToTwo Span
+ Span
y)
      in  forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Maybe Span
r forall a. Semigroup a => a -> a -> a
<> [Span] -> [Span]
joinAsc (Span
sforall a. a -> [a] -> [a]
:[Span]
zs)
    [Span]
xs -> [Span]
xs