src/OptionalConfiguration.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE FlexibleInstances #-}
   3 {-# LANGUAGE OverloadedStrings #-}
   4
   5 -- | The program will parse ~/.twatrc for any available configuration
   6 --   directives, resulting in an OptionalCfg. The command-line
   7 --   arguments will be used to create another OptionalCfg, and the two
   8 --   will be merged. Finally, a default_config will be updated from
   9 --   the merged OptionalCfgs.
  10 --
  11
  12 module OptionalConfiguration (
  13   OptionalCfg(..),
  14   from_rc
  15   )
  16 where
  17
  18 import qualified Data.Configurator as DC
  19 import qualified Data.Configurator.Types as DCT
  20 import Data.Data (Data)
  21 import Data.Maybe (fromMaybe)
  22 import Data.Monoid (Monoid(..))
  23 import Data.Typeable (Typeable)
  24
  25 -- | The same as Cfg, except everything is optional. It's easy to
  26 --   merge two of these by simply dropping the Nothings in favor of
  27 --   the Justs. The 'usernames' are left un-maybed so that cmdargs
  28 --   can parse more than one of them.
  29 --
  30 data OptionalCfg =
  31   OptionalCfg { consumer_key :: Maybe String,
  32                 consumer_secret :: Maybe String,
  33                 access_token :: Maybe String,
  34                 access_secret :: Maybe String,
  35                 heartbeat :: Maybe Int,
  36                 ignore_replies :: Maybe Bool,
  37                 ignore_retweets :: Maybe Bool,
  38                 sendmail_path :: Maybe String,
  39                 from_address :: Maybe String,
  40                 to_address :: Maybe String,
  41                 verbose :: Maybe Bool,
  42                 usernames :: [String] }
  43     deriving (Show, Data, Typeable)
  44
  45 instance Monoid OptionalCfg where
  46   mempty = OptionalCfg
  47              Nothing
  48              Nothing
  49              Nothing
  50              Nothing
  51              Nothing
  52              Nothing
  53              Nothing
  54              Nothing
  55              Nothing
  56              Nothing
  57              Nothing
  58              []
  59
  60   cfg1 `mappend` cfg2 =
  61     OptionalCfg
  62       (merge (consumer_key cfg1) (consumer_key cfg2))
  63       (merge (consumer_secret cfg1) (consumer_secret cfg2))
  64       (merge (access_token cfg1) (access_token cfg2))
  65       (merge (access_secret cfg1) (access_secret cfg2))
  66       (merge (heartbeat cfg1) (heartbeat cfg2))
  67       (merge (ignore_replies cfg1) (ignore_replies cfg2))
  68       (merge (ignore_retweets cfg1) (ignore_retweets cfg2))
  69       (merge (sendmail_path cfg1) (sendmail_path cfg2))
  70       (merge (from_address cfg1) (from_address cfg2))
  71       (merge (to_address cfg1) (to_address cfg2))
  72       (merge (verbose cfg1) (verbose cfg2))
  73       all_usernames
  74     where
  75       merge :: (Maybe a) -> (Maybe a) -> (Maybe a)
  76       merge Nothing Nothing   = Nothing
  77       merge (Just x) Nothing  = Just x
  78       merge Nothing (Just x)  = Just x
  79       merge (Just _) (Just y) = Just y
  80
  81       -- Use only the latter usernames if there are any.
  82       all_usernames =
  83         usernames $ if (null (usernames cfg2))
  84                     then cfg1
  85                     else cfg2
  86
  87 instance DCT.Configured [String] where
  88   convert (DCT.List xs) =
  89     mapM convert_string xs
  90     where
  91       convert_string :: DCT.Value -> Maybe String
  92       convert_string = DCT.convert
  93
  94   convert _ = Nothing
  95
  96 from_rc :: IO OptionalCfg
  97 from_rc = do
  98   cfg <- DC.load [ DC.Optional "$(HOME)/.twatrc" ]
  99   cfg_consumer_key <- DC.lookup cfg "consumer-key"
 100   cfg_consumer_secret <- DC.lookup cfg "consumer-secret"
 101   cfg_access_token <- DC.lookup cfg "access-token"
 102   cfg_access_secret <- DC.lookup cfg "access-secret"
 103   cfg_heartbeat <- DC.lookup cfg "heartbeat"
 104   cfg_ignore_replies <- DC.lookup cfg "ignore-replies"
 105   cfg_ignore_retweets <- DC.lookup cfg "ignore-retweets"
 106   cfg_sendmail_path <- DC.lookup cfg "sendmail-path"
 107   cfg_from_address <- DC.lookup cfg "from"
 108   cfg_to_address <- DC.lookup cfg "to"
 109   cfg_verbose <- DC.lookup cfg "verbose"
 110   cfg_usernames <- DC.lookup cfg "usernames"
 111
 112   return $ OptionalCfg
 113              cfg_consumer_key
 114              cfg_consumer_secret
 115              cfg_access_token
 116              cfg_access_secret
 117              cfg_heartbeat
 118              cfg_ignore_replies
 119              cfg_ignore_retweets
 120              cfg_sendmail_path
 121              cfg_from_address
 122              cfg_to_address
 123              cfg_verbose
 124              (fromMaybe [] cfg_usernames)