From 5375ad26dd78220185f1ffe05222250c06dc1a0c Mon Sep 17 00:00:00 2001 From: Joris Date: Sat, 21 Nov 2015 21:41:38 +0100 Subject: Get next week birthdays and send an empty mail for the moment --- src/Model/Config.hs | 32 ++++++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) create mode 100644 src/Model/Config.hs (limited to 'src/Model/Config.hs') diff --git a/src/Model/Config.hs b/src/Model/Config.hs new file mode 100644 index 0000000..b583048 --- /dev/null +++ b/src/Model/Config.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleContexts #-} + +module Model.Config + ( getConfig + , Config(..) + ) where + +import Data.ConfigFile +import Data.Text (Text) +import qualified Data.Text as T + +import Control.Monad.Trans.Error (runErrorT) +import Control.Monad.IO.Class (liftIO) +import Control.Monad (join) +import Control.Arrow (left) + +data Config = Config + { mailTo :: Text + , mailFrom :: Text + , dayForNextWeekNotification :: Text + } deriving (Read, Eq, Show) + +getConfig :: FilePath -> IO (Either Text Config) +getConfig filePath = + left (T.pack . show) <$> (runErrorT $ do + cp <- join $ liftIO $ readfile emptyCP filePath + Config <$> + (T.pack <$> get cp "DEFAULT" "mail-to") <*> + (T.pack <$> get cp "DEFAULT" "mail-from") <*> + (T.pack <$> get cp "DEFAULT" "day-for-next-week-notification") + ) -- cgit v1.2.3