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

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