theta/src/Packets/MacAddress.hs

{-# LANGUAGE DeriveDataTypeable #-}

module Packets.MacAddress
  (
    MacAddress(..)
  , broadcastMac
  , putMacAddress
  , parseMac
  , mac
  ) where

import           Control.Error.Util        (hush)
import           Data.Binary               (putWord8)
import           Data.Binary.Put           (PutM)
import           Data.Char                 (digitToInt)
import           Data.Data                 (Data)
import           Data.Word                 (Word8)
import           Language.Haskell.TH.Quote (QuasiQuoter (..), dataToExpQ)
import           Text.Parsec               (count, hexDigit, parse)
import           Text.Parsec.Char          (char)

data MacAddress =
  MacAddress Word8 Word8 Word8 Word8 Word8 Word8
  deriving (Show, Eq, Data)

putMacAddress :: MacAddress -> PutM ()
putMacAddress (MacAddress b1 b2 b3 b4 b5 b6) =
  mapM_ putWord8 [b1, b2, b3, b4, b5, b6]

broadcastMac :: MacAddress
broadcastMac = MacAddress 0xff 0xff 0xff 0xff 0xff 0xff

parseMac :: String -> Maybe MacAddress
parseMac = hush . parse macParser ""
  where
    macParser = do
      b1 <- parseHexByte
      rest <- count 5 $ do
        _ <- char ':'
        parseHexByte
      case rest of
        [b2, b3, b4, b5, b6] -> return $ MacAddress b1 b2 b3 b4 b5 b6
        _                    -> fail "Unable to parse MAC address"
    parseHexByte = do
      d1 <- hexDigit
      d2 <- hexDigit
      return $ toEnum (digitToInt d1) * 16 + toEnum (digitToInt d2)

mac :: QuasiQuoter
mac = QuasiQuoter
  {
    quoteExp = quoteMac
  , quotePat = undefined
  , quoteDec = undefined
  , quoteType = undefined
  }
  where
    quoteMac s =
      case parseMac s of
        Just m' -> dataToExpQ (const Nothing) m'
        _       -> fail "Unable to parse MAC address"