From: Michael Orlitzky Date: Tue, 14 Jul 2015 02:28:37 +0000 (-0400) Subject: Separate the Network.DNS.RBL.Weight module and fix the doctests. X-Git-Url: https://gitweb.michael.orlitzky.com/?a=commitdiff_plain;h=67a990c746599a0f64cffa8dd92157626fc4654e;p=dead%2Fharbl.git Separate the Network.DNS.RBL.Weight module and fix the doctests. --- diff --git a/harbl.cabal b/harbl.cabal index 91ae360..a970d30 100644 --- a/harbl.cabal +++ b/harbl.cabal @@ -26,6 +26,7 @@ library exposed-modules: Network.DNS.RBL Network.DNS.RBL.Tests + Network.DNS.RBL.Weight other-modules: Network.DNS.RBL.Domain.Digit diff --git a/harbl/src/Network/DNS/RBL/Domain/Domain.hs b/harbl/src/Network/DNS/RBL/Domain/Domain.hs index 1049e88..3ead2de 100644 --- a/harbl/src/Network/DNS/RBL/Domain/Domain.hs +++ b/harbl/src/Network/DNS/RBL/Domain/Domain.hs @@ -48,8 +48,8 @@ import Network.DNS.RBL.Reversible ( Reversible(..) ) -- DomainRoot -- -- >>> import Text.Parsec ( parse ) --- >>> let s = parse subdomain "" "x" --- >>> DomainName s +-- >>> let (Right r) = parse subdomain "" "x" +-- >>> DomainName r -- DomainName (SubdomainSingleLabel (Label (LetDigLetter (Letter 'x')) Nothing)) -- data Domain = @@ -66,8 +66,8 @@ data Domain = -- "" -- -- >>> import Text.Parsec ( parse ) --- >>> let s = parse subdomain "" "x" --- >>> pretty_print $ DomainName s +-- >>> let (Right r) = parse subdomain "" "x" +-- >>> pretty_print $ DomainName r -- x -- instance Pretty Domain where diff --git a/harbl/src/Network/DNS/RBL/Site.hs b/harbl/src/Network/DNS/RBL/Site.hs index ef0df31..c9ea26c 100644 --- a/harbl/src/Network/DNS/RBL/Site.hs +++ b/harbl/src/Network/DNS/RBL/Site.hs @@ -18,82 +18,21 @@ import Data.List ( intercalate ) import Test.Tasty ( TestTree, testGroup ) import Test.Tasty.HUnit ( (@?=), testCase ) import Text.Parsec ( - (<|>), char, choice, - digit, many1, - option, optionMaybe, parse, sepBy1, - space, - try, - unexpected ) + space ) import Text.Parsec.String ( Parser ) -import Text.Read ( readMaybe ) import Network.DNS.RBL.Host ( Host, host ) import Network.DNS.RBL.IPv4Pattern ( IPv4Pattern, v4pattern ) +import Network.DNS.RBL.Weight ( Weight, weight ) import Network.DNS.RBL.Pretty ( Pretty(..) ) -newtype Weight = Weight Int deriving (Eq, Show) - -instance Pretty Weight where - pretty_show (Weight w) = show w - - --- | Parse the weight multiplier at the end of a site. --- --- ==== _Examples_ --- --- >>> import Text.Parsec ( parseTest ) --- --- Negative, zero, and positive integers are all supported: --- --- >>> parseTest weight "*-5" --- Weight (-5) --- --- >>> parseTest weight "*0" --- Weight 0 --- --- >>> parseTest weight "*17" --- Weight 17 --- --- If the weight is empty, it defaults to @1@: --- --- >>> parseTest weight "" --- Weight 1 --- --- The default is used whenever parsing fails: --- --- >>> parseTest weight "*hello" --- Weight 1 --- --- The 'Pretty' instance works as intended: --- --- >>> import Text.Parsec ( parse ) --- >>> pretty_print $ parse weight "" "*3" --- 3 --- -weight :: Parser Weight -weight = try parse_weight <|> return (Weight 1) - where - parse_weight = do - _ <- char '*' - sign <- (char '-') <|> (option '+' (char '+')) - w <- many1 digit - case ( readMaybe w :: Maybe Int ) of - -- If "many1 digit" gives us a list of digits, we should be able - -- to convert that to an Int! It will overflow rather than fail - -- if the input is too big/small, so it should really always - -- succeed. - Nothing -> unexpected "weight: readMaybe failed on a sequence of digits!" - Just k -> return $ Weight (if sign == '-' then negate k else k) - - - -- | A DNSBL as it would be input into postfix. It has a blacklist -- (DNS) name, a pattern of addresses to use for a \"hit\", and a -- weight multiplier. diff --git a/harbl/src/Network/DNS/RBL/Weight.hs b/harbl/src/Network/DNS/RBL/Weight.hs new file mode 100644 index 0000000..e56bcd0 --- /dev/null +++ b/harbl/src/Network/DNS/RBL/Weight.hs @@ -0,0 +1,112 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +-- | The 'Weight' type, its instances, and a Parsec parser to parse +-- one off the end of a 'Site'. +-- +-- This is a simple newtype wrapper around an 'Int', meant to be +-- used wherever a weight or an RBL score is intended (to prevent +-- integer mixups). For example, the RBLs are all weighted with +-- 'Weight's, and when a user supplied a \"badness\" threshold, it +-- will be as a 'Weight' as well. The two are then comparable but +-- not with other 'Int's. +-- +module Network.DNS.RBL.Weight ( + Weight(..), + weight ) +where + +import Text.Parsec ( + (<|>), + char, + digit, + many1, + option, + try, + unexpected ) +import Text.Parsec.String ( Parser ) +import Text.Read ( readMaybe ) + +import Network.DNS.RBL.Pretty ( Pretty(..) ) + + +-- | The 'Weight' wrapper around an 'Int. We use +-- GeneralizedNewtypeDeriving to derive num automatically (so that we +-- can sum these things). +-- +-- ==== _Examples_ +-- +-- >>> let w1 = Weight 1 +-- >>> w1 +-- Weight 1 +-- >>> let w2 = Weight 1 +-- >>> w1 == w2 +-- True +-- >>> let w3 = Weight 2 +-- >>> w1 == w3 +-- False +-- >>> sum [w1, w2, w3] +-- Weight 4 +-- +newtype Weight = Weight Int deriving (Eq, Num, Show) + + +-- | Pretty-print a 'Weight'. This just shows/prints the underlying 'Int'. +-- +-- ==== _Examples_ +-- +-- >>> pretty_print $ Weight 17 +-- 17 +-- +instance Pretty Weight where + pretty_show (Weight w) = show w + + +-- | Parse the weight multiplier off the end of an input 'Site'. This +-- expects there to be a \"multiplier\" character (an asterisk) +-- before the integral weight. +-- +-- ==== _Examples_ +-- +-- >>> import Text.Parsec ( parseTest ) +-- +-- Negative, zero, and positive integers are all supported: +-- +-- >>> parseTest weight "*-5" +-- Weight (-5) +-- +-- >>> parseTest weight "*0" +-- Weight 0 +-- +-- >>> parseTest weight "*17" +-- Weight 17 +-- +-- If the weight is empty, it defaults to @1@: +-- +-- >>> parseTest weight "" +-- Weight 1 +-- +-- The default is used whenever parsing fails: +-- +-- >>> parseTest weight "*hello" +-- Weight 1 +-- +-- The 'Pretty' instance works as intended: +-- +-- >>> import Text.Parsec ( parse ) +-- >>> pretty_print $ parse weight "" "*3" +-- 3 +-- +weight :: Parser Weight +weight = try parse_weight <|> return (Weight 1) + where + parse_weight = do + _ <- char '*' + sign <- (char '-') <|> (option '+' (char '+')) + w <- many1 digit + case ( readMaybe w :: Maybe Int ) of + -- If "many1 digit" gives us a list of digits, we should be able + -- to convert that to an Int! It will overflow rather than fail + -- if the input is too big/small, so it should really always + -- succeed. + Nothing -> unexpected "weight: readMaybe failed on a sequence of digits!" + Just k -> return $ Weight (if sign == '-' then negate k else k) diff --git a/test/Doctests.hs b/test/Doctests.hs index d183b4b..558a1e2 100644 --- a/test/Doctests.hs +++ b/test/Doctests.hs @@ -4,10 +4,16 @@ where import Test.DocTest import System.FilePath.Find ((==?), always, extension, find) -find_sources :: IO [FilePath] -find_sources = find always (extension ==? ".hs") "src/" +find_lib_sources :: IO [FilePath] +find_lib_sources = find always (extension ==? ".hs") "harbl/src/" + +find_cli_sources :: IO [FilePath] +find_cli_sources = find always (extension ==? ".hs") "harbl-cli/src/" main :: IO () main = do - sources <- find_sources - doctest $ ["-isrc", "-idist/build/autogen"] ++ sources + lib_sources <- find_lib_sources + cli_sources <- find_cli_sources + let sources = lib_sources ++ cli_sources + let flags = ["-iharbl/src", "-iharbl-cli/src", "-idist/build/autogen"] + doctest $ flags ++ sources