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       (usernames cfg2) -- Use only the usernames from cfg2
  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
  82 instance DCT.Configured [String] where
  83   convert (DCT.List xs) =
  84     mapM convert_string xs
  85     where
  86       convert_string :: DCT.Value -> Maybe String
  87       convert_string = DCT.convert
  88
  89   convert _ = Nothing
  90
  91 from_rc :: IO OptionalCfg
  92 from_rc = do
  93   cfg <- DC.load [ DC.Optional "$(HOME)/.twatrc" ]
  94   cfg_consumer_key <- DC.lookup cfg "consumer-key"
  95   cfg_consumer_secret <- DC.lookup cfg "consumer-secret"
  96   cfg_access_token <- DC.lookup cfg "access-token"
  97   cfg_access_secret <- DC.lookup cfg "access-secret"
  98   cfg_heartbeat <- DC.lookup cfg "heartbeat"
  99   cfg_ignore_replies <- DC.lookup cfg "ignore-replies"
 100   cfg_ignore_retweets <- DC.lookup cfg "ignore-retweets"
 101   cfg_sendmail_path <- DC.lookup cfg "sendmail-path"
 102   cfg_from_address <- DC.lookup cfg "from"
 103   cfg_to_address <- DC.lookup cfg "to"
 104   cfg_verbose <- DC.lookup cfg "verbose"
 105   cfg_usernames <- DC.lookup cfg "usernames"
 106
 107   return $ OptionalCfg
 108              cfg_consumer_key
 109              cfg_consumer_secret
 110              cfg_access_token
 111              cfg_access_secret
 112              cfg_heartbeat
 113              cfg_ignore_replies
 114              cfg_ignore_retweets
 115              cfg_sendmail_path
 116              cfg_from_address
 117              cfg_to_address
 118              cfg_verbose
 119              (fromMaybe [] cfg_usernames)