From 1a4b97540833ef71bbe1de92dba03023322ba62a Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Fri, 30 Jan 2015 21:06:37 -0500 Subject: [PATCH] Move the IPv4 pattern stuff into its own module and begin a real test suite. --- harbl.cabal | 62 ++++++++++++++- src/IPv4Pattern.hs | 193 +++++++++++++++++++++++++++++++++++++++++++++ src/Main.hs | 119 +--------------------------- test/Doctests.hs | 13 +++ test/TestSuite.hs | 8 ++ 5 files changed, 276 insertions(+), 119 deletions(-) create mode 100644 src/IPv4Pattern.hs create mode 100644 test/Doctests.hs create mode 100644 test/TestSuite.hs diff --git a/harbl.cabal b/harbl.cabal index b497fb6..5069501 100644 --- a/harbl.cabal +++ b/harbl.cabal @@ -16,11 +16,16 @@ description: executable harbl build-depends: base >= 4.6 && < 5, - parsec >= 3 + parsec >= 3, + tasty >= 0.8, + tasty-hunit >= 0.8 main-is: Main.hs + other-modules: + IPv4Pattern + hs-source-dirs: src/ @@ -42,6 +47,61 @@ executable harbl -fprof-auto -fprof-cafs + +test-suite testsuite + type: exitcode-stdio-1.0 + hs-source-dirs: src test + main-is: TestSuite.hs + build-depends: + base >= 4.6 && < 5, + parsec >= 3, + tasty >= 0.8, + tasty-hunit >= 0.8 + + -- It's not entirely clear to me why I have to reproduce all of this. + ghc-options: + -Wall + -fwarn-hi-shadowing + -fwarn-missing-signatures + -fwarn-name-shadowing + -fwarn-orphans + -fwarn-type-defaults + -fwarn-tabs + -fwarn-incomplete-record-updates + -fwarn-monomorphism-restriction + -fwarn-unused-do-bind + -O2 + + +test-suite doctests + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Doctests.hs + build-depends: + base >= 4.6 && < 5, + -- Additional test dependencies. + doctest >= 0.9, + filemanip >= 0.3.6 + + -- It's not entirely clear to me why I have to reproduce all of this. + ghc-options: + -Wall + -fwarn-hi-shadowing + -fwarn-missing-signatures + -fwarn-name-shadowing + -fwarn-orphans + -fwarn-type-defaults + -fwarn-tabs + -fwarn-incomplete-record-updates + -fwarn-monomorphism-restriction + -fwarn-unused-do-bind + -rtsopts + -threaded + -optc-O3 + -optc-march=native + -O2 + + source-repository head type: git location: http://michael.orlitzky.com/git/harbl.git diff --git a/src/IPv4Pattern.hs b/src/IPv4Pattern.hs new file mode 100644 index 0000000..9f8c87f --- /dev/null +++ b/src/IPv4Pattern.hs @@ -0,0 +1,193 @@ +-- | 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 diff --git a/src/Main.hs b/src/Main.hs index 6f8572d..4c8cbec 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,124 +1,7 @@ module Main where -import Text.Parsec -import Text.Parsec.String ( Parser ) - -newtype IPv4Octet = IPv4Octet Int - deriving (Show) - -data IPv4SequenceMember = - IPv4SequenceMemberOctet IPv4Octet - | IPv4SequenceMemberOctetRange IPv4Octet IPv4Octet - deriving (Show) - -data IPv4Sequence = - IPv4SequenceSingleMember IPv4SequenceMember - | IPv4SequenceOptions IPv4SequenceMember IPv4Sequence - deriving (Show) - -data IPv4Field = IPv4FieldOctet IPv4Octet | IPv4FieldSequence IPv4Sequence - deriving (Show) - -data IPv4Pattern = - IPv4Pattern IPv4Field IPv4Field IPv4Field IPv4Field - deriving (Show) - --- 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 - -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 - - -v4sequence :: Parser IPv4Sequence -v4sequence = try both <|> just_one - where - both = do - sm <- v4seq_member - _ <- char ';' - s <- v4sequence - return $ IPv4SequenceOptions sm s - - just_one = fmap IPv4SequenceSingleMember v4seq_member - - -v4field :: Parser IPv4Field -v4field = just_octet <|> brackets - where - just_octet = fmap IPv4FieldOctet v4octet - - brackets = do - _ <- char '[' - s <- v4sequence - _ <- char ']' - return $ IPv4FieldSequence s - -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 +import IPv4Pattern main :: IO () main = do diff --git a/test/Doctests.hs b/test/Doctests.hs new file mode 100644 index 0000000..d183b4b --- /dev/null +++ b/test/Doctests.hs @@ -0,0 +1,13 @@ +module Main +where + +import Test.DocTest +import System.FilePath.Find ((==?), always, extension, find) + +find_sources :: IO [FilePath] +find_sources = find always (extension ==? ".hs") "src/" + +main :: IO () +main = do + sources <- find_sources + doctest $ ["-isrc", "-idist/build/autogen"] ++ sources diff --git a/test/TestSuite.hs b/test/TestSuite.hs new file mode 100644 index 0000000..83a4dec --- /dev/null +++ b/test/TestSuite.hs @@ -0,0 +1,8 @@ +import Test.Tasty ( TestTree, defaultMain, testGroup ) +import IPv4Pattern ( v4octet_tests ) + +tests :: TestTree +tests = testGroup "All Tests" [ v4octet_tests ] + +main :: IO () +main = defaultMain tests -- 2.44.2