theta/src/Types.hs

{-# 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"