Compare commits
2 commits
cc90208886
...
4bc23000bd
Author | SHA1 | Date | |
---|---|---|---|
|
4bc23000bd | ||
|
3deede4516 |
4 changed files with 31 additions and 29 deletions
14
README.md
14
README.md
|
@ -30,10 +30,10 @@ If you run `nix develop` you get a set up kakoune with an lsp. Be aware
|
||||||
this depends on your local cabal cache.
|
this depends on your local cabal cache.
|
||||||
|
|
||||||
# TODO
|
# TODO
|
||||||
- Better E-Mail generation
|
- [] Better E-Mail generation
|
||||||
- Add the nix modules to the flake
|
- [] Add the nix modules to the flake
|
||||||
- Better Error handling
|
- [] Better Error handling
|
||||||
- Find out which exceptions the SMTP module throws
|
- [] Find out which exceptions the SMTP module throws
|
||||||
- Split config into secrets and non secret config
|
- [] Split config into secrets and non secret config
|
||||||
- make the pad url configurable
|
- [] make the pad url configurable
|
||||||
- clean up Text vs lazy Text
|
- [x] Clean up Strict vs Lazy Text
|
||||||
|
|
|
@ -22,7 +22,7 @@ getToday :: IO Day
|
||||||
getToday = utctDay <$> getCurrentTime
|
getToday = utctDay <$> getCurrentTime
|
||||||
|
|
||||||
reportErrorLocal :: MonadIO m => String -> m ()
|
reportErrorLocal :: MonadIO m => String -> m ()
|
||||||
reportErrorLocal err = liftIO $ hPutStr stderr err
|
reportErrorLocal = liftIO . hPutStr stderr
|
||||||
|
|
||||||
reportErrorMail :: MonadIO m => Config -> String -> m ()
|
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')
|
reportErrorMail config error' = send (mailDomain config) (mailUsername config) (mailPassword config) (mailErrorTo config) (mailFrom config) "choirMail Error" (LT.pack error')
|
||||||
|
@ -31,7 +31,7 @@ findChoirDay :: Day -> [MailRecord] -> Either String MailRecord
|
||||||
findChoirDay today table = maybe
|
findChoirDay today table = maybe
|
||||||
(Left "Keine Probe :(")
|
(Left "Keine Probe :(")
|
||||||
(Right)
|
(Right)
|
||||||
(L.find ((isChoirThisWeek today) .date) table)
|
(L.find ((isChoirThisWeek today) . date) table)
|
||||||
|
|
||||||
|
|
||||||
main' :: App ()
|
main' :: App ()
|
||||||
|
@ -63,7 +63,7 @@ main = do
|
||||||
Left error' -> reportErrorLocal error'
|
Left error' -> reportErrorLocal error'
|
||||||
|
|
||||||
mailText :: MailRecord -> LT.Text
|
mailText :: MailRecord -> LT.Text
|
||||||
mailText record = LT.fromStrict $T.concat ["Guten Morgen,\n\n"
|
mailText record = LT.concat ["Guten Morgen,\n\n"
|
||||||
, announcement record
|
, announcement record
|
||||||
,"\n\ndiesen Donnerstag\n\nDurchsingen: "
|
,"\n\ndiesen Donnerstag\n\nDurchsingen: "
|
||||||
,song1 record
|
,song1 record
|
||||||
|
|
|
@ -1,22 +1,24 @@
|
||||||
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
module TableParser(MailRecord(..), parseBString, parseTable) where
|
module TableParser(MailRecord(..), parseBString, parseTable) where
|
||||||
|
|
||||||
import qualified Text.Parsec as P
|
import qualified Text.Parsec as P
|
||||||
-- import qualified Text.Parsec.Char as P
|
-- import qualified Text.Parsec.Char as P
|
||||||
import qualified Text.Parsec.Text as P
|
import qualified Text.Parsec.Text as P
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text.Lazy as LT
|
||||||
import qualified Data.Text.Encoding as T
|
import qualified Data.Text as ST
|
||||||
|
import qualified Data.Text.Encoding as ST
|
||||||
import qualified Data.Time.Calendar as D
|
import qualified Data.Time.Calendar as D
|
||||||
import qualified Data.ByteString as B
|
import qualified Data.ByteString as B
|
||||||
import Control.Monad
|
import Control.Monad(void)
|
||||||
|
|
||||||
|
|
||||||
data MailRecord = MailRecord {
|
data MailRecord = MailRecord {
|
||||||
date :: D.Day,
|
date :: D.Day,
|
||||||
voice1 :: T.Text,
|
voice1 :: LT.Text,
|
||||||
voice2 :: T.Text,
|
voice2 :: LT.Text,
|
||||||
song1 :: T.Text,
|
song1 :: LT.Text,
|
||||||
song2 :: T.Text,
|
song2 :: LT.Text,
|
||||||
announcement :: T.Text
|
announcement :: LT.Text
|
||||||
} deriving (Show)
|
} deriving (Show)
|
||||||
|
|
||||||
seperator :: Char
|
seperator :: Char
|
||||||
|
@ -25,8 +27,8 @@ seperator = '\t'
|
||||||
sepParser :: P.Parser ()
|
sepParser :: P.Parser ()
|
||||||
sepParser = void $ P.char seperator
|
sepParser = void $ P.char seperator
|
||||||
|
|
||||||
textCellParser :: P.Parser T.Text
|
textCellParser :: P.Parser LT.Text
|
||||||
textCellParser = fmap T.pack $ P.many $ P.noneOf [seperator,'\n','\r']
|
textCellParser = fmap LT.pack $ P.many $ P.noneOf [seperator,'\n','\r']
|
||||||
|
|
||||||
dateCellParser :: P.Parser D.Day
|
dateCellParser :: P.Parser D.Day
|
||||||
dateCellParser = do
|
dateCellParser = do
|
||||||
|
@ -58,8 +60,8 @@ parseRow = do
|
||||||
sepParser
|
sepParser
|
||||||
song2 <- textCellParser
|
song2 <- textCellParser
|
||||||
sepParser
|
sepParser
|
||||||
announcments <- textCellParser
|
announcement <- textCellParser
|
||||||
return $ MailRecord date voice1 voice2 song1 song2 announcments
|
return $ MailRecord{..}
|
||||||
|
|
||||||
parseFirstRow :: P.Parser ()
|
parseFirstRow :: P.Parser ()
|
||||||
parseFirstRow = void (P.string "Datum\tStimmprobe 1\tStimmprobe 2\tLied 1\tLied 2\tWeitere Ansagen" >> P.endOfLine)
|
parseFirstRow = void (P.string "Datum\tStimmprobe 1\tStimmprobe 2\tLied 1\tLied 2\tWeitere Ansagen" >> P.endOfLine)
|
||||||
|
@ -71,7 +73,7 @@ parseTable = do
|
||||||
P.eof
|
P.eof
|
||||||
return x
|
return x
|
||||||
|
|
||||||
textToMailRecord :: T.Text -> Either String [MailRecord]
|
textToMailRecord :: ST.Text -> Either String [MailRecord]
|
||||||
textToMailRecord t = case P.parse parseTable "" t of
|
textToMailRecord t = case P.parse parseTable "" t of
|
||||||
Left x -> Left $ show x
|
Left x -> Left $ show x
|
||||||
Right x -> Right x
|
Right x -> Right x
|
||||||
|
@ -82,7 +84,7 @@ parseBString t = do
|
||||||
text <- toText t
|
text <- toText t
|
||||||
textToMailRecord text
|
textToMailRecord text
|
||||||
|
|
||||||
toText :: B.ByteString -> Either String T.Text
|
toText :: B.ByteString -> Either String ST.Text
|
||||||
toText t = case T.decodeUtf8' t of
|
toText t = case ST.decodeUtf8' t of
|
||||||
Left x -> Left $ show x
|
Left x -> Left $ show x
|
||||||
Right x -> Right x
|
Right x -> Right x
|
||||||
|
|
6
flake.lock
generated
6
flake.lock
generated
|
@ -17,11 +17,11 @@
|
||||||
},
|
},
|
||||||
"nixpkgs": {
|
"nixpkgs": {
|
||||||
"locked": {
|
"locked": {
|
||||||
"lastModified": 1667639549,
|
"lastModified": 1668563542,
|
||||||
"narHash": "sha256-frqZKSG/933Ctwl9voSZnXDwo8CqddXcjQhnCzwNqaM=",
|
"narHash": "sha256-FrMNezX3v4qLkCg+j1e3Ei/FXOSQP4Chq4OOdttIEns=",
|
||||||
"owner": "NixOS",
|
"owner": "NixOS",
|
||||||
"repo": "nixpkgs",
|
"repo": "nixpkgs",
|
||||||
"rev": "cae3751e9f74eea29c573d6c2f14523f41c2821a",
|
"rev": "ce89321950381ec845e56c6a6d1340abe5cd7a65",
|
||||||
"type": "github"
|
"type": "github"
|
||||||
},
|
},
|
||||||
"original": {
|
"original": {
|
||||||
|
|
Loading…
Add table
Reference in a new issue