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.
78 lines
1.9 KiB
78 lines
1.9 KiB
{-# LANGUAGE DeriveDataTypeable #-} |
|
module Types |
|
( |
|
mkVlanId |
|
, vlanId |
|
, VlanId |
|
, IpAddress |
|
, ip |
|
) where |
|
|
|
import Control.Error (hush) |
|
import Data.Data (Data) |
|
import GHC.Word (Word8) |
|
import Language.Haskell.TH.Quote (QuasiQuoter (..)) |
|
import Language.Haskell.TH.Syntax (dataToExpQ) |
|
import Text.Parsec (char, digit, many1, parse) |
|
import Text.Read (readMaybe) |
|
|
|
newtype VlanId = VlanId Int |
|
deriving (Show, Eq, Data) |
|
|
|
mkVlanId :: Int -> Maybe VlanId |
|
mkVlanId i = |
|
if i >= minVlanId && i <= maxVlanId |
|
then Just $ VlanId i |
|
else Nothing |
|
where |
|
minVlanId = 1 |
|
maxVlanId = 4094 |
|
|
|
vlanId :: QuasiQuoter |
|
vlanId = QuasiQuoter |
|
{ |
|
quoteExp = parseVlanId |
|
, quotePat = undefined |
|
, quoteType = undefined |
|
, quoteDec = undefined |
|
} |
|
where |
|
parseVlanId s = |
|
case readMaybe s >>= mkVlanId of |
|
Just vid -> dataToExpQ (const Nothing) vid |
|
Nothing -> fail "Invalid VlanId" |
|
|
|
|
|
newtype IpAddress = IpAddress (Word8, Word8, Word8, Word8) |
|
deriving (Eq, Data) |
|
|
|
instance Show IpAddress where |
|
show (IpAddress (a, b, c, d)) = show a <> "." <> show b <> "." <> show c <> "." <> show d |
|
|
|
parseIp :: String -> Maybe IpAddress |
|
parseIp = hush . parse ipParser "" |
|
where |
|
ipParser = do |
|
a <- read <$> many1 digit |
|
_ <- char '.' |
|
b <- read <$> many1 digit |
|
_ <- char '.' |
|
c <- read <$> many1 digit |
|
_ <- char '.' |
|
d <- read <$> many1 digit |
|
return $ IpAddress (a, b, c, d) |
|
|
|
ip :: QuasiQuoter |
|
ip = QuasiQuoter |
|
{ |
|
quoteExp = doParseIp |
|
, quotePat = undefined |
|
, quoteType = undefined |
|
, quoteDec = undefined |
|
} |
|
where |
|
doParseIp s = do |
|
case parseIp s of |
|
Just m' -> dataToExpQ (const Nothing) m' |
|
_ -> fail "Unable to parse MAC address" |
|
|
|
|