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(..) )
Configuration {
hosts :: Hosts,
lists :: Lists }
+-- threshold :: Weight }
deriving (Show)
-- 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
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)
--- /dev/null
+{-# 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
-- [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
-- [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
projects / dead / harbl.git / commitdiff