{-# LANGUAGE DeriveDataTypeable #-} {-# 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 Data.Configurator () -- Needed for predefined instances. import Data.Configurator.Types ( Configured(..), Value( Number ), convert ) import Data.Data ( Data ) import Data.Ratio ( numerator ) import Data.Typeable ( Typeable ) import System.Console.CmdArgs.Default ( Default(..) ) 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 (Data, Eq, Num, Ord, Show, Typeable) -- | 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 -- | Set a default value for the weight. We use the 'Default' class -- from the CmdArgs class so that 'Weight's can be easily parsed on -- the command-line. -- -- ==== _Examples_ -- -- >>> def :: Weight -- Weight 1 -- instance Default Weight where def = 1 -- | Allow the configurator library to parse a 'Weight' from a config -- file. -- -- ==== _Examples_ -- -- >>> import Data.Configurator () -- Get predefined 'Configured' instances. -- >>> import Data.Text ( pack ) -- >>> import Data.Configurator.Types ( Value( Number, String ) ) -- >>> let n1 = Number 2 -- >>> convert n1 :: Maybe Weight -- Just (Weight 2) -- >>> let s = String (pack "foo1") -- >>> convert s :: Maybe Weight -- Nothing -- instance Configured Weight where -- Don't give us a fractional weight, we'll ignore the denominator. convert (Number x) = Just (Weight (fromInteger $ numerator x)) convert _ = Nothing -- | 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)