nerf/choirMail
1
0
Fork 0
mirror of https://git.nerfingen.de/nerf/choirMail.git synced 2024-12-04 12:19:58 +00:00
Code Issues Projects Releases Packages Wiki Activity

minimized text vs lazytext conversions between lib calls

Browse source
This commit is contained in:
nerf van nerfingen 2022-11-18 11:58:49 +01:00
parent 3deede4516
commit 4bc23000bd
3 changed files with 28 additions and 26 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
README.md
View file

@ -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

6
app/Main.hs
View file

@ -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

32
app/TableParser.hs
View file

@ -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