src/Main.hs

   1 module Main
   2 where
   3
   4 import Text.Parsec
   5 import Text.Parsec.String ( Parser )
   6
   7 newtype IPv4Octet = IPv4Octet Int
   8   deriving (Show)
   9
  10 data IPv4SequenceMember =
  11   IPv4SequenceMemberOctet IPv4Octet
  12   | IPv4SequenceMemberOctetRange IPv4Octet IPv4Octet
  13   deriving (Show)
  14
  15 data IPv4Sequence =
  16   IPv4SequenceSingleMember IPv4SequenceMember
  17   | IPv4SequenceOptions IPv4SequenceMember IPv4Sequence
  18   deriving (Show)
  19
  20 data IPv4Field = IPv4FieldOctet IPv4Octet | IPv4FieldSequence IPv4Sequence
  21   deriving (Show)
  22
  23 data IPv4Pattern =
  24   IPv4Pattern IPv4Field IPv4Field IPv4Field IPv4Field
  25   deriving (Show)
  26
  27 -- An IPv4 address pattern has four fields separated by ".".  Each
  28 -- field is either a decimal number, or a sequence inside "[]" that
  29 -- contains one or more ";"-separated decimal numbers or number..number
  30 -- ranges.
  31 --
  32 -- Thus, any pattern field can be a sequence inside "[]", but a "[]"
  33 -- sequence cannot span multiple address fields, and a pattern field
  34 -- cannot contain both a number and a "[]" sequence at the same time.
  35 --
  36 -- This means that the pattern 1.2.[3.4] is not valid (the sequence
  37 -- [3.4] cannot span two address fields) and the pattern 1.2.3.3[6..9]
  38 -- is also not valid (the last field cannot be both number 3 and
  39 -- sequence [6..9] at the same time).
  40 --
  41 -- The syntax for IPv4 patterns is as follows:
  42 --
  43 -- v4pattern = v4field "." v4field "." v4field "." v4field
  44 -- v4field = v4octet | "[" v4sequence "]"
  45 -- v4octet = any decimal number in the range 0 through 255
  46 -- v4sequence = v4seq_member | v4sequence ";" v4seq_member
  47 -- v4seq_member = v4octet | v4octet ".." v4octet
  48
  49 v4seq_member :: Parser IPv4SequenceMember
  50 v4seq_member = try both <|> just_one
  51   where
  52     both = do
  53       oct1 <- v4octet
  54       _ <- string ".."
  55       oct2 <- v4octet
  56       return $ IPv4SequenceMemberOctetRange oct1 oct2
  57
  58     just_one = fmap IPv4SequenceMemberOctet v4octet
  59
  60
  61 v4sequence :: Parser IPv4Sequence
  62 v4sequence = try both <|> just_one
  63   where
  64     both = do
  65       sm <- v4seq_member
  66       _ <- char ';'
  67       s <- v4sequence
  68       return $ IPv4SequenceOptions sm s
  69
  70     just_one = fmap IPv4SequenceSingleMember v4seq_member
  71
  72
  73 v4field :: Parser IPv4Field
  74 v4field = just_octet <|> brackets
  75   where
  76     just_octet = fmap IPv4FieldOctet v4octet
  77
  78     brackets = do
  79       _ <- char '['
  80       s <- v4sequence
  81       _ <- char ']'
  82       return $ IPv4FieldSequence s
  83
  84 v4octet :: Parser IPv4Octet
  85 v4octet = fmap (IPv4Octet . read) $ many1 digit
  86
  87 v4pattern :: Parser IPv4Pattern
  88 v4pattern = do
  89   field1 <- v4field
  90   _ <- char '.'
  91   field2 <- v4field
  92   _ <- char '.'
  93   field3 <- v4field
  94   _ <- char '.'
  95   field4 <- v4field
  96   return $ IPv4Pattern field1 field2 field3 field4
  97
  98
  99 sequence_members :: IPv4SequenceMember -> [String]
 100 sequence_members (IPv4SequenceMemberOctet (IPv4Octet i)) = [show i]
 101 sequence_members (IPv4SequenceMemberOctetRange (IPv4Octet start) (IPv4Octet end)) =
 102   [show x | x <- [start..end]]
 103
 104 sequences :: IPv4Sequence -> [String]
 105 sequences (IPv4SequenceSingleMember sm) = sequence_members sm
 106 sequences (IPv4SequenceOptions sm s) =
 107   (sequence_members sm) ++ (sequences s)
 108
 109
 110 fields :: IPv4Field -> [String]
 111 fields (IPv4FieldOctet (IPv4Octet i)) = [show i]
 112 fields (IPv4FieldSequence s) = sequences s
 113
 114
 115 addresses :: IPv4Pattern -> [String]
 116 addresses (IPv4Pattern field1 field2 field3 field4) = do
 117   f1 <- fields field1
 118   f2 <- fields field2
 119   f3 <- fields field3
 120   f4 <- fields field4
 121   return $ f1 ++ "." ++ f2 ++ "." ++ f3 ++ "." ++ f4
 122
 123 main :: IO ()
 124 main = do
 125   putStrLn "Hello, world!"