diff --git a/app/Main.hs b/app/Main.hs index cc6c243..363759a 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -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' diff --git a/app/Monad.hs b/app/Monad.hs index 80631cb..42b4593 100644 --- a/app/Monad.hs +++ b/app/Monad.hs @@ -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 diff --git a/app/Sender.hs b/app/Sender.hs index c78850d..efbe8d2 100644 --- a/app/Sender.hs +++ b/app/Sender.hs @@ -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 diff --git a/flake.lock b/flake.lock index a566d94..123b37c 100644 --- a/flake.lock +++ b/flake.lock @@ -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": { diff --git a/flake.nix b/flake.nix index 402d985..0d3fe28 100644 --- a/flake.nix +++ b/flake.nix @@ -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 {