-- | Bitnary helper shit 

module Network.Subnet.Binary
       (Binary (..)
      , mkBinary
      , toBinary
      , fromBinary
      , (.&&.)
      , (.||.)
      , (.+.)
      , (.-.)
      , addOne
      , addInt
      , fixets
      , antifixets
      , modifyBinary) where

import Data.List
import Data.List.Split
newtype Binary = Binary { getBinary:: String }
   deriving (Ord, Show, Eq)

mkBinary :: String -> Binary
mkBinary x | all (== True) $ map (\x -> x == '1' || x == '0') x = Binary x
           | otherwise = error "qasldkfasdf"

toBinary :: (Ord a, Num a) => a -> Binary
toBinary 0 = fixets $ mkBinary "0"
toBinary x = fixets $ mkBinary $ f x $ reverse $ takeWhile (<= x) base2
  where
    f x (n:ns)
      | x >= n = '1' : f (x - n) ns
      | otherwise = '0' : f x ns
    f 0 x = take (length x) $ repeat '0'
    f x [] = error "qwer"

fromBinary :: Num a => Binary -> a
fromBinary x = f (getBinary x) $ reverse $ take (length (getBinary x)) base2
  where
    f (x:xs) (n:ns) | x == '1' = n + f xs ns
                    | True = f xs ns
    f _ _ = 0

octet :: (Ord a, Num a) => a -> [Binary] 
octet = map mkBinary . chunksOf 8 . getBinary . fixets . toBinary

(.&&.) :: Binary -> Binary -> Binary
(.&&.) x y = mkBinary $ go (getBinary x) (getBinary y)
  where
    go (n:ns) (m:ms) | (n == '1') && (m == '1') = '1':go ns ms
                     | otherwise = '0':go ns ms
    go _ _ = []
(.||.) :: Binary -> Binary -> Binary
(.||.) x y = mkBinary $ go (getBinary x) (getBinary y)
  where
    go (n:ns) (m:ms) | (n == '1') || (m == '1') = '1' : go ns ms
                     | otherwise = '0' : go ns ms
    go _ _ = []

binop :: (Num a, Ord a) => (a -> a -> a) -> Binary -> Binary -> Binary
binop f x y = toBinary $ f (fromBinary x) (fromBinary y)
(.+.) :: Binary -> Binary -> Binary
(.+.) = binop (+)
(.-.) :: Binary -> Binary -> Binary
(.-.) = binop (-)
addOne :: Binary -> Binary
addOne = addInt 1
addInt :: (Num a, Ord a) => a -> Binary -> Binary
addInt x y = (toBinary x) .+. y
base2 :: Num a => [a]
base2 = map (2^) [0..63]
fixets :: Binary -> Binary
fixets x = mkBinary $ go (getBinary x)
  where
    go x | mod (length x) 8 == 0 = x
         | True = go ('0':x)

antifixets :: Binary -> Binary
antifixets = modifyBinary go
  where
    go x | mod (length x) 8 == 0 = x
         | otherwise = go (x ++ "0")
modifyBinary :: (String -> String) -> Binary -> Binary
modifyBinary f = mkBinary . f . getBinary