{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE MonoLocalBinds    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections     #-}

module HaskellWorks.Data.Network.Ip.Range where

import Data.List                             (unfoldr)
import GHC.Generics
import HaskellWorks.Data.Network.Ip.SafeEnum
import Prelude                               hiding (last)

import qualified Text.Appar.String as AP

data Range a = Range
  { Range a -> a
first :: a
  , Range a -> a
last  :: a
  } deriving (Range a -> Range a -> Bool
(Range a -> Range a -> Bool)
-> (Range a -> Range a -> Bool) -> Eq (Range a)
forall a. Eq a => Range a -> Range a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Range a -> Range a -> Bool
$c/= :: forall a. Eq a => Range a -> Range a -> Bool
== :: Range a -> Range a -> Bool
$c== :: forall a. Eq a => Range a -> Range a -> Bool
Eq, Eq (Range a)
Eq (Range a)
-> (Range a -> Range a -> Ordering)
-> (Range a -> Range a -> Bool)
-> (Range a -> Range a -> Bool)
-> (Range a -> Range a -> Bool)
-> (Range a -> Range a -> Bool)
-> (Range a -> Range a -> Range a)
-> (Range a -> Range a -> Range a)
-> Ord (Range a)
Range a -> Range a -> Bool
Range a -> Range a -> Ordering
Range a -> Range a -> Range a
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
forall a. Ord a => Eq (Range a)
forall a. Ord a => Range a -> Range a -> Bool
forall a. Ord a => Range a -> Range a -> Ordering
forall a. Ord a => Range a -> Range a -> Range a
min :: Range a -> Range a -> Range a
$cmin :: forall a. Ord a => Range a -> Range a -> Range a
max :: Range a -> Range a -> Range a
$cmax :: forall a. Ord a => Range a -> Range a -> Range a
>= :: Range a -> Range a -> Bool
$c>= :: forall a. Ord a => Range a -> Range a -> Bool
> :: Range a -> Range a -> Bool
$c> :: forall a. Ord a => Range a -> Range a -> Bool
<= :: Range a -> Range a -> Bool
$c<= :: forall a. Ord a => Range a -> Range a -> Bool
< :: Range a -> Range a -> Bool
$c< :: forall a. Ord a => Range a -> Range a -> Bool
compare :: Range a -> Range a -> Ordering
$ccompare :: forall a. Ord a => Range a -> Range a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Range a)
Ord, Int -> Range a -> ShowS
[Range a] -> ShowS
Range a -> String
(Int -> Range a -> ShowS)
-> (Range a -> String) -> ([Range a] -> ShowS) -> Show (Range a)
forall a. Show a => Int -> Range a -> ShowS
forall a. Show a => [Range a] -> ShowS
forall a. Show a => Range a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Range a] -> ShowS
$cshowList :: forall a. Show a => [Range a] -> ShowS
show :: Range a -> String
$cshow :: forall a. Show a => Range a -> String
showsPrec :: Int -> Range a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Range a -> ShowS
Show, (forall x. Range a -> Rep (Range a) x)
-> (forall x. Rep (Range a) x -> Range a) -> Generic (Range a)
forall x. Rep (Range a) x -> Range a
forall x. Range a -> Rep (Range a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Range a) x -> Range a
forall a x. Range a -> Rep (Range a) x
$cto :: forall a x. Rep (Range a) x -> Range a
$cfrom :: forall a x. Range a -> Rep (Range a) x
Generic)

parseRange :: AP.Parser a -> AP.Parser (Range a)
parseRange :: Parser a -> Parser (Range a)
parseRange Parser a
pa = a -> a -> Range a
forall a. a -> a -> Range a
Range (a -> a -> Range a) -> Parser a -> MkParser String (a -> Range a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
pa MkParser String (a -> Range a)
-> MkParser String String -> MkParser String (a -> Range a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> MkParser String String
forall inp. Input inp => String -> MkParser inp String
AP.string String
" - " MkParser String (a -> Range a) -> Parser a -> Parser (Range a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
pa

-- | Merge adjacent ranges if they overlap or are adjacent
mergeRanges :: (SafeEnum a, Ord a) => [Range a] -> [Range a]
mergeRanges :: [Range a] -> [Range a]
mergeRanges (r1 :: Range a
r1@(Range a
f1 a
l1):r2 :: Range a
r2@(Range a
f2 a
l2):[Range a]
rs)
  | a -> a
forall a. SafeEnum a => a -> a
boundedSucc a
l1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
f2  = [Range a] -> [Range a]
forall a. (SafeEnum a, Ord a) => [Range a] -> [Range a]
mergeRanges (Range a
nrRange a -> [Range a] -> [Range a]
forall a. a -> [a] -> [a]
:[Range a]
rs)
  | Bool
otherwise = Range a
r1 Range a -> [Range a] -> [Range a]
forall a. a -> [a] -> [a]
: [Range a] -> [Range a]
forall a. (SafeEnum a, Ord a) => [Range a] -> [Range a]
mergeRanges (Range a
r2Range a -> [Range a] -> [Range a]
forall a. a -> [a] -> [a]
:[Range a]
rs)
  where nr :: Range a
nr = a -> a -> Range a
forall a. a -> a -> Range a
Range a
f1 (a -> a -> a
forall a. Ord a => a -> a -> a
max a
l1 a
l2)
mergeRanges [Range a
r] = [Range a
r]
mergeRanges [] = []

class Contains a where
  -- | 'left' contains 'right', with the possibility of one or both of the boundaries being the same.
  contains :: a -> a -> Bool

instance Ord a => Contains (Range a) where
  contains :: Range a -> Range a -> Bool
contains Range a
l Range a
r = Range a -> a
forall a. Range a -> a
first Range a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= Range a -> a
forall a. Range a -> a
first Range a
r Bool -> Bool -> Bool
&& Range a -> a
forall a. Range a -> a
last Range a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= Range a -> a
forall a. Range a -> a
last Range a
r

rangeToList :: (SafeEnum a, Ord a) => Range a -> [a]
rangeToList :: Range a -> [a]
rangeToList (Range a
a a
b) = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
b) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> Maybe (a, a)) -> a -> [a]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (\a
x -> (a
x,) (a -> (a, a)) -> Maybe a -> Maybe (a, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Maybe a
forall a. SafeEnum a => a -> Maybe a
safeSucc a
x) a
a