Compare commits

..

No commits in common. "4c54800b980663f420f7166927be9a429e95f7c8" and "f88fcc1391f5152a01cd0476b4f9a11c1a68d09f" have entirely different histories.

5 changed files with 17 additions and 39 deletions

View file

@ -37,17 +37,20 @@ findChoirDay today table = maybe
main' :: App ()
main' = do
args <- liftIO getArgs
case args of
[] -> fail "Please provide a config file"
(headArgs : _) -> do
case L.uncons args of
Nothing -> fail "We need exactly one config path as option"
Just (headArgs,_) -> do
config <- parseConfigFile headArgs
-- we want to handle these while we have the config in scope
handleE (\error' -> reportErrorMail config error') $ do
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'

View file

@ -3,8 +3,6 @@ module Monad(
App
,module Control.Monad.Fail
,module Control.Monad.IO.Class
,handleE
,catchE
,throwE
,except
,runApp
@ -31,16 +29,6 @@ instance MonadFail App where
throwE :: String -> App a
throwE = App . T.throwE
catchE :: App a -> (String -> App a) -> App a
catchE a f = do
result <- liftIO $ runApp a
case result of
Left err -> f err
Right res -> return res
handleE :: (String -> App a) -> App a -> App a
handleE = flip catchE
except :: Either String a -> App a
except = App . T.except

View file

@ -1,32 +1,19 @@
{-# LANGUAGE OverloadedStrings #-}
module Sender
(generateMail
,send
) where
module Sender where
import Network.Mail.Mime
import Network.Mail.SMTP
import qualified Data.Text as ST
import qualified Data.Text.Lazy as LT
import Monad
import Control.Monad.IO.Class
import Data.Time.LocalTime (getZonedTime)
import Data.Time.Format (TimeLocale, formatTime, defaultTimeLocale)
rfc5322Format :: String
rfc5322Format = "%a, %d %b %0Y %T %z"
generateMail :: (MonadIO m) => ST.Text -> ST.Text -> ST.Text -> LT.Text -> m Mail
generateMail to from subj body = do
time <- liftIO getZonedTime
let timeString = ST.pack $ formatTime defaultTimeLocale rfc5322Format time
mailWithoutDate = simpleMail' (Address Nothing to) (Address Nothing from) subj body
mailWithDate = mailWithoutDate {mailHeaders = ("Date",timeString) : mailHeaders mailWithoutDate}
return mailWithDate
generateMail :: ST.Text -> ST.Text -> ST.Text -> LT.Text -> Mail
generateMail to from subj = simpleMail' (Address Nothing to) (Address Nothing from) subj
-- domain -> Username -> password -> To -> From -> Subject -> Body
send :: (MonadIO m) => String -> String -> String -> ST.Text -> ST.Text -> ST.Text -> LT.Text -> m ()
send domain user pass to from subj body = do
mail <- liftIO $ generateMail to from subj body
liftIO $ sendMailWithLoginTLS domain user pass mail
send domain user pass to from subj body = liftIO $ sendMailWithLoginTLS domain user pass mail
where
mail = generateMail to from subj body

6
flake.lock generated
View file

@ -20,11 +20,11 @@
},
"nixpkgs": {
"locked": {
"lastModified": 1749174413,
"narHash": "sha256-urN9UMK5cd1dzhR+Lx0xHeTgBp2MatA5+6g9JaxjuQs=",
"lastModified": 1746576598,
"narHash": "sha256-FshoQvr6Aor5SnORVvh/ZdJ1Sa2U4ZrIMwKBX5k2wu0=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "6ad174a6dc07c7742fc64005265addf87ad08615",
"rev": "b3582c75c7f21ce0b429898980eddbbf05c68e55",
"type": "github"
},
"original": {

View file

@ -62,7 +62,7 @@
});
in
pkgs.kakoune.override {
plugins = with pkgs.kakounePlugins; [fzf-kak kakoune-lsp config];
plugins = with pkgs.kakounePlugins; [fzf-kak kak-lsp config];
};
in
pkgs.mkShell {