{-# 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 #-}