Clean up the configurator code in the CLI app.
authorMichael Orlitzky <michael@orlitzky.com>
Fri, 17 Jul 2015 05:33:41 +0000 (01:33 -0400)
committerMichael Orlitzky <michael@orlitzky.com>
Fri, 17 Jul 2015 05:33:41 +0000 (01:33 -0400)
harbl-cli/src/Configuration.hs
harbl-cli/src/Configurator.hs [new file with mode: 0644]
harbl-cli/src/Hosts.hs
harbl-cli/src/Lists.hs

index 64adc7e6a7bb330b396cf0603b3381f61e49edca..a6798e97f08f38803edb0116a2f5080bffae5465 100644 (file)
@@ -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 (file)
index 0000000..f85b2be
--- /dev/null
@@ -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
index 020484dff1dc1872fe6e742d61fd6c2121fcacfb..83bf7c3492b22d5a2a333dc001ebfc9a36a67ad2 100644 (file)
@@ -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
index 8edb167e30685abbd37b777dde3506e19bda7243..d94e85d16abbb797f2a160c0a8e853b13fcfafbb 100644 (file)
@@ -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