You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
62 lines
1.7 KiB
62 lines
1.7 KiB
{-# 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" |
|
|
|
|