choirMail/app/Main.hs

{-# 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
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 err = liftIO $ hPutStr stderr err

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.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]