--- /dev/null
+-- | An IPv4 address pattern has four fields separated by ".". Each
+-- field is either a decimal number, or a sequence inside "[]" that
+-- contains one or more ";"-separated decimal numbers or
+-- number..number ranges.
+--
+-- Thus, any pattern field can be a sequence inside "[]", but a "[]"
+-- sequence cannot span multiple address fields, and a pattern field
+-- cannot contain both a number and a "[]" sequence at the same
+-- time.
+--
+-- This means that the pattern 1.2.[3.4] is not valid (the sequence
+-- [3.4] cannot span two address fields) and the pattern
+-- 1.2.3.3[6..9] is also not valid (the last field cannot be both
+-- number 3 and sequence [6..9] at the same time).
+--
+-- The syntax for IPv4 patterns is as follows:
+--
+-- v4pattern = v4field "." v4field "." v4field "." v4field
+-- v4field = v4octet | "[" v4sequence "]"
+-- v4octet = any decimal number in the range 0 through 255
+-- v4sequence = v4seq_member | v4sequence ";" v4seq_member
+-- v4seq_member = v4octet | v4octet ".." v4octet
+--
+module IPv4Pattern
+where
+
+import Test.Tasty ( TestTree, testGroup )
+import Test.Tasty.HUnit ( (@?=), testCase )
+import Text.Parsec
+import Text.Parsec.String ( Parser )
+
+
+newtype IPv4Octet = IPv4Octet Int
+ deriving (Eq, Show)
+
+data IPv4SequenceMember =
+ IPv4SequenceMemberOctet IPv4Octet
+ | IPv4SequenceMemberOctetRange IPv4Octet IPv4Octet
+ deriving (Eq, Show)
+
+data IPv4Sequence =
+ IPv4SequenceSingleMember IPv4SequenceMember
+ | IPv4SequenceOptions IPv4SequenceMember IPv4Sequence
+ deriving (Eq, Show)
+
+
+data IPv4Field = IPv4FieldOctet IPv4Octet | IPv4FieldSequence IPv4Sequence
+ deriving (Eq, Show)
+
+data IPv4Pattern =
+ IPv4Pattern IPv4Field IPv4Field IPv4Field IPv4Field
+ deriving (Eq, Show)
+
+
+-- | Parse an IPv4 \"sequence member\". A sequence member is either an
+-- octet, or a start..end sequence (like an enumeration, in Haskell).
+--
+-- ==== _Examples_
+--
+-- >>> parse v4seq_member "" "127"
+-- Right (IPv4SequenceMemberOctet (IPv4Octet 127))
+--
+-- >>> parse v4seq_member "" "1..5"
+-- Right (IPv4SequenceMemberOctetRange (IPv4Octet 1) (IPv4Octet 5))
+--
+v4seq_member :: Parser IPv4SequenceMember
+v4seq_member = try both <|> just_one
+ where
+ both = do
+ oct1 <- v4octet
+ _ <- string ".."
+ oct2 <- v4octet
+ return $ IPv4SequenceMemberOctetRange oct1 oct2
+
+ just_one = fmap IPv4SequenceMemberOctet v4octet
+
+
+-- | Parse an IPv4 \"sequence\". A sequence is whatever is allowed
+-- within square brackets. Basically it can be three things:
+--
+-- * An octet (number).
+-- * A range of addresses in start..end format.
+-- * An alternative, separated by a semicolon, where each side
+-- contains one of the previous two options.
+--
+-- ==== _Examples_
+--
+-- >>> parse v4sequence "" "1"
+-- Right (IPv4SequenceSingleMember (IPv4SequenceMemberOctet (IPv4Octet 1)))
+--
+-- >>> parse v4sequence "" "1..2"
+-- Right (IPv4SequenceSingleMember (IPv4SequenceMemberOctetRange (IPv4Octet 1) (IPv4Octet 2)))
+--
+-- >>> parse v4sequence "" "1..2;8"
+-- Right (IPv4SequenceOptions (IPv4SequenceMemberOctetRange (IPv4Octet 1) (IPv4Octet 2)) (IPv4SequenceSingleMember (IPv4SequenceMemberOctet (IPv4Octet 8))))
+--
+v4sequence :: Parser IPv4Sequence
+v4sequence = try both <|> just_one -- Maybe sepBy is appropriate here?
+ where
+ both = do
+ sm <- v4seq_member
+ _ <- char ';'
+ s <- v4sequence
+ return $ IPv4SequenceOptions sm s
+
+ just_one = fmap IPv4SequenceSingleMember v4seq_member
+
+
+-- | Parse an IPv4 \"field\", which is either a boring old octet, or a
+-- 'v4sequence' within square brackets.
+--
+-- ==== _Examples_
+--
+-- >>> parse v4field "" "127"
+-- Right (IPv4FieldOctet (IPv4Octet 127))
+--
+-- >>> parse v4field "" "[127]"
+-- Right (IPv4FieldSequence (IPv4SequenceSingleMember (IPv4SequenceMemberOctet (IPv4Octet 127))))
+--
+v4field :: Parser IPv4Field
+v4field = just_octet <|> brackets
+ where
+ just_octet = fmap IPv4FieldOctet v4octet
+
+ brackets = do
+ _ <- char '['
+ s <- v4sequence
+ _ <- char ']'
+ return $ IPv4FieldSequence s
+
+
+-- | Parse an IPv4 octet, which should contain a string of digits.
+--
+-- ==== _Examples_
+--
+-- >>> parse v4octet "" "127"
+-- Right (IPv4Octet 127)
+--
+v4octet :: Parser IPv4Octet
+v4octet = fmap (IPv4Octet . read) $ many1 digit
+
+v4pattern :: Parser IPv4Pattern
+v4pattern = do
+ field1 <- v4field
+ _ <- char '.'
+ field2 <- v4field
+ _ <- char '.'
+ field3 <- v4field
+ _ <- char '.'
+ field4 <- v4field
+ return $ IPv4Pattern field1 field2 field3 field4
+
+
+sequence_members :: IPv4SequenceMember -> [String]
+sequence_members (IPv4SequenceMemberOctet (IPv4Octet i)) = [show i]
+sequence_members (IPv4SequenceMemberOctetRange (IPv4Octet start) (IPv4Octet end)) =
+ [show x | x <- [start..end]]
+
+sequences :: IPv4Sequence -> [String]
+sequences (IPv4SequenceSingleMember sm) = sequence_members sm
+sequences (IPv4SequenceOptions sm s) =
+ (sequence_members sm) ++ (sequences s)
+
+
+fields :: IPv4Field -> [String]
+fields (IPv4FieldOctet (IPv4Octet i)) = [show i]
+fields (IPv4FieldSequence s) = sequences s
+
+
+addresses :: IPv4Pattern -> [String]
+addresses (IPv4Pattern field1 field2 field3 field4) = do
+ f1 <- fields field1
+ f2 <- fields field2
+ f3 <- fields field3
+ f4 <- fields field4
+ return $ f1 ++ "." ++ f2 ++ "." ++ f3 ++ "." ++ f4
+
+
+-- Tests
+
+v4octet_tests :: TestTree
+v4octet_tests =
+ testGroup
+ "v4octet tests"
+ [ test_v4octet_single_digit_parsed ]
+
+test_v4octet_single_digit_parsed :: TestTree
+test_v4octet_single_digit_parsed =
+ testCase "a single digit is parsed as a v4octet" $ do
+ -- Whatever, it's a test.
+ let (Right actual) = parse v4octet "" "1"
+ let expected = IPv4Octet 1
+ actual @?= expected
projects / dead / harbl.git / blobdiff