src/OptionalConfiguration.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE FlexibleInstances #-}
   3 {-# LANGUAGE OverloadedStrings #-}
   4
   5 -- | The program will parse ~/.htsnrc for any available configuration
   6 --   directives, resulting in an OptionalConfiguration. The
   7 --   command-line arguments will be used to create another
   8 --   OptionalConfiguration, and the two will be merged. Finally, a
   9 --   def :: Configuration will be updated from the merged
  10 --   OptionalConfigurations.
  11 --
  12
  13 module OptionalConfiguration (
  14   OptionalConfiguration(..),
  15   from_rc )
  16 where
  17
  18 import qualified Data.Configurator as DC (
  19   Worth(Optional),
  20   load,
  21   lookup )
  22 import Data.Data (Data)
  23 import Data.Maybe (fromMaybe)
  24 import Data.Monoid (Monoid(..))
  25 import Data.Typeable (Typeable)
  26
  27 import FeedHosts (FeedHosts(..))
  28
  29
  30 -- | The same as Configuration, except everything is optional. It's easy to
  31 --   merge two of these by simply dropping the Nothings in favor of
  32 --   the Justs. The 'feed_hosts' are left un-maybed so that cmdargs
  33 --   can parse more than one of them.
  34 --
  35 data OptionalConfiguration =
  36   OptionalConfiguration {
  37     feed_hosts :: FeedHosts,
  38     password  :: Maybe String,
  39     output_directory :: Maybe FilePath,
  40     username :: Maybe String }
  41     deriving (Show, Data, Typeable)
  42
  43 instance Monoid OptionalConfiguration where
  44   mempty = OptionalConfiguration
  45              (FeedHosts [])
  46              Nothing
  47              Nothing
  48              Nothing
  49
  50
  51   cfg1 `mappend` cfg2 =
  52     OptionalConfiguration
  53       all_feed_hosts
  54       (merge (password cfg1) (password cfg2))
  55       (merge (output_directory cfg1) (output_directory cfg2))
  56       (merge (username cfg1) (username cfg2))
  57     where
  58       merge :: (Maybe a) -> (Maybe a) -> (Maybe a)
  59       merge Nothing Nothing   = Nothing
  60       merge (Just x) Nothing  = Just x
  61       merge Nothing (Just x)  = Just x
  62       merge (Just _) (Just y) = Just y
  63
  64       -- Use only the latter feed_hosts if there are any.
  65       all_feed_hosts =
  66         feed_hosts $ if (null (get_feed_hosts (feed_hosts cfg2)))
  67                     then cfg1
  68                     else cfg2
  69
  70 from_rc :: IO OptionalConfiguration
  71 from_rc = do
  72   cfg <- DC.load [ DC.Optional "$(HOME)/.htsnrc" ]
  73   cfg_password <- DC.lookup cfg "password"
  74   cfg_output_directory <- DC.lookup cfg "output_directory"
  75   cfg_username <- DC.lookup cfg "username"
  76   cfg_feed_hosts <- DC.lookup cfg "feed_hosts"
  77
  78   return $ OptionalConfiguration
  79              (fromMaybe (FeedHosts []) cfg_feed_hosts)
  80              cfg_password
  81              cfg_output_directory
  82              cfg_username
  83