{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE LambdaCase #-}
module Data.Loc.Span
( Span
, fromTo
, fromToMay
, start
, end
, lines
, overlapping
, linesOverlapping
, touching
, join
, joinAsc
, (+)
, (-)
, 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
data Span = Span
{ Span -> Loc
start :: Loc
, Span -> Loc
end :: Loc
} deriving (Typeable Span
DataType
Constr
Typeable Span
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Span -> c Span)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Span)
-> (Span -> Constr)
-> (Span -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> Span -> Span)
-> (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 u. (forall d. Data d => d -> u) -> Span -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Span -> u)
-> (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 (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Span -> m Span)
-> Data Span
Span -> DataType
Span -> Constr
(forall b. Data b => b -> b) -> Span -> Span
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Span -> c Span
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cSpan :: Constr
$tSpan :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> Span -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Span -> u
gmapQ :: (forall d. Data d => d -> u) -> Span -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Span -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable Span
Data, Span -> Span -> Bool
(Span -> Span -> Bool) -> (Span -> Span -> Bool) -> Eq Span
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
Eq Span
-> (Span -> Span -> Ordering)
-> (Span -> Span -> Bool)
-> (Span -> Span -> Bool)
-> (Span -> Span -> Bool)
-> (Span -> Span -> Bool)
-> (Span -> Span -> Span)
-> (Span -> Span -> Span)
-> Ord 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
$cp1Ord :: Eq Span
Ord)
instance Show Span
where
showsPrec :: Int -> Span -> ShowS
showsPrec = Int -> Span -> ShowS
spanShowsPrec
instance Read Span
where
readPrec :: ReadPrec Span
readPrec = ReadPrec Span
spanReadPrec
spanShowsPrec :: Int -> Span -> ShowS
spanShowsPrec :: Int -> Span -> ShowS
spanShowsPrec Int
_ (Span Loc
a Loc
b) =
Int -> Loc -> ShowS
locShowsPrec Int
10 Loc
a ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> ShowS
showString String
"-" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> Loc -> ShowS
locShowsPrec Int
10 Loc
b
spanReadPrec :: ReadPrec Span
spanReadPrec :: ReadPrec Span
spanReadPrec =
ReadPrec Loc
locReadPrec ReadPrec Loc -> (Loc -> ReadPrec Span) -> ReadPrec Span
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Loc
a ->
Char -> ReadPrec ()
readPrecChar Char
'-' ReadPrec () -> ReadPrec Loc -> ReadPrec Loc
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
ReadPrec Loc
locReadPrec ReadPrec Loc -> (Loc -> ReadPrec Span) -> ReadPrec Span
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Loc
b ->
ReadPrec Span
-> (Span -> ReadPrec Span) -> Maybe Span -> ReadPrec Span
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ReadPrec Span
forall (f :: * -> *) a. Alternative f => f a
empty Span -> ReadPrec Span
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Loc -> Loc -> Maybe Span
fromToMay Loc
a Loc
b)
fromTo :: Loc -> Loc -> Span
fromTo :: Loc -> Loc -> Span
fromTo Loc
a Loc
b =
Span -> Maybe Span -> Span
forall a. a -> Maybe a -> a
fromMaybe (LocException -> Span
forall a e. Exception e => e -> a
throw LocException
EmptySpan) (Loc -> Loc -> Maybe Span
fromToMay Loc
a Loc
b)
fromToMay :: Loc -> Loc -> Maybe Span
fromToMay :: Loc -> Loc -> Maybe Span
fromToMay Loc
a Loc
b =
case Loc -> Loc -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Loc
a Loc
b of
Ordering
LT -> Span -> Maybe Span
forall a. a -> Maybe a
Just (Loc -> Loc -> Span
Span Loc
a Loc
b)
Ordering
GT -> Span -> Maybe Span
forall a. a -> Maybe a
Just (Loc -> Loc -> Span
Span Loc
b Loc
a)
Ordering
EQ -> Maybe Span
forall a. Maybe a
Nothing
lines :: Span -> NonEmpty Line
lines :: Span -> NonEmpty Line
lines Span
s =
[Line] -> NonEmpty Line
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)]
overlapping :: Span -> Span -> Bool
overlapping :: Span -> Span -> Bool
overlapping Span
a Span
b =
Bool -> Bool
not (Span -> Loc
end Span
a Loc -> Loc -> Bool
forall a. Ord a => a -> a -> Bool
<= Span -> Loc
start Span
b Bool -> Bool -> Bool
|| Span -> Loc
end Span
b Loc -> Loc -> Bool
forall a. Ord a => a -> a -> Bool
<= Span -> Loc
start Span
a)
linesOverlapping :: Span -> Span -> Bool
linesOverlapping :: Span -> Span -> Bool
linesOverlapping Span
a Span
b =
Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
(Loc -> Line
Loc.line (Loc -> Line) -> (Span -> Loc) -> Span -> Line
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Span -> Loc
end) Span
a Line -> Line -> Bool
forall a. Ord a => a -> a -> Bool
< (Loc -> Line
Loc.line (Loc -> Line) -> (Span -> Loc) -> Span -> Line
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Span -> Loc
start) Span
b Bool -> Bool -> Bool
||
(Loc -> Line
Loc.line (Loc -> Line) -> (Span -> Loc) -> Span -> Line
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Span -> Loc
end) Span
b Line -> Line -> Bool
forall a. Ord a => a -> a -> Bool
< (Loc -> Line
Loc.line (Loc -> Line) -> (Span -> Loc) -> Span -> Line
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Span -> Loc
start) Span
a
touching :: Span -> Span -> Bool
touching :: Span -> Span -> Bool
touching Span
a Span
b =
Bool -> Bool
not (Span -> Loc
end Span
a Loc -> Loc -> Bool
forall a. Ord a => a -> a -> Bool
< Span -> Loc
start Span
b Bool -> Bool -> Bool
|| Span -> Loc
end Span
b Loc -> Loc -> Bool
forall a. Ord a => a -> a -> Bool
< Span -> Loc
start Span
a)
join :: Span -> Span -> Span
join :: Span -> Span -> Span
join Span
a Span
b =
Loc -> Loc -> Span
Span (Loc -> Loc -> Loc
forall a. Ord a => a -> a -> a
min (Span -> Loc
start Span
a) (Span -> Loc
start Span
b))
(Loc -> Loc -> Loc
forall a. Ord a => a -> a -> a
max (Span -> Loc
end Span
a) (Span -> Loc
end Span
b))
(+) :: Span -> Span -> OneToTwo Span
Span
a + :: Span -> Span -> OneToTwo Span
+ Span
b
| Span -> Span -> Bool
touching Span
a Span
b = Span -> OneToTwo Span
forall a. a -> OneToTwo a
OneToTwo.One (Span -> Span -> Span
join Span
a Span
b)
| Bool
otherwise = Span -> Span -> OneToTwo Span
forall a. a -> a -> OneToTwo a
OneToTwo.Two Span
a Span
b
(-) :: Span -> Span -> ZeroToTwo Span
Span
a - :: Span -> Span -> ZeroToTwo Span
- Span
b
| Bool -> Bool
not (Span -> Span -> Bool
overlapping Span
a Span
b) =
Span -> ZeroToTwo Span
forall a. a -> ZeroToTwo a
ZeroToTwo.One Span
a
| Span -> Loc
start Span
b Loc -> Loc -> Bool
forall a. Ord a => a -> a -> Bool
> Span -> Loc
start Span
a Bool -> Bool -> Bool
&& Span -> Loc
end Span
b Loc -> Loc -> Bool
forall a. Ord a => a -> a -> Bool
< Span -> Loc
end Span
a =
Span -> Span -> ZeroToTwo Span
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))
| Span -> Loc
start Span
b Loc -> Loc -> Bool
forall a. Ord a => a -> a -> Bool
<= Span -> Loc
start Span
a Bool -> Bool -> Bool
&& Span -> Loc
end Span
b Loc -> Loc -> Bool
forall a. Ord a => a -> a -> Bool
< Span -> Loc
end Span
a =
Span -> ZeroToTwo Span
forall a. a -> ZeroToTwo a
ZeroToTwo.One (Loc -> Loc -> Span
Span (Span -> Loc
end Span
b) (Span -> Loc
end Span
a))
| Span -> Loc
start Span
b Loc -> Loc -> Bool
forall a. Ord a => a -> a -> Bool
> Span -> Loc
start Span
a Bool -> Bool -> Bool
&& Span -> Loc
end Span
b Loc -> Loc -> Bool
forall a. Ord a => a -> a -> Bool
>= Span -> Loc
end Span
a =
Span -> ZeroToTwo Span
forall a. a -> ZeroToTwo a
ZeroToTwo.One (Loc -> Loc -> Span
Span (Span -> Loc
start Span
a) (Span -> Loc
start Span
b))
| Bool
otherwise =
ZeroToTwo Span
forall a. ZeroToTwo a
ZeroToTwo.Zero
joinAsc
:: [Span]
-> [Span]
joinAsc :: [Span] -> [Span]
joinAsc =
\case
Span
x:Span
y:[Span]
zs ->
let (Maybe Span
r, Span
s) = OneToTwo Span -> (Maybe Span, Span)
forall a. OneToTwo a -> (Maybe a, a)
OneToTwo.toTuple' (Span
x Span -> Span -> OneToTwo Span
+ Span
y)
in Maybe Span -> [Span]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Maybe Span
r [Span] -> [Span] -> [Span]
forall a. Semigroup a => a -> a -> a
<> [Span] -> [Span]
joinAsc (Span
sSpan -> [Span] -> [Span]
forall a. a -> [a] -> [a]
:[Span]
zs)
[Span]
xs -> [Span]
xs