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' :: App ()
main' = do main' = do
args <- liftIO getArgs args <- liftIO getArgs
case args of case L.uncons args of
[] -> fail "Please provide a config file" Nothing -> fail "We need exactly one config path as option"
(headArgs : _) -> do Just (headArgs,_) -> do
config <- parseConfigFile headArgs config <- parseConfigFile headArgs
-- we want to handle these while we have the config in scope -- we want to handle these while we have the config in scope
handleE (\error' -> reportErrorMail config error') $ do result <- liftIO $ runApp $ do
bs <- request bs <- request
table <- except $ parseBString bs table <- except $ parseBString bs
today <- liftIO getToday today <- liftIO getToday
record <- except $ findChoirDay today table record <- except $ findChoirDay today table
send (mailDomain config) (mailUsername config) (mailPassword config) (mailTo config) (mailFrom config) (mailSubject record) (mailText record) 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 App
,module Control.Monad.Fail ,module Control.Monad.Fail
,module Control.Monad.IO.Class ,module Control.Monad.IO.Class
,handleE
,catchE
,throwE ,throwE
,except ,except
,runApp ,runApp
@ -31,16 +29,6 @@ instance MonadFail App where
throwE :: String -> App a throwE :: String -> App a
throwE = App . T.throwE 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 :: Either String a -> App a
except = App . T.except except = App . T.except

View file

@ -1,32 +1,19 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module Sender module Sender where
(generateMail
,send
) where
import Network.Mail.Mime import Network.Mail.Mime
import Network.Mail.SMTP import Network.Mail.SMTP
import qualified Data.Text as ST import qualified Data.Text as ST
import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy as LT
import Monad 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 :: ST.Text -> ST.Text -> ST.Text -> LT.Text -> Mail
generateMail to from subj body = do generateMail to from subj = simpleMail' (Address Nothing to) (Address Nothing from) subj
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
-- domain -> Username -> password -> To -> From -> Subject -> Body -- domain -> Username -> password -> To -> From -> Subject -> Body
send :: (MonadIO m) => String -> String -> String -> ST.Text -> ST.Text -> ST.Text -> LT.Text -> m () send :: (MonadIO m) => String -> String -> String -> ST.Text -> ST.Text -> ST.Text -> LT.Text -> m ()
send domain user pass to from subj body = do send domain user pass to from subj body = liftIO $ sendMailWithLoginTLS domain user pass mail
mail <- liftIO $ generateMail to from subj body where
liftIO $ sendMailWithLoginTLS domain user pass mail mail = generateMail to from subj body

6
flake.lock generated
View file

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

View file

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