From dd4abc21674b98bc55a3775291a8667dffec2863 Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Tue, 16 Jul 2013 12:48:54 -0400 Subject: [PATCH] Create a Usernames newtype to fix an orphan instance. --- src/CommandLine.hs | 2 +- src/Configuration.hs | 11 ++++++----- src/Main.hs | 6 +++--- src/OptionalConfiguration.hs | 22 ++++++++-------------- src/Usernames.hs | 34 ++++++++++++++++++++++++++++++++++ 5 files changed, 52 insertions(+), 23 deletions(-) create mode 100644 src/Usernames.hs diff --git a/src/CommandLine.hs b/src/CommandLine.hs index e70aa96..ef9ff39 100644 --- a/src/CommandLine.hs +++ b/src/CommandLine.hs @@ -14,8 +14,8 @@ import System.IO (hPutStrLn, stderr) import Paths_twat (version) import Data.Version (showVersion) -import OptionalConfiguration import ExitCodes +import OptionalConfiguration description :: String description = "Twat twats tweets so you don't have to twitter." diff --git a/src/Configuration.hs b/src/Configuration.hs index f73bc61..095f539 100644 --- a/src/Configuration.hs +++ b/src/Configuration.hs @@ -11,6 +11,7 @@ module Configuration ( where import qualified OptionalConfiguration as OC +import Usernames data Cfg = Cfg { consumer_key :: String, @@ -24,7 +25,7 @@ data Cfg = from_address :: Maybe String, to_address :: Maybe String, verbose :: Bool, - usernames :: [String] } + usernames :: Usernames } deriving (Show) @@ -41,7 +42,7 @@ default_config = from_address = Nothing, to_address = Nothing, verbose = False, - usernames = [] } + usernames = Usernames [] } merge_optional :: Cfg -> OC.OptionalCfg -> Cfg merge_optional cfg opt_cfg = @@ -71,6 +72,6 @@ merge_optional cfg opt_cfg = merge' (Just _) (Just y) = Just y -- If there are any optional usernames, use only those. - all_usernames = if (null (OC.usernames opt_cfg)) - then (usernames cfg) - else (OC.usernames opt_cfg) + all_usernames = if (null (get_usernames (OC.usernames opt_cfg))) + then (usernames cfg) + else (OC.usernames opt_cfg) diff --git a/src/Main.hs b/src/Main.hs index 40703d7..b4fd956 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -24,7 +24,7 @@ import Mail ( import Twitter.Http import Twitter.Status import Twitter.User - +import Usernames (Usernames(..)) -- | A wrapper around threadDelay which takes seconds instead of -- microseconds as its argument. @@ -205,7 +205,7 @@ main = do -- set in either the config file or on the command-line. let cfg = merge_optional default_config opt_config - when (null $ usernames cfg) $ do + when (null $ get_usernames (usernames cfg)) $ do hPutStrLn stderr "ERROR: no usernames supplied." _ <- show_help exitWith (ExitFailure exit_no_usernames) @@ -216,7 +216,7 @@ main = do -- Execute run_twat on each username in a new thread. let run_twat_curried = run_twat cfg message - _ <- mapM (forkIO . run_twat_curried) (usernames cfg) + _ <- mapM (forkIO . run_twat_curried) (get_usernames (usernames cfg)) _ <- forever $ -- This thread (the one executing main) doesn't do anything, diff --git a/src/OptionalConfiguration.hs b/src/OptionalConfiguration.hs index 600647f..77b3a06 100644 --- a/src/OptionalConfiguration.hs +++ b/src/OptionalConfiguration.hs @@ -16,12 +16,15 @@ module OptionalConfiguration ( where import qualified Data.Configurator as DC -import qualified Data.Configurator.Types as DCT + import Data.Data (Data) import Data.Maybe (fromMaybe) import Data.Monoid (Monoid(..)) import Data.Typeable (Typeable) +import Usernames + + -- | The same as Cfg, except everything is optional. It's easy to -- merge two of these by simply dropping the Nothings in favor of -- the Justs. The 'usernames' are left un-maybed so that cmdargs @@ -39,7 +42,7 @@ data OptionalCfg = from_address :: Maybe String, to_address :: Maybe String, verbose :: Maybe Bool, - usernames :: [String] } + usernames :: Usernames } deriving (Show, Data, Typeable) instance Monoid OptionalCfg where @@ -55,7 +58,7 @@ instance Monoid OptionalCfg where Nothing Nothing Nothing - [] + (Usernames []) cfg1 `mappend` cfg2 = OptionalCfg @@ -80,19 +83,10 @@ instance Monoid OptionalCfg where -- Use only the latter usernames if there are any. all_usernames = - usernames $ if (null (usernames cfg2)) + usernames $ if (null (get_usernames (usernames cfg2))) then cfg1 else cfg2 -instance DCT.Configured [String] where - convert (DCT.List xs) = - mapM convert_string xs - where - convert_string :: DCT.Value -> Maybe String - convert_string = DCT.convert - - convert _ = Nothing - from_rc :: IO OptionalCfg from_rc = do cfg <- DC.load [ DC.Optional "$(HOME)/.twatrc" ] @@ -121,4 +115,4 @@ from_rc = do cfg_from_address cfg_to_address cfg_verbose - (fromMaybe [] cfg_usernames) + (fromMaybe (Usernames []) cfg_usernames) diff --git a/src/Usernames.hs b/src/Usernames.hs new file mode 100644 index 0000000..6f2fb28 --- /dev/null +++ b/src/Usernames.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE DeriveDataTypeable #-} + +-- | A newtype around a list of Strings which represent the usernames +-- to watch. This is all to avoid an orphan instance of Configured +-- for [String] if we had defined one in e.g. OptionalConfiguration. +-- +module Usernames +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 +import Data.Data (Data) +import System.Console.CmdArgs.Default (Default(..)) +import Data.Typeable (Typeable) + + +newtype Usernames = + Usernames { get_usernames :: [String] } + deriving (Data, Show, Typeable) + + +instance Default Usernames where + def = Usernames [] + + +instance DCT.Configured Usernames where + convert (DCT.List xs) = + fmap Usernames (mapM convert_string xs) + where + convert_string :: DCT.Value -> Maybe String + convert_string = DCT.convert + + convert _ = Nothing -- 2.44.2