]> gitweb.michael.orlitzky.com - dead/halcyon.git/commitdiff
Create a Usernames newtype to fix an orphan instance.
authorMichael Orlitzky <michael@orlitzky.com>
Tue, 16 Jul 2013 16:48:54 +0000 (12:48 -0400)
committerMichael Orlitzky <michael@orlitzky.com>
Tue, 16 Jul 2013 16:48:54 +0000 (12:48 -0400)
src/CommandLine.hs
src/Configuration.hs
src/Main.hs
src/OptionalConfiguration.hs
src/Usernames.hs [new file with mode: 0644]

index e70aa964c667e3d22aa88afcefb3847da84169ba..ef9ff39939a9f9795c26de573aedad318c5e7b5c 100644 (file)
@@ -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."
index f73bc615a7d81adbd8c2c2eca0aea3afc92ab5f9..095f5395f6bf7b6d0e4994ece60f453df1e5b614 100644 (file)
@@ -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)
index 40703d7ea9170c10110efe3787ce070c47786256..b4fd956f2114d1f3a32f2b6126572811aa603a20 100644 (file)
@@ -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,
index 600647f7fa37fafff795d9dfee1721cb0ca43d9c..77b3a06d2c42bef78908bdc09827cad73e91988d 100644 (file)
@@ -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 (file)
index 0000000..6f2fb28
--- /dev/null
@@ -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