65 lines
2 KiB
Haskell
65 lines
2 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.IO as T
|
|
import qualified Data.Text.Lazy as LT
|
|
import Data.Maybe
|
|
import System.Environment
|
|
import System.Exit
|
|
import Data.Time.Format.ISO8601
|
|
import Sender
|
|
|
|
isChoirThisWeek :: Day -> Day -> Bool
|
|
isChoirThisWeek today day = today <= day && diffDays day today <= 6
|
|
|
|
getToday :: IO Day
|
|
getToday = utctDay <$> getCurrentTime
|
|
|
|
reportError :: String -> IO ()
|
|
reportError err = hPutStr stderr err
|
|
|
|
main :: IO ()
|
|
main = do
|
|
args <- getArgs
|
|
if length args /= 1
|
|
then
|
|
die "We need exactly one argument"
|
|
else do
|
|
configE <- parseFile (head args)
|
|
case configE of
|
|
Left text -> hPutStr stderr text
|
|
Right config -> do
|
|
bs <- request
|
|
let eitherTable = parseBString bs
|
|
case eitherTable of
|
|
Left x -> reportError x
|
|
Right table -> do
|
|
today <- getToday
|
|
maybe
|
|
(T.putStr "Keine Probe :(")
|
|
(\record -> send (mailDomain config) (mailUsername config) (mailPassword config) (mailTo config) (mailFrom config) (mailSubject record) (mailText record))
|
|
(L.find ((isChoirThisWeek today) . date) table)
|
|
|
|
mailText :: MailRecord -> LT.Text
|
|
mailText record = LT.fromStrict $T.concat ["Guten Morgen,\n\n"
|
|
, announcement record
|
|
,"\n\ndiesen Donnerstag\n\nDurchsingen: "
|
|
,song1 record
|
|
,", "
|
|
,song2 record
|
|
,"\nStimmproben: "
|
|
,voice1 record
|
|
,", "
|
|
,voice2 record
|
|
,"\n\nLG\nMalte\n" ]
|
|
|
|
mailSubject :: MailRecord -> T.Text
|
|
mailSubject record = T.concat ["Donnerstag ", T.pack $ iso8601Show $ date record]
|