{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
module Data.IP.RouteTable.Internal where
import Control.Applicative hiding (empty)
import qualified Control.Applicative as A (empty)
import Control.Monad
import Data.Bits
import Data.Foldable (Foldable(..))
import Data.IP.Addr
import Data.IP.Op
import Data.IP.Range
import Data.IntMap (IntMap, (!))
import qualified Data.IntMap as IM (fromList)
import Data.Monoid hiding ((<>))
import Data.Semigroup
import Data.Traversable
import Data.Word
import GHC.Generics (Generic, Generic1)
import Prelude hiding (lookup)
class Addr a => Routable a where
intToTBit :: Int -> a
isZero :: a -> a -> Bool
instance Routable IPv4 where
intToTBit :: Int -> IPv4
intToTBit = Int -> IPv4
intToTBitIPv4
isZero :: IPv4 -> IPv4 -> Bool
isZero IPv4
a IPv4
b = IPv4
a forall a. Addr a => a -> a -> a
`masked` IPv4
b forall a. Eq a => a -> a -> Bool
== Word32 -> IPv4
IP4 Word32
0
instance Routable IPv6 where
intToTBit :: Int -> IPv6
intToTBit = Int -> IPv6
intToTBitIPv6
isZero :: IPv6 -> IPv6 -> Bool
isZero IPv6
a IPv6
b = IPv6
a forall a. Addr a => a -> a -> a
`masked` IPv6
b forall a. Eq a => a -> a -> Bool
== IPv6Addr -> IPv6
IP6 (Word32
0,Word32
0,Word32
0,Word32
0)
intToTBitIPv4 :: Int -> IPv4
intToTBitIPv4 :: Int -> IPv4
intToTBitIPv4 Int
len = Word32 -> IPv4
IP4 (IntMap Word32
intToTBitsIPv4 forall a. IntMap a -> Int -> a
! Int
len)
intToTBitIPv6 :: Int -> IPv6
intToTBitIPv6 :: Int -> IPv6
intToTBitIPv6 Int
len = IPv6Addr -> IPv6
IP6 (IntMap IPv6Addr
intToTBitsIPv6 forall a. IntMap a -> Int -> a
! Int
len)
intToTBitsWord32 :: [Word32]
intToTBitsWord32 :: [Word32]
intToTBitsWord32 = forall a. (a -> a) -> a -> [a]
iterate (forall a. Bits a => a -> Int -> a
`shift` (-Int
1)) Word32
0x80000000
intToTBitsIPv4 :: IntMap IPv4Addr
intToTBitsIPv4 :: IntMap Word32
intToTBitsIPv4 = forall a. [(Int, a)] -> IntMap a
IM.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..Int
32] [Word32]
intToTBitsWord32
intToTBitsIPv6 :: IntMap IPv6Addr
intToTBitsIPv6 :: IntMap IPv6Addr
intToTBitsIPv6 = forall a. [(Int, a)] -> IntMap a
IM.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..Int
128] [IPv6Addr]
bs
where
bs :: [IPv6Addr]
bs = [IPv6Addr]
b1 forall a. [a] -> [a] -> [a]
++ [IPv6Addr]
b2 forall a. [a] -> [a] -> [a]
++ [IPv6Addr]
b3 forall a. [a] -> [a] -> [a]
++ [IPv6Addr]
b4 forall a. [a] -> [a] -> [a]
++ [IPv6Addr]
b5
b1 :: [IPv6Addr]
b1 = forall a b. (a -> b) -> [a] -> [b]
map (\Word32
vbit -> (Word32
vbit,Word32
all0,Word32
all0,Word32
all0)) [Word32]
intToTBits
b2 :: [IPv6Addr]
b2 = forall a b. (a -> b) -> [a] -> [b]
map (\Word32
vbit -> (Word32
all0,Word32
vbit,Word32
all0,Word32
all0)) [Word32]
intToTBits
b3 :: [IPv6Addr]
b3 = forall a b. (a -> b) -> [a] -> [b]
map (\Word32
vbit -> (Word32
all0,Word32
all0,Word32
vbit,Word32
all0)) [Word32]
intToTBits
b4 :: [IPv6Addr]
b4 = forall a b. (a -> b) -> [a] -> [b]
map (\Word32
vbit -> (Word32
all0,Word32
all0,Word32
all0,Word32
vbit)) [Word32]
intToTBits
b5 :: [IPv6Addr]
b5 = [(Word32
all0,Word32
all0,Word32
all0,Word32
all0)]
intToTBits :: [Word32]
intToTBits = forall a. Int -> [a] -> [a]
take Int
32 [Word32]
intToTBitsWord32
all0 :: Word32
all0 = Word32
0x00000000
data IPRTable k a =
Nil
| Node !(AddrRange k) !k !(Maybe a) !(IPRTable k a) !(IPRTable k a)
deriving (IPRTable k a -> IPRTable k a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k a. (Eq k, Eq a) => IPRTable k a -> IPRTable k a -> Bool
/= :: IPRTable k a -> IPRTable k a -> Bool
$c/= :: forall k a. (Eq k, Eq a) => IPRTable k a -> IPRTable k a -> Bool
== :: IPRTable k a -> IPRTable k a -> Bool
$c== :: forall k a. (Eq k, Eq a) => IPRTable k a -> IPRTable k a -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k a x. Rep (IPRTable k a) x -> IPRTable k a
forall k a x. IPRTable k a -> Rep (IPRTable k a) x
$cto :: forall k a x. Rep (IPRTable k a) x -> IPRTable k a
$cfrom :: forall k a x. IPRTable k a -> Rep (IPRTable k a) x
Generic, forall k a. Rep1 (IPRTable k) a -> IPRTable k a
forall k a. IPRTable k a -> Rep1 (IPRTable k) a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall k a. Rep1 (IPRTable k) a -> IPRTable k a
$cfrom1 :: forall k a. IPRTable k a -> Rep1 (IPRTable k) a
Generic1, Int -> IPRTable k a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k a. (Show k, Show a) => Int -> IPRTable k a -> ShowS
forall k a. (Show k, Show a) => [IPRTable k a] -> ShowS
forall k a. (Show k, Show a) => IPRTable k a -> String
showList :: [IPRTable k a] -> ShowS
$cshowList :: forall k a. (Show k, Show a) => [IPRTable k a] -> ShowS
show :: IPRTable k a -> String
$cshow :: forall k a. (Show k, Show a) => IPRTable k a -> String
showsPrec :: Int -> IPRTable k a -> ShowS
$cshowsPrec :: forall k a. (Show k, Show a) => Int -> IPRTable k a -> ShowS
Show)
empty :: Routable k => IPRTable k a
empty :: forall k a. Routable k => IPRTable k a
empty = forall k a. IPRTable k a
Nil
instance Functor (IPRTable k) where
fmap :: forall a b. (a -> b) -> IPRTable k a -> IPRTable k b
fmap a -> b
_ IPRTable k a
Nil = forall k a. IPRTable k a
Nil
fmap a -> b
f (Node AddrRange k
r k
a Maybe a
mv IPRTable k a
b1 IPRTable k a
b2) = forall k a.
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
Node AddrRange k
r k
a (a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
mv) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f IPRTable k a
b1) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f IPRTable k a
b2)
instance Foldable (IPRTable k) where
foldMap :: forall m a. Monoid m => (a -> m) -> IPRTable k a -> m
foldMap a -> m
_ IPRTable k a
Nil = forall a. Monoid a => a
mempty
foldMap a -> m
f (Node AddrRange k
_ k
_ Maybe a
mv IPRTable k a
b1 IPRTable k a
b2) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Maybe a
mv forall a. Monoid a => a -> a -> a
`mappend` forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f IPRTable k a
b1 forall a. Monoid a => a -> a -> a
`mappend` forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f IPRTable k a
b2
instance Traversable (IPRTable k) where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IPRTable k a -> f (IPRTable k b)
traverse a -> f b
_ IPRTable k a
Nil = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall k a. IPRTable k a
Nil
traverse a -> f b
f (Node AddrRange k
r k
a Maybe a
mv IPRTable k a
b1 IPRTable k a
b2) = forall k a.
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
Node AddrRange k
r k
a forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Maybe a
mv forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f IPRTable k a
b1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f IPRTable k a
b2
instance Routable k => Semigroup (IPRTable k a) where
IPRTable k a
a <> :: IPRTable k a -> IPRTable k a -> IPRTable k a
<> IPRTable k a
b = forall b k a.
(b -> AddrRange k -> a -> b) -> b -> IPRTable k a -> b
foldlWithKey (\IPRTable k a
rt AddrRange k
k a
v -> forall k a.
Routable k =>
AddrRange k -> a -> IPRTable k a -> IPRTable k a
insert AddrRange k
k a
v IPRTable k a
rt) IPRTable k a
a IPRTable k a
b
stimes :: forall b. Integral b => b -> IPRTable k a -> IPRTable k a
stimes = forall b a. Integral b => b -> a -> a
stimesIdempotent
instance Routable k => Monoid (IPRTable k a) where
mempty :: IPRTable k a
mempty = forall k a. Routable k => IPRTable k a
empty
mappend :: IPRTable k a -> IPRTable k a -> IPRTable k a
mappend = forall a. Semigroup a => a -> a -> a
(<>)
insert :: (Routable k) => AddrRange k -> a -> IPRTable k a -> IPRTable k a
insert :: forall k a.
Routable k =>
AddrRange k -> a -> IPRTable k a -> IPRTable k a
insert AddrRange k
k1 a
v1 IPRTable k a
Nil = forall k a.
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
Node AddrRange k
k1 k
tb1 (forall a. a -> Maybe a
Just a
v1) forall k a. IPRTable k a
Nil forall k a. IPRTable k a
Nil
where
tb1 :: k
tb1 = forall k. Routable k => AddrRange k -> k
keyToTestBit AddrRange k
k1
insert AddrRange k
k1 a
v1 s :: IPRTable k a
s@(Node AddrRange k
k2 k
tb2 Maybe a
v2 IPRTable k a
l IPRTable k a
r)
| AddrRange k
k1 forall a. Eq a => a -> a -> Bool
== AddrRange k
k2 = forall k a.
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
Node AddrRange k
k1 k
tb1 (forall a. a -> Maybe a
Just a
v1) IPRTable k a
l IPRTable k a
r
| AddrRange k
k2 forall a. Addr a => AddrRange a -> AddrRange a -> Bool
>:> AddrRange k
k1 = if forall k. Routable k => AddrRange k -> k -> Bool
isLeft AddrRange k
k1 k
tb2 then
forall k a.
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
Node AddrRange k
k2 k
tb2 Maybe a
v2 (forall k a.
Routable k =>
AddrRange k -> a -> IPRTable k a -> IPRTable k a
insert AddrRange k
k1 a
v1 IPRTable k a
l) IPRTable k a
r
else
forall k a.
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
Node AddrRange k
k2 k
tb2 Maybe a
v2 IPRTable k a
l (forall k a.
Routable k =>
AddrRange k -> a -> IPRTable k a -> IPRTable k a
insert AddrRange k
k1 a
v1 IPRTable k a
r)
| AddrRange k
k1 forall a. Addr a => AddrRange a -> AddrRange a -> Bool
>:> AddrRange k
k2 = if forall k. Routable k => AddrRange k -> k -> Bool
isLeft AddrRange k
k2 k
tb1 then
forall k a.
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
Node AddrRange k
k1 k
tb1 (forall a. a -> Maybe a
Just a
v1) IPRTable k a
s forall k a. IPRTable k a
Nil
else
forall k a.
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
Node AddrRange k
k1 k
tb1 (forall a. a -> Maybe a
Just a
v1) forall k a. IPRTable k a
Nil IPRTable k a
s
| Bool
otherwise = let n :: IPRTable k a
n = forall k a.
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
Node AddrRange k
k1 k
tb1 (forall a. a -> Maybe a
Just a
v1) forall k a. IPRTable k a
Nil forall k a. IPRTable k a
Nil
in forall k a.
Routable k =>
IPRTable k a -> IPRTable k a -> IPRTable k a
link IPRTable k a
n IPRTable k a
s
where
tb1 :: k
tb1 = forall k. Routable k => AddrRange k -> k
keyToTestBit AddrRange k
k1
link :: Routable k => IPRTable k a -> IPRTable k a -> IPRTable k a
link :: forall k a.
Routable k =>
IPRTable k a -> IPRTable k a -> IPRTable k a
link s1 :: IPRTable k a
s1@(Node AddrRange k
k1 k
_ Maybe a
_ IPRTable k a
_ IPRTable k a
_) s2 :: IPRTable k a
s2@(Node AddrRange k
k2 k
_ Maybe a
_ IPRTable k a
_ IPRTable k a
_)
| forall k. Routable k => AddrRange k -> k -> Bool
isLeft AddrRange k
k1 k
tbg = forall k a.
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
Node AddrRange k
kg k
tbg forall a. Maybe a
Nothing IPRTable k a
s1 IPRTable k a
s2
| Bool
otherwise = forall k a.
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
Node AddrRange k
kg k
tbg forall a. Maybe a
Nothing IPRTable k a
s2 IPRTable k a
s1
where
kg :: AddrRange k
kg = forall k.
Routable k =>
Int -> AddrRange k -> AddrRange k -> AddrRange k
glue Int
0 AddrRange k
k1 AddrRange k
k2
tbg :: k
tbg = forall k. Routable k => AddrRange k -> k
keyToTestBit AddrRange k
kg
link IPRTable k a
_ IPRTable k a
_ = forall a. HasCallStack => String -> a
error String
"link"
glue :: (Routable k) => Int -> AddrRange k -> AddrRange k -> AddrRange k
glue :: forall k.
Routable k =>
Int -> AddrRange k -> AddrRange k -> AddrRange k
glue Int
n AddrRange k
k1 AddrRange k
k2
| forall a. AddrRange a -> a
addr AddrRange k
k1 forall a. Addr a => a -> a -> a
`masked` k
mk forall a. Eq a => a -> a -> Bool
== forall a. AddrRange a -> a
addr AddrRange k
k2 forall a. Addr a => a -> a -> a
`masked` k
mk = forall k.
Routable k =>
Int -> AddrRange k -> AddrRange k -> AddrRange k
glue (Int
n forall a. Num a => a -> a -> a
+ Int
1) AddrRange k
k1 AddrRange k
k2
| Bool
otherwise = forall a. Addr a => a -> Int -> AddrRange a
makeAddrRange (forall a. AddrRange a -> a
addr AddrRange k
k1) (Int
n forall a. Num a => a -> a -> a
- Int
1)
where
mk :: k
mk = forall a. Addr a => Int -> a
intToMask Int
n
keyToTestBit :: Routable k => AddrRange k -> k
keyToTestBit :: forall k. Routable k => AddrRange k -> k
keyToTestBit = forall a. Routable a => Int -> a
intToTBit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. AddrRange a -> Int
mlen
isLeft :: Routable k => AddrRange k -> k -> Bool
isLeft :: forall k. Routable k => AddrRange k -> k -> Bool
isLeft AddrRange k
adr = forall a. Routable a => a -> a -> Bool
isZero (forall a. AddrRange a -> a
addr AddrRange k
adr)
delete :: (Routable k) => AddrRange k -> IPRTable k a -> IPRTable k a
delete :: forall k a.
Routable k =>
AddrRange k -> IPRTable k a -> IPRTable k a
delete AddrRange k
_ IPRTable k a
Nil = forall k a. IPRTable k a
Nil
delete AddrRange k
k1 s :: IPRTable k a
s@(Node AddrRange k
k2 k
tb2 Maybe a
v2 IPRTable k a
l IPRTable k a
r)
| AddrRange k
k1 forall a. Eq a => a -> a -> Bool
== AddrRange k
k2 = forall k a.
Routable k =>
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
node AddrRange k
k2 k
tb2 forall a. Maybe a
Nothing IPRTable k a
l IPRTable k a
r
| AddrRange k
k2 forall a. Addr a => AddrRange a -> AddrRange a -> Bool
>:> AddrRange k
k1 = if forall k. Routable k => AddrRange k -> k -> Bool
isLeft AddrRange k
k1 k
tb2 then
forall k a.
Routable k =>
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
node AddrRange k
k2 k
tb2 Maybe a
v2 (forall k a.
Routable k =>
AddrRange k -> IPRTable k a -> IPRTable k a
delete AddrRange k
k1 IPRTable k a
l) IPRTable k a
r
else
forall k a.
Routable k =>
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
node AddrRange k
k2 k
tb2 Maybe a
v2 IPRTable k a
l (forall k a.
Routable k =>
AddrRange k -> IPRTable k a -> IPRTable k a
delete AddrRange k
k1 IPRTable k a
r)
| Bool
otherwise = IPRTable k a
s
node :: (Routable k) => AddrRange k -> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
node :: forall k a.
Routable k =>
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
node AddrRange k
_ k
_ Maybe a
Nothing IPRTable k a
Nil IPRTable k a
r = IPRTable k a
r
node AddrRange k
_ k
_ Maybe a
Nothing IPRTable k a
l IPRTable k a
Nil = IPRTable k a
l
node AddrRange k
k k
tb Maybe a
v IPRTable k a
l IPRTable k a
r = forall k a.
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
Node AddrRange k
k k
tb Maybe a
v IPRTable k a
l IPRTable k a
r
lookup :: Routable k => AddrRange k -> IPRTable k a -> Maybe a
lookup :: forall k a. Routable k => AddrRange k -> IPRTable k a -> Maybe a
lookup AddrRange k
k IPRTable k a
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd (forall k a.
Routable k =>
AddrRange k
-> IPRTable k a -> Maybe (AddrRange k, a) -> Maybe (AddrRange k, a)
search AddrRange k
k IPRTable k a
s forall a. Maybe a
Nothing)
lookupKeyValue :: Routable k => AddrRange k -> IPRTable k a -> Maybe (AddrRange k, a)
lookupKeyValue :: forall k a.
Routable k =>
AddrRange k -> IPRTable k a -> Maybe (AddrRange k, a)
lookupKeyValue AddrRange k
k IPRTable k a
s = forall k a.
Routable k =>
AddrRange k
-> IPRTable k a -> Maybe (AddrRange k, a) -> Maybe (AddrRange k, a)
search AddrRange k
k IPRTable k a
s forall a. Maybe a
Nothing
search :: Routable k => AddrRange k
-> IPRTable k a
-> Maybe (AddrRange k, a)
-> Maybe (AddrRange k, a)
search :: forall k a.
Routable k =>
AddrRange k
-> IPRTable k a -> Maybe (AddrRange k, a) -> Maybe (AddrRange k, a)
search AddrRange k
_ IPRTable k a
Nil Maybe (AddrRange k, a)
res = Maybe (AddrRange k, a)
res
search AddrRange k
k1 (Node AddrRange k
k2 k
tb2 Maybe a
Nothing IPRTable k a
l IPRTable k a
r) Maybe (AddrRange k, a)
res
| AddrRange k
k1 forall a. Eq a => a -> a -> Bool
== AddrRange k
k2 = Maybe (AddrRange k, a)
res
| AddrRange k
k2 forall a. Addr a => AddrRange a -> AddrRange a -> Bool
>:> AddrRange k
k1 = if forall k. Routable k => AddrRange k -> k -> Bool
isLeft AddrRange k
k1 k
tb2 then
forall k a.
Routable k =>
AddrRange k
-> IPRTable k a -> Maybe (AddrRange k, a) -> Maybe (AddrRange k, a)
search AddrRange k
k1 IPRTable k a
l Maybe (AddrRange k, a)
res
else
forall k a.
Routable k =>
AddrRange k
-> IPRTable k a -> Maybe (AddrRange k, a) -> Maybe (AddrRange k, a)
search AddrRange k
k1 IPRTable k a
r Maybe (AddrRange k, a)
res
| Bool
otherwise = Maybe (AddrRange k, a)
res
search AddrRange k
k1 (Node AddrRange k
k2 k
tb2 (Just a
vl) IPRTable k a
l IPRTable k a
r) Maybe (AddrRange k, a)
res
| AddrRange k
k1 forall a. Eq a => a -> a -> Bool
== AddrRange k
k2 = forall a. a -> Maybe a
Just (AddrRange k
k1, a
vl)
| AddrRange k
k2 forall a. Addr a => AddrRange a -> AddrRange a -> Bool
>:> AddrRange k
k1 = if forall k. Routable k => AddrRange k -> k -> Bool
isLeft AddrRange k
k1 k
tb2 then
forall k a.
Routable k =>
AddrRange k
-> IPRTable k a -> Maybe (AddrRange k, a) -> Maybe (AddrRange k, a)
search AddrRange k
k1 IPRTable k a
l forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (AddrRange k
k2, a
vl)
else
forall k a.
Routable k =>
AddrRange k
-> IPRTable k a -> Maybe (AddrRange k, a) -> Maybe (AddrRange k, a)
search AddrRange k
k1 IPRTable k a
r forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (AddrRange k
k2, a
vl)
| Bool
otherwise = Maybe (AddrRange k, a)
res
lookupAll :: Routable k => AddrRange k -> IPRTable k a -> [(AddrRange k, a)]
lookupAll :: forall k a.
Routable k =>
AddrRange k -> IPRTable k a -> [(AddrRange k, a)]
lookupAll AddrRange k
range = forall {b}.
[(AddrRange k, b)] -> IPRTable k b -> [(AddrRange k, b)]
go []
where
go :: [(AddrRange k, b)] -> IPRTable k b -> [(AddrRange k, b)]
go [(AddrRange k, b)]
acc IPRTable k b
Nil = [(AddrRange k, b)]
acc
go [(AddrRange k, b)]
acc (Node AddrRange k
k k
tb Maybe b
Nothing IPRTable k b
l IPRTable k b
r)
| AddrRange k
k forall a. Eq a => a -> a -> Bool
== AddrRange k
range = [(AddrRange k, b)]
acc
| AddrRange k
k forall a. Addr a => AddrRange a -> AddrRange a -> Bool
>:> AddrRange k
range = [(AddrRange k, b)] -> IPRTable k b -> [(AddrRange k, b)]
go [(AddrRange k, b)]
acc forall a b. (a -> b) -> a -> b
$ if forall k. Routable k => AddrRange k -> k -> Bool
isLeft AddrRange k
range k
tb then IPRTable k b
l else IPRTable k b
r
| Bool
otherwise = [(AddrRange k, b)]
acc
go [(AddrRange k, b)]
acc (Node AddrRange k
k k
tb (Just b
v) IPRTable k b
l IPRTable k b
r)
| AddrRange k
k forall a. Eq a => a -> a -> Bool
== AddrRange k
range = (AddrRange k
k,b
v)forall a. a -> [a] -> [a]
:[(AddrRange k, b)]
acc
| AddrRange k
k forall a. Addr a => AddrRange a -> AddrRange a -> Bool
>:> AddrRange k
range = [(AddrRange k, b)] -> IPRTable k b -> [(AddrRange k, b)]
go ((AddrRange k
k,b
v)forall a. a -> [a] -> [a]
:[(AddrRange k, b)]
acc) forall a b. (a -> b) -> a -> b
$ if forall k. Routable k => AddrRange k -> k -> Bool
isLeft AddrRange k
range k
tb then IPRTable k b
l else IPRTable k b
r
| Bool
otherwise = [(AddrRange k, b)]
acc
findMatch :: Alternative m => Routable k => AddrRange k -> IPRTable k a -> m (AddrRange k, a)
findMatch :: forall (m :: * -> *) k a.
(Alternative m, Routable k) =>
AddrRange k -> IPRTable k a -> m (AddrRange k, a)
findMatch AddrRange k
_ IPRTable k a
Nil = forall (f :: * -> *) a. Alternative f => f a
A.empty
findMatch AddrRange k
k1 (Node AddrRange k
k2 k
_ Maybe a
Nothing IPRTable k a
l IPRTable k a
r)
| AddrRange k
k1 forall a. Addr a => AddrRange a -> AddrRange a -> Bool
>:> AddrRange k
k2 = forall (m :: * -> *) k a.
(Alternative m, Routable k) =>
AddrRange k -> IPRTable k a -> m (AddrRange k, a)
findMatch AddrRange k
k1 IPRTable k a
l forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) k a.
(Alternative m, Routable k) =>
AddrRange k -> IPRTable k a -> m (AddrRange k, a)
findMatch AddrRange k
k1 IPRTable k a
r
| AddrRange k
k2 forall a. Addr a => AddrRange a -> AddrRange a -> Bool
>:> AddrRange k
k1 = forall (m :: * -> *) k a.
(Alternative m, Routable k) =>
AddrRange k -> IPRTable k a -> m (AddrRange k, a)
findMatch AddrRange k
k1 IPRTable k a
l forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) k a.
(Alternative m, Routable k) =>
AddrRange k -> IPRTable k a -> m (AddrRange k, a)
findMatch AddrRange k
k1 IPRTable k a
r
| Bool
otherwise = forall (f :: * -> *) a. Alternative f => f a
A.empty
findMatch AddrRange k
k1 (Node AddrRange k
k2 k
_ (Just a
vl) IPRTable k a
l IPRTable k a
r)
| AddrRange k
k1 forall a. Addr a => AddrRange a -> AddrRange a -> Bool
>:> AddrRange k
k2 = forall (f :: * -> *) a. Applicative f => a -> f a
pure (AddrRange k
k2, a
vl) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) k a.
(Alternative m, Routable k) =>
AddrRange k -> IPRTable k a -> m (AddrRange k, a)
findMatch AddrRange k
k1 IPRTable k a
l forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) k a.
(Alternative m, Routable k) =>
AddrRange k -> IPRTable k a -> m (AddrRange k, a)
findMatch AddrRange k
k1 IPRTable k a
r
| AddrRange k
k2 forall a. Addr a => AddrRange a -> AddrRange a -> Bool
>:> AddrRange k
k1 = forall (m :: * -> *) k a.
(Alternative m, Routable k) =>
AddrRange k -> IPRTable k a -> m (AddrRange k, a)
findMatch AddrRange k
k1 IPRTable k a
l forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) k a.
(Alternative m, Routable k) =>
AddrRange k -> IPRTable k a -> m (AddrRange k, a)
findMatch AddrRange k
k1 IPRTable k a
r
| Bool
otherwise = forall (f :: * -> *) a. Alternative f => f a
A.empty
fromList :: Routable k => [(AddrRange k, a)] -> IPRTable k a
fromList :: forall k a. Routable k => [(AddrRange k, a)] -> IPRTable k a
fromList = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\IPRTable k a
s (AddrRange k
k,a
v) -> forall k a.
Routable k =>
AddrRange k -> a -> IPRTable k a -> IPRTable k a
insert AddrRange k
k a
v IPRTable k a
s) forall k a. Routable k => IPRTable k a
empty
toList :: Routable k => IPRTable k a -> [(AddrRange k, a)]
toList :: forall k a. Routable k => IPRTable k a -> [(AddrRange k, a)]
toList = forall k a b. (IPRTable k a -> b -> b) -> b -> IPRTable k a -> b
foldt forall {k} {b}.
IPRTable k b -> [(AddrRange k, b)] -> [(AddrRange k, b)]
toL []
where
toL :: IPRTable k b -> [(AddrRange k, b)] -> [(AddrRange k, b)]
toL IPRTable k b
Nil [(AddrRange k, b)]
xs = [(AddrRange k, b)]
xs
toL (Node AddrRange k
_ k
_ Maybe b
Nothing IPRTable k b
_ IPRTable k b
_) [(AddrRange k, b)]
xs = [(AddrRange k, b)]
xs
toL (Node AddrRange k
k k
_ (Just b
a) IPRTable k b
_ IPRTable k b
_) [(AddrRange k, b)]
xs = (AddrRange k
k,b
a) forall a. a -> [a] -> [a]
: [(AddrRange k, b)]
xs
foldt :: (IPRTable k a -> b -> b) -> b -> IPRTable k a -> b
foldt :: forall k a b. (IPRTable k a -> b -> b) -> b -> IPRTable k a -> b
foldt IPRTable k a -> b -> b
_ b
v IPRTable k a
Nil = b
v
foldt IPRTable k a -> b -> b
func b
v rt :: IPRTable k a
rt@(Node AddrRange k
_ k
_ Maybe a
_ IPRTable k a
l IPRTable k a
r) = forall k a b. (IPRTable k a -> b -> b) -> b -> IPRTable k a -> b
foldt IPRTable k a -> b -> b
func (forall k a b. (IPRTable k a -> b -> b) -> b -> IPRTable k a -> b
foldt IPRTable k a -> b -> b
func (IPRTable k a -> b -> b
func IPRTable k a
rt b
v) IPRTable k a
l) IPRTable k a
r
foldlWithKey :: (b -> AddrRange k -> a -> b) -> b -> IPRTable k a -> b
foldlWithKey :: forall b k a.
(b -> AddrRange k -> a -> b) -> b -> IPRTable k a -> b
foldlWithKey b -> AddrRange k -> a -> b
f b
zr = b -> IPRTable k a -> b
go b
zr
where
go :: b -> IPRTable k a -> b
go b
z IPRTable k a
Nil = b
z
go b
z (Node AddrRange k
_ k
_ Maybe a
Nothing IPRTable k a
l IPRTable k a
r) = b -> IPRTable k a -> b
go (b -> IPRTable k a -> b
go b
z IPRTable k a
l) IPRTable k a
r
go b
z (Node AddrRange k
n k
_ (Just a
v) IPRTable k a
l IPRTable k a
r) = b -> IPRTable k a -> b
go (b -> AddrRange k -> a -> b
f (b -> IPRTable k a -> b
go b
z IPRTable k a
l) AddrRange k
n a
v) IPRTable k a
r
{-# INLINE foldlWithKey #-}
foldrWithKey :: (AddrRange k -> a -> b -> b) -> b -> IPRTable k a -> b
foldrWithKey :: forall k a b.
(AddrRange k -> a -> b -> b) -> b -> IPRTable k a -> b
foldrWithKey AddrRange k -> a -> b -> b
f b
zr = b -> IPRTable k a -> b
go b
zr
where
go :: b -> IPRTable k a -> b
go b
z IPRTable k a
Nil = b
z
go b
z (Node AddrRange k
_ k
_ Maybe a
Nothing IPRTable k a
l IPRTable k a
r) = b -> IPRTable k a -> b
go (b -> IPRTable k a -> b
go b
z IPRTable k a
r) IPRTable k a
l
go b
z (Node AddrRange k
n k
_ (Just a
v) IPRTable k a
l IPRTable k a
r) = b -> IPRTable k a -> b
go (AddrRange k -> a -> b -> b
f AddrRange k
n a
v (b -> IPRTable k a -> b
go b
z IPRTable k a
r)) IPRTable k a
l
{-# INLINE foldrWithKey #-}