]> gitweb.michael.orlitzky.com - dead/harbl.git/commitdiff
Move the IPv4 pattern stuff into its own module and begin a real test suite.
authorMichael Orlitzky <michael@orlitzky.com>
Sat, 31 Jan 2015 02:06:37 +0000 (21:06 -0500)
committerMichael Orlitzky <michael@orlitzky.com>
Sat, 31 Jan 2015 02:06:37 +0000 (21:06 -0500)
harbl.cabal
src/IPv4Pattern.hs [new file with mode: 0644]
src/Main.hs
test/Doctests.hs [new file with mode: 0644]
test/TestSuite.hs [new file with mode: 0644]

index b497fb63efb6c73b63940917ed72d682b2db87ae..50695012dc5b8efdbb2078388aff53dcd221ea08 100644 (file)
@@ -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 (file)
index 0000000..9f8c87f
--- /dev/null
@@ -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
index 6f8572d6e1a287e01d3b28f0d77eb271ee610eb5..4c8cbecf3de53cc0bb2065532e16b560393a863e 100644 (file)
@@ -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 (file)
index 0000000..d183b4b
--- /dev/null
@@ -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 (file)
index 0000000..83a4dec
--- /dev/null
@@ -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