-- | network combinatoring 

module Network.Subnet.Network where

import Network.Subnet.Binary
import Network.Subnet.Ip
import Data.List
import Data.List.Split
-- Here is the meat and potatos

-- as long as the subnet has 1 it adds the number from the IP up to the point
-- where there is a 0 in the subnet mask at which point it repeats 0 for the
-- length of the remainng IP

-- Perform bit-wise anding to calculate the subnet network address of a
-- specific subnet

network :: LogIp -> SubnetMask -> LogIp
network x y = showLogIp $ (readLogIp x) .&&. (readSubnetMask y)
nextNetwork :: LogIp -> SubnetMask -> LogIp
nextNetwork x y
  | network x y == network (addOneLogIp x) y = nextNetwork (addOneLogIp x) y
  | otherwise = addOneLogIp x

-- lists all known address in subnet
allInSubnet :: LogIp -> SubnetMask -> [LogIp]
allInSubnet x y = f (network x y) y
  where
    f x y = takeWhile (/= (nextNetwork x y)) $ iterate addOneLogIp x

broadcast :: LogIp -> SubnetMask -> LogIp
broadcast x y = last $ allInSubnet x y
hosts :: LogIp -> SubnetMask -> [LogIp]
hosts x y = (tail . init) $ allInSubnet x y

-- TODO : make this idiotic function prettier
summarize :: [LogIp] -> SubnetMask
summarize = mkSubnetMask .
            getLogIp .
            showLogIp .
            mkBinary .
            k .
            takeWhile (/='0') .
            map (\x -> if x then '1' else '0') .
            map g .
            transpose .
            map (getBinary . readLogIp)
  where
    f = getBinary . readLogIp
    g xs = all (== head xs) (tail xs)
    k x | length x < 32 = k $ x ++ "0"
        | True = x