mirror of
https://git.nerfingen.de/nerf/choirMail.git
synced 2025-06-07 17:21:16 +00:00
some minor code cleanup
This commit is contained in:
parent
5c203e5a95
commit
72e53eea4f
3 changed files with 17 additions and 8 deletions
11
app/Main.hs
11
app/Main.hs
|
@ -37,20 +37,17 @@ findChoirDay today table = maybe
|
||||||
main' :: App ()
|
main' :: App ()
|
||||||
main' = do
|
main' = do
|
||||||
args <- liftIO getArgs
|
args <- liftIO getArgs
|
||||||
case L.uncons args of
|
case args of
|
||||||
Nothing -> fail "We need exactly one config path as option"
|
[] -> fail "Please provide a config file"
|
||||||
Just (headArgs,_) -> do
|
(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
|
||||||
result <- liftIO $ runApp $ do
|
handleE (\error' -> reportErrorMail config error') $ 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'
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
12
app/Monad.hs
12
app/Monad.hs
|
@ -3,6 +3,8 @@ 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
|
||||||
|
@ -29,6 +31,16 @@ 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
|
||||||
|
|
||||||
|
|
|
@ -62,7 +62,7 @@
|
||||||
});
|
});
|
||||||
in
|
in
|
||||||
pkgs.kakoune.override {
|
pkgs.kakoune.override {
|
||||||
plugins = with pkgs.kakounePlugins; [fzf-kak kak-lsp config];
|
plugins = with pkgs.kakounePlugins; [fzf-kak kakoune-lsp config];
|
||||||
};
|
};
|
||||||
in
|
in
|
||||||
pkgs.mkShell {
|
pkgs.mkShell {
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue