mirror of
https://git.nerfingen.de/nerf/choirMail.git
synced 2024-10-22 19:39:25 +00:00
77 lines
2.4 KiB
Haskell
77 lines
2.4 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
module Main where
|
|
|
|
import TableParser
|
|
import Requester
|
|
import Config
|
|
import Data.Time.Calendar
|
|
import Data.Time.Clock
|
|
import qualified Data.List as L
|
|
import System.IO
|
|
import qualified Data.Text as T
|
|
import qualified Data.Text.Lazy as LT
|
|
import System.Environment
|
|
import Data.Time.Format.ISO8601
|
|
import Sender
|
|
import Monad
|
|
|
|
isChoirThisWeek :: Day -> Day -> Bool
|
|
isChoirThisWeek today day = today <= day && diffDays day today <= 6
|
|
|
|
getToday :: IO Day
|
|
getToday = utctDay <$> getCurrentTime
|
|
|
|
reportErrorLocal :: MonadIO m => String -> m ()
|
|
reportErrorLocal = liftIO . hPutStr stderr
|
|
|
|
reportErrorMail :: MonadIO m => Config -> String -> m ()
|
|
reportErrorMail config error' = send (mailDomain config) (mailUsername config) (mailPassword config) (mailErrorTo config) (mailFrom config) "choirMail Error" (LT.pack error')
|
|
|
|
findChoirDay :: Day -> [MailRecord] -> Either String MailRecord
|
|
findChoirDay today table = maybe
|
|
(Left "Keine Probe :(")
|
|
(Right)
|
|
(L.find ((isChoirThisWeek today) . date) table)
|
|
|
|
|
|
main' :: App ()
|
|
main' = do
|
|
args <- liftIO getArgs
|
|
if length args /= 1
|
|
then
|
|
fail "We need exactly one config path as option"
|
|
else do
|
|
config <- parseConfigFile (head args)
|
|
-- we want to handle these while we have the config in scope
|
|
result <- liftIO $ runApp $ do
|
|
bs <- request
|
|
table <- except $ parseBString bs
|
|
today <- liftIO getToday
|
|
record <- except $ findChoirDay today table
|
|
send (mailDomain config) (mailUsername config) (mailPassword config) (mailTo config) (mailFrom config) (mailSubject record) (mailText record)
|
|
case result of
|
|
Right x -> return x
|
|
Left error' -> reportErrorMail config error'
|
|
|
|
|
|
|
|
main :: IO ()
|
|
main = do
|
|
result <- runApp main'
|
|
case result of
|
|
Right x -> return x
|
|
Left error' -> reportErrorLocal error'
|
|
|
|
mailText :: MailRecord -> LT.Text
|
|
mailText record = LT.concat ["Guten Morgen,\n\n"
|
|
, announcement record
|
|
,"\n\ndiesen Donnerstag\n\nDurchsingen: "
|
|
,songs record
|
|
,"\nStimmproben: "
|
|
,voices record
|
|
,"\nNoten mitbringen: "
|
|
, notes record
|
|
,"\n\nLG\nJo^^\n" ]
|
|
|
|
mailSubject :: MailRecord -> T.Text
|
|
mailSubject record = T.concat ["Donnerstag ", T.pack $ iso8601Show $ date record]
|