exposed-modules:
Network.DNS.RBL
Network.DNS.RBL.Tests
+ Network.DNS.RBL.Weight
other-modules:
Network.DNS.RBL.Domain.Digit
-- 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 =
-- ""
--
-- >>> 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
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.
--- /dev/null
+{-# 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)
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
projects / dead / harbl.git / commitdiff