From b47aaa60a797aee4ecdcd5535ed40c1a7b15ddce Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Fri, 17 Jul 2015 01:33:41 -0400 Subject: [PATCH] Clean up the configurator code in the CLI app. --- harbl-cli/src/Configuration.hs | 15 ++++++++++----- harbl-cli/src/Configurator.hs | 35 ++++++++++++++++++++++++++++++++++ harbl-cli/src/Hosts.hs | 32 ++++++++++--------------------- harbl-cli/src/Lists.hs | 32 ++++++++++--------------------- 4 files changed, 65 insertions(+), 49 deletions(-) create mode 100644 harbl-cli/src/Configurator.hs diff --git a/harbl-cli/src/Configuration.hs b/harbl-cli/src/Configuration.hs index 64adc7e..a6798e9 100644 --- a/harbl-cli/src/Configuration.hs +++ b/harbl-cli/src/Configuration.hs @@ -7,8 +7,12 @@ module Configuration ( merge_optional ) where +import Data.Monoid ( Monoid(..) ) import System.Console.CmdArgs.Default ( Default(..) ) +-- From the harbl library. +import Network.DNS.RBL.Weight ( Weight ) + import qualified OptionalConfiguration as OC ( OptionalConfiguration(..) ) import Hosts ( Hosts(..) ) @@ -22,6 +26,7 @@ data Configuration = Configuration { hosts :: Hosts, lists :: Lists } +-- threshold :: Weight } deriving (Show) @@ -29,7 +34,9 @@ data Configuration = -- values. -- instance Default Configuration where - def = Configuration { hosts = def, lists = def } + def = Configuration { hosts = def, + lists = def } +-- threshold = def } -- | Merge a 'Configuration' with an 'OptionalConfiguration'. This is @@ -42,7 +49,5 @@ merge_optional :: Configuration merge_optional cfg opt_cfg = Configuration all_hosts all_lists where - all_hosts = - Hosts $ (get_hosts $ hosts cfg) ++ (get_hosts $ OC.hosts opt_cfg) - all_lists = - Lists $ (get_lists $ lists cfg) ++ (get_lists $ OC.lists opt_cfg) + all_hosts = (hosts cfg) `mappend` (OC.hosts opt_cfg) + all_lists = (lists cfg) `mappend` (OC.lists opt_cfg) diff --git a/harbl-cli/src/Configurator.hs b/harbl-cli/src/Configurator.hs new file mode 100644 index 0000000..f85b2be --- /dev/null +++ b/harbl-cli/src/Configurator.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE FlexibleContexts #-} + +module Configurator ( convert_newtype_list ) +where + +import Data.Configurator.Types ( + Configured, + Value( List ), + convert ) + + +-- | Configurator helper function. We often want to parse a list of +-- \"special\" strings; that is, a list of strings with a little +-- more type safett. For example, if we want to read a list of IP +-- addresses and a list of usernames, we don't want to confuse the +-- two. So, we might wrap them in \"Addresses\" and \"Usernames\" +-- newtypes. But then Configurator doesn't know how to parse them +-- any more! This function takes the newtype constructor and the +-- value and does the obvious thing. +-- +-- ==== _Examples_ +-- +-- >>> import Data.Configurator () -- Get predefined 'Configured' instances. +-- >>> import Data.Text ( pack ) +-- >>> import Data.Configurator.Types ( Value( String ) ) +-- >>> newtype Foo = Foo [String] deriving (Show) +-- >>> let s1 = String (pack "foo1") +-- >>> let s2 = String (pack "foo2") +-- >>> let config = List [s1, s2] +-- >>> convert_newtype_list Foo config +-- Just (Foo ["foo1","foo2"]) +-- +convert_newtype_list :: Configured b => ([b] -> a) -> Value -> Maybe a +convert_newtype_list ctor (List xs) = fmap ctor (mapM convert xs) +convert_newtype_list _ _ = Nothing diff --git a/harbl-cli/src/Hosts.hs b/harbl-cli/src/Hosts.hs index 020484d..83bf7c3 100644 --- a/harbl-cli/src/Hosts.hs +++ b/harbl-cli/src/Hosts.hs @@ -3,45 +3,33 @@ -- [String] if we had defined one in e.g. 'OptionalConfiguration'. -- {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Hosts ( Hosts(..) ) where --- DC is needed only for the DCT.Configured instance of String. -import qualified Data.Configurator as DC() -import qualified Data.Configurator.Types as DCT ( - Configured, - Value( List ), - convert ) +import Data.Configurator () -- Needed for predefined instances. +import Data.Configurator.Types ( Configured(..) ) +import Data.Monoid ( Monoid ) import Data.Data ( Data ) import System.Console.CmdArgs.Default ( Default(..) ) import Data.Typeable ( Typeable ) +import Configurator ( convert_newtype_list ) + -- | A (wrapper around a) list of hosts. -- newtype Hosts = Hosts { get_hosts :: [String] } - deriving (Data, Show, Typeable) + deriving (Data, Monoid, Show, Typeable) -- | The default list of hosts. It's empty. -- instance Default Hosts where def = Hosts [] -instance DCT.Configured Hosts where +instance Configured Hosts where -- | This allows us to read a Hosts object out of a Configurator - -- config file. By default Configurator wouldn't know what to do, - -- so we have to tell it that we expect a list, and if that list - -- has strings in it, we can apply the Hosts constructor to - -- it. - convert (DCT.List xs) = - -- mapM gives us a Maybe [String] here. - fmap Hosts (mapM convert_string xs) - where - convert_string :: DCT.Value -> Maybe String - convert_string = DCT.convert - - -- If we read anything other than a list of values out of the file, - -- fail. - convert _ = Nothing + -- config file: by default Configurator wouldn't know what to do. + convert = convert_newtype_list Hosts diff --git a/harbl-cli/src/Lists.hs b/harbl-cli/src/Lists.hs index 8edb167..d94e85d 100644 --- a/harbl-cli/src/Lists.hs +++ b/harbl-cli/src/Lists.hs @@ -3,45 +3,33 @@ -- [String] if we had defined one in e.g. 'OptionalConfiguration'. -- {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Lists ( Lists(..) ) where --- DC is needed only for the DCT.Configured instance of String. -import qualified Data.Configurator as DC() -import qualified Data.Configurator.Types as DCT ( - Configured, - Value( List ), - convert ) +import Data.Configurator () -- Needed for predefined instances. +import Data.Configurator.Types ( Configured(..) ) import Data.Data ( Data ) +import Data.Monoid ( Monoid ) import System.Console.CmdArgs.Default ( Default(..) ) import Data.Typeable ( Typeable ) +import Configurator ( convert_newtype_list ) + -- | A (wrapper around a) list of blacklists. -- newtype Lists = Lists { get_lists :: [String] } - deriving (Data, Show, Typeable) + deriving (Data, Monoid, Show, Typeable) -- | The default list of white/blacklists. It's empty. -- instance Default Lists where def = Lists [] -instance DCT.Configured Lists where +instance Configured Lists where -- | This allows us to read a 'Lists' object out of a Configurator - -- config file. By default Configurator wouldn't know what to do, - -- so we have to tell it that we expect a list, and if that list - -- has strings in it, we can apply the Lists constructor to - -- it. - convert (DCT.List xs) = - -- mapM gives us a Maybe [String] here. - fmap Lists (mapM convert_string xs) - where - convert_string :: DCT.Value -> Maybe String - convert_string = DCT.convert - - -- If we read anything other than a list of values out of the file, - -- fail. - convert _ = Nothing + -- config file: by default Configurator wouldn't know what to do. + convert = convert_newtype_list Lists -- 2.44.2