X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FCidr.hs;h=266b7c57f8a8e8318124a2518900de75a4d166ca;hb=7d9a55cb4f217bada3c66f585cd1ce35dc564fb1;hp=ab1ef51cce7af37bb5e3bdbec269a512ca59976f;hpb=fbd4a98a9a0996d41e3715a2698114b8a061f2cd;p=hath.git diff --git a/src/Cidr.hs b/src/Cidr.hs index ab1ef51..266b7c5 100644 --- a/src/Cidr.hs +++ b/src/Cidr.hs @@ -1,7 +1,7 @@ module Cidr ( Cidr(..), cidr_from_string, - contains + combine_all ) where import IPv4Address @@ -85,9 +85,27 @@ contains _ (Cidr IPv4Address.None _) = False -- address and see if the result is the same as cidr1's mask applied -- to cidr1's address. -- -contains (Cidr addr1 (Maskbits mbits1)) (Cidr addr2 (Maskbits mbits2)) +contains (Cidr addr1 mbits1) (Cidr addr2 mbits2) | mbits1 > mbits2 = False | otherwise = addr1masked == addr2masked where - addr1masked = apply_mask addr1 (Maskbits mbits1) - addr2masked = apply_mask addr2 (Maskbits mbits1) + addr1masked = apply_mask addr1 mbits1 + addr2masked = apply_mask addr2 mbits1 + + +contains_proper :: Cidr -> Cidr -> Bool +contains_proper cidr1 cidr2 = + (cidr1 `contains` cidr2) && (not (cidr1 == cidr2)) + + +-- A CIDR range is redundant (with respect to the given list) if +-- another CIDR range in that list properly contains it. +redundant :: [Cidr] -> Cidr -> Bool +redundant cidrlist cidr = any ((flip contains_proper) cidr) cidrlist + + +-- We want to get rid of all the Cidrs that are properly contained +-- in some other Cidr. +combine_all :: [Cidr] -> [Cidr] +combine_all cidrs = + filter (not . (redundant cidrs)) cidrs