-- | LogIp and SubnetMask 

module Network.Subnet.Ip where

import Network.Subnet.Binary
import Data.List
import Data.List.Split


newtype SubnetMask = SubnetMask { getSubnetMask :: String }
  deriving (Ord, Show, Eq)

newtype LogIp = LogIp { getLogIp :: String }
   deriving (Ord, Show, Eq)
-- | TODO
-- Subnetmasks take non base2 digits
-- check hosts.hs, hosts or hosts.exe
mkSubnetMask :: String -> SubnetMask
mkSubnetMask x | isSubnetMask x = SubnetMask x
               | otherwise = error $ x ++ " Not a subnet mask"
mkLogIp :: String -> LogIp
mkLogIp x | isLogIp x = LogIp x
          | otherwise = error $ x ++ " is not a log IP"
showIp :: [String] -> String
showIp = intercalate "."
readIp :: String -> [String]
readIp = splitOn "."                              

readLogIp :: LogIp -> Binary
readLogIp = fixets . mkBinary . concat . map (getBinary . fixets . toBinary . read) . readIp . getLogIp
readSubnetMask :: SubnetMask -> Binary
readSubnetMask = fixets . mkBinary . concat . map (getBinary . fixets . toBinary . read) . readIp . getSubnetMask

showLogIp :: Binary -> LogIp
showLogIp = mkLogIp . intercalate "." . map (show . fromBinary . mkBinary) . chunksOf 8 . getBinary
showSubnetMask :: Binary -> SubnetMask
showSubnetMask = mkSubnetMask . intercalate "." . map (show . fromBinary . mkBinary) . chunksOf 8 . getBinary
modifyLogIp :: (String -> String) -> LogIp -> LogIp
modifyLogIp f = mkLogIp . f . getLogIp

addOneLogIp :: LogIp -> LogIp
addOneLogIp = showLogIp . addOne . readLogIp

isLogIp :: String -> Bool
isLogIp = f .
          map read .
          readIp .
          g
  where
    g :: String -> String
    g x = if length (readIp x) == 4 then x else x ++ " is not a proper LogIp"
    f (x:xs) = (x >= 0 && x <= 255) && f xs
    f [] = True
isSubnetMask :: String -> Bool
isSubnetMask = f .
               removeInvalidZeros .
               map read .
               readIp .
               g
  where
    g x = if length (readIp x) == 4 then x else x ++ " is not a proper subnetmask"
    f (x:xs) | x `elem` possible = True && f xs
             | otherwise = False
    f [] = True
    possible = [255,254,252,248,240,224,192,128,0]
removeInvalidZeros :: (Num a, Eq a) => [a] -> [a]
removeInvalidZeros (x:xs) | x == 0 = 0 : take (length xs) (repeat 0) 
                          | otherwise = x : removeInvalidZeros xs 
removeInvalidZeros [] = []