src/OptionalConfiguration.hs

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