{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}

-- |
--   IP routing table is a tree of 'AddrRange'
--   to search one of them on the longest
--   match base. It is a kind of TRIE with one
--   way branching removed. Both IPv4 and IPv6
--   are supported.
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)

-- $setup
-- >>> :set -XOverloadedStrings

----------------------------------------------------------------

-- |
--   A class to contain IPv4 and IPv6.
class Addr a => Routable a where
    -- |
    --       The 'intToTBit' function takes 'Int' and returns an 'Routable' address
    --       whose only n-th bit is set.
    intToTBit :: Int -> a

    -- |
    --       The 'isZero' function takes an 'Routable' address and an test bit
    --       'Routable' address and returns 'True' is the bit is unset,
    --       otherwise returns 'False'.
    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 IPv4 -> IPv4 -> IPv4
forall a. Addr a => a -> a -> a
`masked` IPv4
b IPv4 -> IPv4 -> Bool
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 IPv6 -> IPv6 -> IPv6
forall a. Addr a => a -> a -> a
`masked` IPv6
b IPv6 -> IPv6 -> Bool
forall a. Eq a => a -> a -> Bool
== IPv6Addr -> IPv6
IP6 (Word32
0, Word32
0, Word32
0, Word32
0)

----------------------------------------------------------------
--
-- Test Bit
--

intToTBitIPv4 :: Int -> IPv4
intToTBitIPv4 :: Int -> IPv4
intToTBitIPv4 Int
len = Word32 -> IPv4
IP4 (IntMap Word32
intToTBitsIPv4 IntMap Word32 -> Int -> Word32
forall a. IntMap a -> Int -> a
! Int
len)

intToTBitIPv6 :: Int -> IPv6
intToTBitIPv6 :: Int -> IPv6
intToTBitIPv6 Int
len = IPv6Addr -> IPv6
IP6 (IntMap IPv6Addr
intToTBitsIPv6 IntMap IPv6Addr -> Int -> IPv6Addr
forall a. IntMap a -> Int -> a
! Int
len)

intToTBitsWord32 :: [Word32]
intToTBitsWord32 :: [Word32]
intToTBitsWord32 = (Word32 -> Word32) -> Word32 -> [Word32]
forall a. (a -> a) -> a -> [a]
iterate (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shift` (-Int
1)) Word32
0x80000000

intToTBitsIPv4 :: IntMap IPv4Addr
intToTBitsIPv4 :: IntMap Word32
intToTBitsIPv4 = [(Int, Word32)] -> IntMap Word32
forall a. [(Int, a)] -> IntMap a
IM.fromList ([(Int, Word32)] -> IntMap Word32)
-> [(Int, Word32)] -> IntMap Word32
forall a b. (a -> b) -> a -> b
$ [Int] -> [Word32] -> [(Int, Word32)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 .. Int
32] [Word32]
intToTBitsWord32

intToTBitsIPv6 :: IntMap IPv6Addr
intToTBitsIPv6 :: IntMap IPv6Addr
intToTBitsIPv6 = [(Int, IPv6Addr)] -> IntMap IPv6Addr
forall a. [(Int, a)] -> IntMap a
IM.fromList ([(Int, IPv6Addr)] -> IntMap IPv6Addr)
-> [(Int, IPv6Addr)] -> IntMap IPv6Addr
forall a b. (a -> b) -> a -> b
$ [Int] -> [IPv6Addr] -> [(Int, IPv6Addr)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 .. Int
128] [IPv6Addr]
bs
  where
    bs :: [IPv6Addr]
bs = [IPv6Addr]
b1 [IPv6Addr] -> [IPv6Addr] -> [IPv6Addr]
forall a. [a] -> [a] -> [a]
++ [IPv6Addr]
b2 [IPv6Addr] -> [IPv6Addr] -> [IPv6Addr]
forall a. [a] -> [a] -> [a]
++ [IPv6Addr]
b3 [IPv6Addr] -> [IPv6Addr] -> [IPv6Addr]
forall a. [a] -> [a] -> [a]
++ [IPv6Addr]
b4 [IPv6Addr] -> [IPv6Addr] -> [IPv6Addr]
forall a. [a] -> [a] -> [a]
++ [IPv6Addr]
b5
    b1 :: [IPv6Addr]
b1 = (Word32 -> IPv6Addr) -> [Word32] -> [IPv6Addr]
forall a b. (a -> b) -> [a] -> [b]
map (\Word32
vbit -> (Word32
vbit, Word32
all0, Word32
all0, Word32
all0)) [Word32]
intToTBits
    b2 :: [IPv6Addr]
b2 = (Word32 -> IPv6Addr) -> [Word32] -> [IPv6Addr]
forall a b. (a -> b) -> [a] -> [b]
map (\Word32
vbit -> (Word32
all0, Word32
vbit, Word32
all0, Word32
all0)) [Word32]
intToTBits
    b3 :: [IPv6Addr]
b3 = (Word32 -> IPv6Addr) -> [Word32] -> [IPv6Addr]
forall a b. (a -> b) -> [a] -> [b]
map (\Word32
vbit -> (Word32
all0, Word32
all0, Word32
vbit, Word32
all0)) [Word32]
intToTBits
    b4 :: [IPv6Addr]
b4 = (Word32 -> IPv6Addr) -> [Word32] -> [IPv6Addr]
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 = Int -> [Word32] -> [Word32]
forall a. Int -> [a] -> [a]
take Int
32 [Word32]
intToTBitsWord32
    all0 :: Word32
all0 = Word32
0x00000000

----------------------------------------------------------------

-- |
--   The Tree structure for IP routing table based on TRIE with
--   one way branching removed. This is an abstract data type,
--   so you cannot touch its inside. Please use 'insert' or 'lookup', instead.
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
(IPRTable k a -> IPRTable k a -> Bool)
-> (IPRTable k a -> IPRTable k a -> Bool) -> Eq (IPRTable k a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k a. (Eq k, Eq a) => 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
/= :: IPRTable k a -> IPRTable k a -> Bool
Eq, (forall x. IPRTable k a -> Rep (IPRTable k a) x)
-> (forall x. Rep (IPRTable k a) x -> IPRTable k a)
-> Generic (IPRTable k a)
forall x. Rep (IPRTable k a) x -> IPRTable k a
forall x. IPRTable k a -> Rep (IPRTable k a) x
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
$cfrom :: forall k a x. IPRTable k a -> Rep (IPRTable k a) x
from :: forall x. IPRTable k a -> Rep (IPRTable k a) x
$cto :: forall k a x. Rep (IPRTable k a) x -> IPRTable k a
to :: forall x. Rep (IPRTable k a) x -> IPRTable k a
Generic, (forall a. IPRTable k a -> Rep1 (IPRTable k) a)
-> (forall a. Rep1 (IPRTable k) a -> IPRTable k a)
-> Generic1 (IPRTable k)
forall a. Rep1 (IPRTable k) a -> IPRTable k a
forall a. IPRTable k a -> Rep1 (IPRTable k) a
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
$cfrom1 :: forall k a. IPRTable k a -> Rep1 (IPRTable k) a
from1 :: forall a. IPRTable k a -> Rep1 (IPRTable k) a
$cto1 :: forall k a. Rep1 (IPRTable k) a -> IPRTable k a
to1 :: forall a. Rep1 (IPRTable k) a -> IPRTable k a
Generic1, Int -> IPRTable k a -> ShowS
[IPRTable k a] -> ShowS
IPRTable k a -> String
(Int -> IPRTable k a -> ShowS)
-> (IPRTable k a -> String)
-> ([IPRTable k a] -> ShowS)
-> Show (IPRTable k a)
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
$cshowsPrec :: forall k a. (Show k, Show a) => Int -> IPRTable k a -> ShowS
showsPrec :: Int -> IPRTable k a -> ShowS
$cshow :: forall k a. (Show k, Show a) => IPRTable k a -> String
show :: IPRTable k a -> String
$cshowList :: forall k a. (Show k, Show a) => [IPRTable k a] -> ShowS
showList :: [IPRTable k a] -> ShowS
Show)

----------------------------------------------------------------

-- |
--   The 'empty' function returns an empty IP routing table.
--
-- >>> (empty :: IPRTable IPv4 ()) == fromList []
-- True
empty :: Routable k => IPRTable k a
empty :: forall k a. Routable k => IPRTable k a
empty = IPRTable k a
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 = IPRTable k b
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) = AddrRange k
-> k -> Maybe b -> IPRTable k b -> IPRTable k b -> IPRTable k b
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 (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
mv) ((a -> b) -> IPRTable k a -> IPRTable k b
forall a b. (a -> b) -> IPRTable k a -> IPRTable k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f IPRTable k a
b1) ((a -> b) -> IPRTable k a -> IPRTable k b
forall a b. (a -> b) -> IPRTable k a -> IPRTable k b
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 = m
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) = (a -> m) -> Maybe a -> m
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Maybe a
mv m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> IPRTable k a -> m
forall m a. Monoid m => (a -> m) -> IPRTable k a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f IPRTable k a
b1 m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> IPRTable k a -> m
forall m a. Monoid m => (a -> m) -> IPRTable k a -> m
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 = IPRTable k b -> f (IPRTable k b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IPRTable k b
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) = AddrRange k
-> k -> Maybe b -> IPRTable k b -> IPRTable k b -> IPRTable k b
forall k a.
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
Node AddrRange k
r k
a (Maybe b -> IPRTable k b -> IPRTable k b -> IPRTable k b)
-> f (Maybe b) -> f (IPRTable k b -> IPRTable k b -> IPRTable k b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Maybe a -> f (Maybe b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse a -> f b
f Maybe a
mv f (IPRTable k b -> IPRTable k b -> IPRTable k b)
-> f (IPRTable k b) -> f (IPRTable k b -> IPRTable k b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> IPRTable k a -> f (IPRTable k b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IPRTable k a -> f (IPRTable k b)
traverse a -> f b
f IPRTable k a
b1 f (IPRTable k b -> IPRTable k b)
-> f (IPRTable k b) -> f (IPRTable k b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> IPRTable k a -> f (IPRTable k b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IPRTable k a -> f (IPRTable k b)
traverse a -> f b
f IPRTable k a
b2

-- | Note that Semigroup and Monoid instances are right-biased.
--   That is, if both arguments have the same key, the value from the right
--   argument will be used.
--   Since: 1.7.5
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 = (IPRTable k a -> AddrRange k -> a -> IPRTable k a)
-> IPRTable k a -> IPRTable k a -> IPRTable k a
forall b k a.
(b -> AddrRange k -> a -> b) -> b -> IPRTable k a -> b
foldlWithKey (\IPRTable k a
rt AddrRange k
k a
v -> AddrRange k -> a -> IPRTable k a -> IPRTable k a
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 = b -> IPRTable k a -> IPRTable k a
forall b a. Integral b => b -> a -> a
stimesIdempotent

-- | Since: 1.7.5
instance Routable k => Monoid (IPRTable k a) where
    mempty :: IPRTable k a
mempty = IPRTable k a
forall k a. Routable k => IPRTable k a
empty
    mappend :: IPRTable k a -> IPRTable k a -> IPRTable k a
mappend = IPRTable k a -> IPRTable k a -> IPRTable k a
forall a. Semigroup a => a -> a -> a
(<>)

----------------------------------------------------------------

-- |
--   The 'insert' function inserts a value with a key of 'AddrRange' to 'IPRTable'
--   and returns a new 'IPRTable'.
--
-- >>> (insert ("127.0.0.1" :: AddrRange IPv4) () empty) == fromList [("127.0.0.1",())]
-- True
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 = AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
forall k a.
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
Node AddrRange k
k1 k
tb1 (a -> Maybe a
forall a. a -> Maybe a
Just a
v1) IPRTable k a
forall k a. IPRTable k a
Nil IPRTable k a
forall k a. IPRTable k a
Nil
  where
    tb1 :: k
tb1 = AddrRange k -> k
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 AddrRange k -> AddrRange k -> Bool
forall a. Eq a => a -> a -> Bool
== AddrRange k
k2 = AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
forall k a.
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
Node AddrRange k
k1 k
tb1 (a -> Maybe a
forall a. a -> Maybe a
Just a
v1) IPRTable k a
l IPRTable k a
r
    | AddrRange k
k2 AddrRange k -> AddrRange k -> Bool
forall a. Addr a => AddrRange a -> AddrRange a -> Bool
>:> AddrRange k
k1 =
        if AddrRange k -> k -> Bool
forall k. Routable k => AddrRange k -> k -> Bool
isLeft AddrRange k
k1 k
tb2
            then
                AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
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 (AddrRange k -> a -> IPRTable k a -> IPRTable k a
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
                AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
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 (AddrRange k -> a -> IPRTable k a -> IPRTable k a
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 AddrRange k -> AddrRange k -> Bool
forall a. Addr a => AddrRange a -> AddrRange a -> Bool
>:> AddrRange k
k2 =
        if AddrRange k -> k -> Bool
forall k. Routable k => AddrRange k -> k -> Bool
isLeft AddrRange k
k2 k
tb1
            then
                AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
forall k a.
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
Node AddrRange k
k1 k
tb1 (a -> Maybe a
forall a. a -> Maybe a
Just a
v1) IPRTable k a
s IPRTable k a
forall k a. IPRTable k a
Nil
            else
                AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
forall k a.
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
Node AddrRange k
k1 k
tb1 (a -> Maybe a
forall a. a -> Maybe a
Just a
v1) IPRTable k a
forall k a. IPRTable k a
Nil IPRTable k a
s
    | Bool
otherwise =
        let n :: IPRTable k a
n = AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
forall k a.
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
Node AddrRange k
k1 k
tb1 (a -> Maybe a
forall a. a -> Maybe a
Just a
v1) IPRTable k a
forall k a. IPRTable k a
Nil IPRTable k a
forall k a. IPRTable k a
Nil
         in IPRTable k a -> IPRTable k a -> IPRTable k a
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 = AddrRange k -> k
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
_)
    | AddrRange k -> k -> Bool
forall k. Routable k => AddrRange k -> k -> Bool
isLeft AddrRange k
k1 k
tbg = AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
forall k a.
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
Node AddrRange k
kg k
tbg Maybe a
forall a. Maybe a
Nothing IPRTable k a
s1 IPRTable k a
s2
    | Bool
otherwise = AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
forall k a.
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
Node AddrRange k
kg k
tbg Maybe a
forall a. Maybe a
Nothing IPRTable k a
s2 IPRTable k a
s1
  where
    kg :: AddrRange k
kg = Int -> AddrRange k -> AddrRange k -> AddrRange k
forall k.
Routable k =>
Int -> AddrRange k -> AddrRange k -> AddrRange k
glue Int
0 AddrRange k
k1 AddrRange k
k2
    tbg :: k
tbg = AddrRange k -> k
forall k. Routable k => AddrRange k -> k
keyToTestBit AddrRange k
kg
link IPRTable k a
_ IPRTable k a
_ = String -> 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
    | AddrRange k -> k
forall a. AddrRange a -> a
addr AddrRange k
k1 k -> k -> k
forall a. Addr a => a -> a -> a
`masked` k
mk k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== AddrRange k -> k
forall a. AddrRange a -> a
addr AddrRange k
k2 k -> k -> k
forall a. Addr a => a -> a -> a
`masked` k
mk = Int -> AddrRange k -> AddrRange k -> AddrRange k
forall k.
Routable k =>
Int -> AddrRange k -> AddrRange k -> AddrRange k
glue (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) AddrRange k
k1 AddrRange k
k2
    | Bool
otherwise = k -> Int -> AddrRange k
forall a. Addr a => a -> Int -> AddrRange a
makeAddrRange (AddrRange k -> k
forall a. AddrRange a -> a
addr AddrRange k
k1) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  where
    mk :: k
mk = Int -> k
forall a. Addr a => Int -> a
intToMask Int
n

keyToTestBit :: Routable k => AddrRange k -> k
keyToTestBit :: forall k. Routable k => AddrRange k -> k
keyToTestBit = Int -> k
forall a. Routable a => Int -> a
intToTBit (Int -> k) -> (AddrRange k -> Int) -> AddrRange k -> k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddrRange k -> Int
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 = k -> k -> Bool
forall a. Routable a => a -> a -> Bool
isZero (AddrRange k -> k
forall a. AddrRange a -> a
addr AddrRange k
adr)

----------------------------------------------------------------

-- |
--   The 'delete' function deletes a value by a key of 'AddrRange' from 'IPRTable'
--   and returns a new 'IPRTable'.
--
-- >>> delete "127.0.0.1" (insert "127.0.0.1" () empty) == (empty :: IPRTable IPv4 ())
-- True
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 = IPRTable k a
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 AddrRange k -> AddrRange k -> Bool
forall a. Eq a => a -> a -> Bool
== AddrRange k
k2 = AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
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
forall a. Maybe a
Nothing IPRTable k a
l IPRTable k a
r
    | AddrRange k
k2 AddrRange k -> AddrRange k -> Bool
forall a. Addr a => AddrRange a -> AddrRange a -> Bool
>:> AddrRange k
k1 =
        if AddrRange k -> k -> Bool
forall k. Routable k => AddrRange k -> k -> Bool
isLeft AddrRange k
k1 k
tb2
            then
                AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
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 (AddrRange k -> IPRTable k a -> IPRTable k a
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
                AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
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 (AddrRange k -> IPRTable k a -> IPRTable k a
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 = AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
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

----------------------------------------------------------------

-- |
--   The 'lookup' function looks up 'IPRTable' with a key of 'AddrRange'.
--   If a routing information in 'IPRTable' matches the key, its value
--   is returned.
--
-- >>> let v4 = ["133.4.0.0/16","133.5.0.0/16","133.5.16.0/24","133.5.23.0/24"] :: [AddrRange IPv4]
-- >>> let rt = fromList $ zip v4 v4
-- >>> lookup "127.0.0.1" rt
-- Nothing
-- >>> lookup "133.3.0.1" rt
-- Nothing
-- >>> lookup "133.4.0.0" rt
-- Just 133.4.0.0/16
-- >>> lookup "133.4.0.1" rt
-- Just 133.4.0.0/16
-- >>> lookup "133.5.16.0" rt
-- Just 133.5.16.0/24
-- >>> lookup "133.5.16.1" rt
-- Just 133.5.16.0/24
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 = ((AddrRange k, a) -> a) -> Maybe (AddrRange k, a) -> Maybe a
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AddrRange k, a) -> a
forall a b. (a, b) -> b
snd (AddrRange k
-> IPRTable k a -> Maybe (AddrRange k, a) -> Maybe (AddrRange k, a)
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 Maybe (AddrRange k, a)
forall a. Maybe a
Nothing)

-- |
--   The 'lookupKeyValue' function looks up 'IPRTable' with a key of 'AddrRange'.
--   If a routing information in 'IPRTable' matches the key, both key and value
--   are returned.
--
-- >>> :set -XOverloadedStrings
-- >>> let rt = fromList ([("192.168.0.0/24", 1), ("10.10.0.0/16", 2)] :: [(AddrRange IPv4, Int)])
-- >>> lookupKeyValue "127.0.0.1" rt
-- Nothing
-- >>> lookupKeyValue "192.168.0.1" rt
-- Just (192.168.0.0/24,1)
-- >>> lookupKeyValue "10.10.0.1" rt
-- Just (10.10.0.0/16,2)
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 = AddrRange k
-> IPRTable k a -> Maybe (AddrRange k, a) -> Maybe (AddrRange k, a)
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 Maybe (AddrRange k, a)
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 AddrRange k -> AddrRange k -> Bool
forall a. Eq a => a -> a -> Bool
== AddrRange k
k2 = Maybe (AddrRange k, a)
res
    | AddrRange k
k2 AddrRange k -> AddrRange k -> Bool
forall a. Addr a => AddrRange a -> AddrRange a -> Bool
>:> AddrRange k
k1 =
        if AddrRange k -> k -> Bool
forall k. Routable k => AddrRange k -> k -> Bool
isLeft AddrRange k
k1 k
tb2
            then
                AddrRange k
-> IPRTable k a -> Maybe (AddrRange k, a) -> Maybe (AddrRange k, a)
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
                AddrRange k
-> IPRTable k a -> Maybe (AddrRange k, a) -> Maybe (AddrRange k, a)
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 AddrRange k -> AddrRange k -> Bool
forall a. Eq a => a -> a -> Bool
== AddrRange k
k2 = (AddrRange k, a) -> Maybe (AddrRange k, a)
forall a. a -> Maybe a
Just (AddrRange k
k1, a
vl)
    | AddrRange k
k2 AddrRange k -> AddrRange k -> Bool
forall a. Addr a => AddrRange a -> AddrRange a -> Bool
>:> AddrRange k
k1 =
        if AddrRange k -> k -> Bool
forall k. Routable k => AddrRange k -> k -> Bool
isLeft AddrRange k
k1 k
tb2
            then
                AddrRange k
-> IPRTable k a -> Maybe (AddrRange k, a) -> Maybe (AddrRange k, a)
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) -> Maybe (AddrRange k, a))
-> Maybe (AddrRange k, a) -> Maybe (AddrRange k, a)
forall a b. (a -> b) -> a -> b
$ (AddrRange k, a) -> Maybe (AddrRange k, a)
forall a. a -> Maybe a
Just (AddrRange k
k2, a
vl)
            else
                AddrRange k
-> IPRTable k a -> Maybe (AddrRange k, a) -> Maybe (AddrRange k, a)
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) -> Maybe (AddrRange k, a))
-> Maybe (AddrRange k, a) -> Maybe (AddrRange k, a)
forall a b. (a -> b) -> a -> b
$ (AddrRange k, a) -> Maybe (AddrRange k, a)
forall a. a -> Maybe a
Just (AddrRange k
k2, a
vl)
    | Bool
otherwise = Maybe (AddrRange k, a)
res

-- |
--   'lookupAll' is a version of 'lookup' that returns all entries matching the
--    given key, not just the longest match.
--
-- >>> :set -XOverloadedStrings
-- >>> let rt = fromList ([("192.168.0.0/24", 1), ("10.10.0.0/16", 2), ("10.0.0.0/8", 3)] :: [(AddrRange IPv4, Int)])
-- >>> lookupAll "127.0.0.1" rt
-- []
-- >>> lookupAll "192.168.0.1" rt
-- [(192.168.0.0/24,1)]
-- >>> lookupAll "10.10.0.1" rt
-- [(10.10.0.0/16,2),(10.0.0.0/8,3)]
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 = [(AddrRange k, a)] -> IPRTable k a -> [(AddrRange k, a)]
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 AddrRange k -> AddrRange k -> Bool
forall a. Eq a => a -> a -> Bool
== AddrRange k
range = [(AddrRange k, b)]
acc
        | AddrRange k
k AddrRange k -> AddrRange k -> Bool
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 (IPRTable k b -> [(AddrRange k, b)])
-> IPRTable k b -> [(AddrRange k, b)]
forall a b. (a -> b) -> a -> b
$ if AddrRange k -> k -> Bool
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 AddrRange k -> AddrRange k -> Bool
forall a. Eq a => a -> a -> Bool
== AddrRange k
range = (AddrRange k
k, b
v) (AddrRange k, b) -> [(AddrRange k, b)] -> [(AddrRange k, b)]
forall a. a -> [a] -> [a]
: [(AddrRange k, b)]
acc
        | AddrRange k
k AddrRange k -> AddrRange k -> Bool
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) (AddrRange k, b) -> [(AddrRange k, b)] -> [(AddrRange k, b)]
forall a. a -> [a] -> [a]
: [(AddrRange k, b)]
acc) (IPRTable k b -> [(AddrRange k, b)])
-> IPRTable k b -> [(AddrRange k, b)]
forall a b. (a -> b) -> a -> b
$ if AddrRange k -> k -> Bool
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

----------------------------------------------------------------

-- |
--   The 'findMatch' function looks up 'IPRTable' with a key of 'AddrRange'.
--   If the key matches routing informations in 'IPRTable', they are
--   returned.
--
-- >>> let v4 = ["133.4.0.0/16","133.5.0.0/16","133.5.16.0/24","133.5.23.0/24"] :: [AddrRange IPv4]
-- >>> let rt = fromList $ zip v4 $ repeat ()
-- >>> findMatch "133.4.0.0/15" rt :: [(AddrRange IPv4,())]
-- [(133.4.0.0/16,()),(133.5.0.0/16,()),(133.5.16.0/24,()),(133.5.23.0/24,())]
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 = m (AddrRange k, a)
forall a. m a
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 AddrRange k -> AddrRange k -> Bool
forall a. Addr a => AddrRange a -> AddrRange a -> Bool
>:> AddrRange k
k2 = AddrRange k -> IPRTable k a -> m (AddrRange k, 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 m (AddrRange k, a) -> m (AddrRange k, a) -> m (AddrRange k, a)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AddrRange k -> IPRTable k a -> m (AddrRange k, 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 AddrRange k -> AddrRange k -> Bool
forall a. Addr a => AddrRange a -> AddrRange a -> Bool
>:> AddrRange k
k1 = AddrRange k -> IPRTable k a -> m (AddrRange k, 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 m (AddrRange k, a) -> m (AddrRange k, a) -> m (AddrRange k, a)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AddrRange k -> IPRTable k a -> m (AddrRange k, 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 = m (AddrRange k, a)
forall a. m a
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 AddrRange k -> AddrRange k -> Bool
forall a. Addr a => AddrRange a -> AddrRange a -> Bool
>:> AddrRange k
k2 = (AddrRange k, a) -> m (AddrRange k, a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AddrRange k
k2, a
vl) m (AddrRange k, a) -> m (AddrRange k, a) -> m (AddrRange k, a)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AddrRange k -> IPRTable k a -> m (AddrRange k, 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 m (AddrRange k, a) -> m (AddrRange k, a) -> m (AddrRange k, a)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AddrRange k -> IPRTable k a -> m (AddrRange k, 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 AddrRange k -> AddrRange k -> Bool
forall a. Addr a => AddrRange a -> AddrRange a -> Bool
>:> AddrRange k
k1 = AddrRange k -> IPRTable k a -> m (AddrRange k, 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 m (AddrRange k, a) -> m (AddrRange k, a) -> m (AddrRange k, a)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AddrRange k -> IPRTable k a -> m (AddrRange k, 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 = m (AddrRange k, a)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
A.empty

----------------------------------------------------------------

-- |
--   The 'fromList' function creates a new IP routing table from
--   a list of a pair of 'IPrange' and value.
fromList :: Routable k => [(AddrRange k, a)] -> IPRTable k a
fromList :: forall k a. Routable k => [(AddrRange k, a)] -> IPRTable k a
fromList = (IPRTable k a -> (AddrRange k, a) -> IPRTable k a)
-> IPRTable k a -> [(AddrRange k, a)] -> IPRTable k a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\IPRTable k a
s (AddrRange k
k, a
v) -> AddrRange k -> a -> IPRTable k a -> IPRTable k a
forall k a.
Routable k =>
AddrRange k -> a -> IPRTable k a -> IPRTable k a
insert AddrRange k
k a
v IPRTable k a
s) IPRTable k a
forall k a. Routable k => IPRTable k a
empty

-- |
--   The 'toList' function creates a list of a pair of 'AddrRange' and
--   value from an IP routing table.
toList :: Routable k => IPRTable k a -> [(AddrRange k, a)]
toList :: forall k a. Routable k => IPRTable k a -> [(AddrRange k, a)]
toList = (IPRTable k a -> [(AddrRange k, a)] -> [(AddrRange k, a)])
-> [(AddrRange k, a)] -> IPRTable k a -> [(AddrRange k, a)]
forall k a b. (IPRTable k a -> b -> b) -> b -> IPRTable k a -> b
foldt IPRTable k a -> [(AddrRange k, a)] -> [(AddrRange k, a)]
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) (AddrRange k, b) -> [(AddrRange k, b)] -> [(AddrRange k, b)]
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) = (IPRTable k a -> b -> b) -> b -> IPRTable k a -> b
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) -> b -> IPRTable k a -> b
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

-- | /O(n)/. Fold the keys and values in the IPRTable using the given
--   left-associative binary operator.
--   This function is equivalent to Data.Map.foldlWithKey with necessary to
--   IPRTable changes.
--   Since: 1.7.5
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 #-}

-- | /O(n)/. Fold the keys and values in the IPRTable using the given
--   right-associative binary operator.
--   This function is equivalent to Data.Map.foldrWithKey with necessary to
--   IPRTable changes.
--   Since: 1.7.5
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 #-}