harbl/src/Network/DNS/RBL/Weight.hs

   1 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
   2
   3 -- | The 'Weight' type, its instances, and a Parsec parser to parse
   4 --   one off the end of a 'Site'.
   5 --
   6 --   This is a simple newtype wrapper around an 'Int', meant to be
   7 --   used wherever a weight or an RBL score is intended (to prevent
   8 --   integer mixups). For example, the RBLs are all weighted with
   9 --   'Weight's, and when a user supplied a \"badness\" threshold, it
  10 --   will be as a 'Weight' as well. The two are then comparable but
  11 --   not with other 'Int's.
  12 --
  13 module Network.DNS.RBL.Weight (
  14   Weight(..),
  15   weight )
  16 where
  17
  18 import System.Console.CmdArgs.Default ( Default(..) )
  19 import Text.Parsec (
  20   (<|>),
  21   char,
  22   digit,
  23   many1,
  24   option,
  25   try,
  26   unexpected )
  27 import Text.Parsec.String ( Parser )
  28 import Text.Read ( readMaybe )
  29
  30 import Network.DNS.RBL.Pretty ( Pretty(..) )
  31
  32
  33 -- | The 'Weight' wrapper around an 'Int. We use
  34 --   GeneralizedNewtypeDeriving to derive num automatically (so that we
  35 --   can sum these things).
  36 --
  37 --   ==== _Examples_
  38 --
  39 --   >>> let w1 = Weight 1
  40 --   >>> w1
  41 --   Weight 1
  42 --   >>> let w2 = Weight 1
  43 --   >>> w1 == w2
  44 --   True
  45 --   >>> let w3 = Weight 2
  46 --   >>> w1 == w3
  47 --   False
  48 --   >>> sum [w1, w2, w3]
  49 --   Weight 4
  50 --
  51 newtype Weight = Weight Int deriving (Eq, Num, Ord, Show)
  52
  53
  54 -- | Pretty-print a 'Weight'. This just shows/prints the underlying 'Int'.
  55 --
  56 --   ==== _Examples_
  57 --
  58 --   >>> pretty_print $ Weight 17
  59 --   17
  60 --
  61 instance Pretty Weight where
  62   pretty_show (Weight w) = show w
  63
  64
  65 -- | Set a default value for the weight. We use the 'Default' class
  66 --   from the CmdArgs class so that 'Weight's can be easily parsed on
  67 --   the command-line.
  68 --
  69 --   ==== _Examples_
  70 --
  71 --   >>> def :: Weight
  72 --   Weight 1
  73 --
  74 instance Default Weight where def = 1
  75
  76
  77 -- | Parse the weight multiplier off the end of an input 'Site'. This
  78 --   expects there to be a \"multiplier\" character (an asterisk)
  79 --   before the integral weight.
  80 --
  81 --   ==== _Examples_
  82 --
  83 --   >>> import Text.Parsec ( parseTest )
  84 --
  85 --   Negative, zero, and positive integers are all supported:
  86 --
  87 --   >>> parseTest weight "*-5"
  88 --   Weight (-5)
  89 --
  90 --   >>> parseTest weight "*0"
  91 --   Weight 0
  92 --
  93 --   >>> parseTest weight "*17"
  94 --   Weight 17
  95 --
  96 --   If the weight is empty, it defaults to @1@:
  97 --
  98 --   >>> parseTest weight ""
  99 --   Weight 1
 100 --
 101 --   The default is used whenever parsing fails:
 102 --
 103 --   >>> parseTest weight "*hello"
 104 --   Weight 1
 105 --
 106 --   The 'Pretty' instance works as intended:
 107 --
 108 --   >>> import Text.Parsec ( parse )
 109 --   >>> pretty_print $ parse weight "" "*3"
 110 --   3
 111 --
 112 weight :: Parser Weight
 113 weight = try parse_weight <|> return (Weight 1)
 114   where
 115     parse_weight = do
 116       _ <- char '*'
 117       sign <- (char '-') <|> (option '+' (char '+'))
 118       w <- many1 digit
 119       case ( readMaybe w :: Maybe Int ) of
 120         -- If "many1 digit" gives us a list of digits, we should be able
 121         -- to convert that to an Int! It will overflow rather than fail
 122         -- if the input is too big/small, so it should really always
 123         -- succeed.
 124         Nothing -> unexpected "weight: readMaybe failed on a sequence of digits!"
 125         Just k  -> return $ Weight (if sign == '-' then negate k else k)