-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

-- | Ranges are half-open.
module Util.Ranges (
    Ranges, extract, extract1, pair_map
    , ranges, sorted_ranges, merge_sorted, range, point, everything, nothing
    , overlapping, overlapping_closed, intersection, invert
) where
import qualified Control.DeepSeq as DeepSeq
import qualified Data.List as List

import qualified Util.Pretty as Pretty
import qualified Util.Seq as Seq


data Ranges n = Ranges [(n, n)] | Everything
    deriving (Ranges n -> Ranges n -> Bool
(Ranges n -> Ranges n -> Bool)
-> (Ranges n -> Ranges n -> Bool) -> Eq (Ranges n)
forall n. Eq n => Ranges n -> Ranges n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ranges n -> Ranges n -> Bool
$c/= :: forall n. Eq n => Ranges n -> Ranges n -> Bool
== :: Ranges n -> Ranges n -> Bool
$c== :: forall n. Eq n => Ranges n -> Ranges n -> Bool
Eq, Int -> Ranges n -> ShowS
[Ranges n] -> ShowS
Ranges n -> String
(Int -> Ranges n -> ShowS)
-> (Ranges n -> String) -> ([Ranges n] -> ShowS) -> Show (Ranges n)
forall n. Show n => Int -> Ranges n -> ShowS
forall n. Show n => [Ranges n] -> ShowS
forall n. Show n => Ranges n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ranges n] -> ShowS
$cshowList :: forall n. Show n => [Ranges n] -> ShowS
show :: Ranges n -> String
$cshow :: forall n. Show n => Ranges n -> String
showsPrec :: Int -> Ranges n -> ShowS
$cshowsPrec :: forall n. Show n => Int -> Ranges n -> ShowS
Show)

instance Ord n => Semigroup (Ranges n) where
    Ranges n
Everything <> :: Ranges n -> Ranges n -> Ranges n
<> Ranges n
_ = Ranges n
forall n. Ranges n
Everything
    Ranges n
_ <> Ranges n
Everything = Ranges n
forall n. Ranges n
Everything
    Ranges [(n, n)]
r1 <> Ranges [(n, n)]
r2 = [(n, n)] -> Ranges n
forall n. [(n, n)] -> Ranges n
Ranges ([(n, n)] -> [(n, n)] -> [(n, n)]
forall n. Ord n => [(n, n)] -> [(n, n)] -> [(n, n)]
merge [(n, n)]
r1 [(n, n)]
r2)

instance Ord n => Monoid (Ranges n) where
    mempty :: Ranges n
mempty = [(n, n)] -> Ranges n
forall n. [(n, n)] -> Ranges n
Ranges []
    mappend :: Ranges n -> Ranges n -> Ranges n
mappend = Ranges n -> Ranges n -> Ranges n
forall a. Semigroup a => a -> a -> a
(<>)

instance Pretty.Pretty n => Pretty.Pretty (Ranges n) where
    format :: Ranges n -> Doc
format (Ranges [(n, n)]
rs) = [Text] -> Doc
Pretty.textList (((n, n) -> Text) -> [(n, n)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (n, n) -> Text
forall {a} {a}. (Pretty a, Pretty a) => (a, a) -> Text
f [(n, n)]
rs)
        where f :: (a, a) -> Text
f (a
s, a
e) = a -> Text
forall a. Pretty a => a -> Text
Pretty.pretty a
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"--" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. Pretty a => a -> Text
Pretty.pretty a
e
    format Ranges n
Everything = Text -> Doc
Pretty.text Text
"[*--*]"

instance DeepSeq.NFData n => DeepSeq.NFData (Ranges n) where
    rnf :: Ranges n -> ()
rnf Ranges n
Everything = ()
    rnf (Ranges [(n, n)]
xs) = [(n, n)] -> ()
forall a. NFData a => a -> ()
DeepSeq.rnf [(n, n)]
xs

-- | Nothing means an everything range.
extract :: Ranges n -> Maybe [(n, n)]
extract :: forall n. Ranges n -> Maybe [(n, n)]
extract (Ranges [(n, n)]
pairs) = [(n, n)] -> Maybe [(n, n)]
forall a. a -> Maybe a
Just [(n, n)]
pairs
extract Ranges n
Everything = Maybe [(n, n)]
forall a. Maybe a
Nothing

-- | Nothing means no ranges, Just Nothing means Everything.
extract1 :: Ranges n -> Maybe (Maybe (n, n))
extract1 :: forall n. Ranges n -> Maybe (Maybe (n, n))
extract1 (Ranges [(n, n)]
pairs) = case ([(n, n)] -> Maybe (n, n)
forall a. [a] -> Maybe a
Seq.head [(n, n)]
pairs, [(n, n)] -> Maybe (n, n)
forall a. [a] -> Maybe a
Seq.last [(n, n)]
pairs) of
    (Just (n
s, n
_), Just (n
_, n
e)) -> Maybe (n, n) -> Maybe (Maybe (n, n))
forall a. a -> Maybe a
Just (Maybe (n, n) -> Maybe (Maybe (n, n)))
-> Maybe (n, n) -> Maybe (Maybe (n, n))
forall a b. (a -> b) -> a -> b
$ (n, n) -> Maybe (n, n)
forall a. a -> Maybe a
Just (n
s, n
e)
    (Maybe (n, n), Maybe (n, n))
_ -> Maybe (Maybe (n, n))
forall a. Maybe a
Nothing
extract1 Ranges n
Everything = Maybe (n, n) -> Maybe (Maybe (n, n))
forall a. a -> Maybe a
Just Maybe (n, n)
forall a. Maybe a
Nothing

pair_map :: Ord b => ((a, a) -> (b, b)) -> Ranges a -> Ranges b
pair_map :: forall b a. Ord b => ((a, a) -> (b, b)) -> Ranges a -> Ranges b
pair_map (a, a) -> (b, b)
f Ranges a
r = case Ranges a -> Maybe [(a, a)]
forall n. Ranges n -> Maybe [(n, n)]
extract Ranges a
r of
    Maybe [(a, a)]
Nothing -> Ranges b
forall n. Ranges n
everything
    Just [(a, a)]
pairs -> [(b, b)] -> Ranges b
forall n. Ord n => [(n, n)] -> Ranges n
sorted_ranges (((a, a) -> (b, b)) -> [(a, a)] -> [(b, b)]
forall a b. (a -> b) -> [a] -> [b]
map (a, a) -> (b, b)
f [(a, a)]
pairs)

-- * constructors

-- | This doesn't ensure that, given @(s, e)@, s <= e.
ranges :: Ord n => [(n, n)] -> Ranges n
ranges :: forall n. Ord n => [(n, n)] -> Ranges n
ranges = [(n, n)] -> Ranges n
forall n. Ord n => [(n, n)] -> Ranges n
sorted_ranges ([(n, n)] -> Ranges n)
-> ([(n, n)] -> [(n, n)]) -> [(n, n)] -> Ranges n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(n, n)] -> [(n, n)]
forall a. Ord a => [a] -> [a]
List.sort

sorted_ranges :: Ord n => [(n, n)] -> Ranges n
sorted_ranges :: forall n. Ord n => [(n, n)] -> Ranges n
sorted_ranges = [(n, n)] -> Ranges n
forall n. [(n, n)] -> Ranges n
Ranges ([(n, n)] -> Ranges n)
-> ([(n, n)] -> [(n, n)]) -> [(n, n)] -> Ranges n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(n, n)] -> [(n, n)]
forall n. Ord n => [(n, n)] -> [(n, n)]
merge_sorted

merge_sorted :: Ord n => [(n, n)] -> [(n, n)]
merge_sorted :: forall n. Ord n => [(n, n)] -> [(n, n)]
merge_sorted [] = []
merge_sorted [(n, n)
x] = [(n, n)
x]
merge_sorted ((n
s1, n
e1) : (n
s2, n
e2) : [(n, n)]
rest)
    | n
e1 n -> n -> Bool
forall a. Ord a => a -> a -> Bool
>= n
e2 = [(n, n)] -> [(n, n)]
forall n. Ord n => [(n, n)] -> [(n, n)]
merge_sorted ((n
s1, n
e1) (n, n) -> [(n, n)] -> [(n, n)]
forall a. a -> [a] -> [a]
: [(n, n)]
rest)
    | n
e1 n -> n -> Bool
forall a. Ord a => a -> a -> Bool
>= n
s2 = [(n, n)] -> [(n, n)]
forall n. Ord n => [(n, n)] -> [(n, n)]
merge_sorted ((n
s1, n
e2) (n, n) -> [(n, n)] -> [(n, n)]
forall a. a -> [a] -> [a]
: [(n, n)]
rest)
    | Bool
otherwise = (n
s1, n
e1) (n, n) -> [(n, n)] -> [(n, n)]
forall a. a -> [a] -> [a]
: [(n, n)] -> [(n, n)]
forall n. Ord n => [(n, n)] -> [(n, n)]
merge_sorted ((n
s2, n
e2) (n, n) -> [(n, n)] -> [(n, n)]
forall a. a -> [a] -> [a]
: [(n, n)]
rest)

range :: n -> n -> Ranges n
range :: forall n. n -> n -> Ranges n
range n
s n
e = [(n, n)] -> Ranges n
forall n. [(n, n)] -> Ranges n
Ranges [(n
s, n
e)]

point :: n -> Ranges n
point :: forall n. n -> Ranges n
point n
p = n -> n -> Ranges n
forall n. n -> n -> Ranges n
range n
p n
p

everything :: Ranges n
everything :: forall n. Ranges n
everything = Ranges n
forall n. Ranges n
Everything

nothing :: Ranges n
nothing :: forall n. Ranges n
nothing = [(n, n)] -> Ranges n
forall n. [(n, n)] -> Ranges n
Ranges []

-- * functions

overlapping :: Ord n => Ranges n -> Ranges n -> Bool
overlapping :: forall n. Ord n => Ranges n -> Ranges n -> Bool
overlapping = Bool -> Ranges n -> Ranges n -> Bool
forall n. Ord n => Bool -> Ranges n -> Ranges n -> Bool
check_overlapping Bool
False

-- | This is like 'overlapping', except the ranges are closed instead of
-- half-open.
overlapping_closed :: Ord n => Ranges n -> Ranges n -> Bool
overlapping_closed :: forall n. Ord n => Ranges n -> Ranges n -> Bool
overlapping_closed = Bool -> Ranges n -> Ranges n -> Bool
forall n. Ord n => Bool -> Ranges n -> Ranges n -> Bool
check_overlapping Bool
True

check_overlapping :: Ord n => Bool -> Ranges n -> Ranges n -> Bool
check_overlapping :: forall n. Ord n => Bool -> Ranges n -> Ranges n -> Bool
check_overlapping Bool
_ Ranges n
Everything Ranges n
r2 = Ranges n
r2 Ranges n -> Ranges n -> Bool
forall a. Eq a => a -> a -> Bool
/= Ranges n
forall n. Ranges n
nothing
check_overlapping Bool
_ Ranges n
r1 Ranges n
Everything = Ranges n
r1 Ranges n -> Ranges n -> Bool
forall a. Eq a => a -> a -> Bool
/= Ranges n
forall n. Ranges n
nothing
check_overlapping Bool
closed (Ranges [(n, n)]
r1) (Ranges [(n, n)]
r2) = [(n, n)] -> [(n, n)] -> Bool
forall {a}. Ord a => [(a, a)] -> [(a, a)] -> Bool
go [(n, n)]
r1 [(n, n)]
r2
    where
    go :: [(a, a)] -> [(a, a)] -> Bool
go [] [(a, a)]
_ = Bool
False
    go [(a, a)]
_ [] = Bool
False
    go r1 :: [(a, a)]
r1@((a
s1, a
e1) : [(a, a)]
rest1) r2 :: [(a, a)]
r2@((a
s2, a
e2) : [(a, a)]
rest2)
        -- It's important that zero width ranges can still overlap, otherwise
        -- zero width track damage won't invalidate any caches.
        | a
s1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
s2 = Bool
True
        | a
e1 a -> a -> Bool
`lt` a
s2 = [(a, a)] -> [(a, a)] -> Bool
go [(a, a)]
rest1 [(a, a)]
r2
        | a
e2 a -> a -> Bool
`lt` a
s1 = [(a, a)] -> [(a, a)] -> Bool
go [(a, a)]
r1 [(a, a)]
rest2
        | Bool
otherwise = Bool
True
        where lt :: a -> a -> Bool
lt = if Bool
closed then a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<) else a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=)

intersection :: Ord n => Ranges n -> Ranges n -> Ranges n
intersection :: forall n. Ord n => Ranges n -> Ranges n -> Ranges n
intersection Ranges n
Everything Ranges n
r2 = Ranges n
r2
intersection Ranges n
r1 Ranges n
Everything = Ranges n
r1
intersection (Ranges [(n, n)]
r1) (Ranges [(n, n)]
r2) = [(n, n)] -> Ranges n
forall n. [(n, n)] -> Ranges n
Ranges ([(n, n)] -> [(n, n)] -> [(n, n)]
forall n. Ord n => [(n, n)] -> [(n, n)] -> [(n, n)]
go [(n, n)]
r1 [(n, n)]
r2)
    where
    go :: [(a, a)] -> [(a, a)] -> [(a, a)]
go [] [(a, a)]
_ = []
    go [(a, a)]
_ [] = []
    go r1 :: [(a, a)]
r1@((a
s1, a
e1) : [(a, a)]
rest1) r2 :: [(a, a)]
r2@((a
s2, a
e2) : [(a, a)]
rest2)
        | a
s1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
s2 = (a
s1, a -> a -> a
forall a. Ord a => a -> a -> a
min a
e1 a
e2) (a, a) -> [(a, a)] -> [(a, a)]
forall a. a -> [a] -> [a]
: [(a, a)]
rest
        | a
e1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
s2 = [(a, a)] -> [(a, a)] -> [(a, a)]
go [(a, a)]
rest1 [(a, a)]
r2
        | a
e2 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
s1 = [(a, a)] -> [(a, a)] -> [(a, a)]
go [(a, a)]
r1 [(a, a)]
rest2
        | Bool
otherwise = (a -> a -> a
forall a. Ord a => a -> a -> a
max a
s1 a
s2, a -> a -> a
forall a. Ord a => a -> a -> a
min a
e1 a
e2) (a, a) -> [(a, a)] -> [(a, a)]
forall a. a -> [a] -> [a]
: [(a, a)]
rest
        where rest :: [(a, a)]
rest = if a
e1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
e2 then [(a, a)] -> [(a, a)] -> [(a, a)]
go [(a, a)]
rest1 [(a, a)]
r2 else [(a, a)] -> [(a, a)] -> [(a, a)]
go [(a, a)]
r1 [(a, a)]
rest2

merge :: Ord n => [(n, n)] -> [(n, n)] -> [(n, n)]
merge :: forall n. Ord n => [(n, n)] -> [(n, n)] -> [(n, n)]
merge [(n, n)]
r1 [(n, n)]
r2 = [(n, n)] -> [(n, n)]
forall n. Ord n => [(n, n)] -> [(n, n)]
merge_sorted (((n, n) -> n) -> [(n, n)] -> [(n, n)] -> [(n, n)]
forall k a. Ord k => (a -> k) -> [a] -> [a] -> [a]
Seq.merge_on (n, n) -> n
forall a b. (a, b) -> a
fst [(n, n)]
r1 [(n, n)]
r2)

-- | Given a complete range, invert the ranges.
invert :: Ord n => (n, n) -> Ranges n -> Ranges n
invert :: forall n. Ord n => (n, n) -> Ranges n -> Ranges n
invert (n, n)
_ Ranges n
Everything = Ranges n
forall a. Monoid a => a
mempty
invert (n
start, n
end) (Ranges [(n, n)]
pairs) = [(n, n)] -> Ranges n
forall n. [(n, n)] -> Ranges n
Ranges ([(n, n)] -> Ranges n) -> [(n, n)] -> Ranges n
forall a b. (a -> b) -> a -> b
$ n -> [(n, n)] -> [(n, n)]
go n
start [(n, n)]
pairs
    where
    go :: n -> [(n, n)] -> [(n, n)]
go n
p ((n
s, n
e) : [(n, n)]
rs)
        | n
s n -> n -> Bool
forall a. Ord a => a -> a -> Bool
> n
p = (n
p, n
s) (n, n) -> [(n, n)] -> [(n, n)]
forall a. a -> [a] -> [a]
: n -> [(n, n)] -> [(n, n)]
go n
e [(n, n)]
rs
        | Bool
otherwise = n -> [(n, n)] -> [(n, n)]
go n
e [(n, n)]
rs
    go n
p [] = if n
p n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
end then [(n
p, n
end)] else []