From 4bc23000bdf7a169ed7c290431b2084d1e9f415c Mon Sep 17 00:00:00 2001 From: nerf van nerfingen Date: Fri, 18 Nov 2022 11:58:49 +0100 Subject: [PATCH] minimized text vs lazytext conversions between lib calls --- README.md | 14 +++++++------- app/Main.hs | 6 +++--- app/TableParser.hs | 34 ++++++++++++++++++---------------- 3 files changed, 28 insertions(+), 26 deletions(-) diff --git a/README.md b/README.md index 0fcf615..93a4f5b 100644 --- a/README.md +++ b/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. # TODO -- Better E-Mail generation -- Add the nix modules to the flake -- Better Error handling - - Find out which exceptions the SMTP module throws -- Split config into secrets and non secret config - - make the pad url configurable -- clean up Text vs lazy Text \ No newline at end of file +- [] Better E-Mail generation +- [] Add the nix modules to the flake +- [] Better Error handling + - [] Find out which exceptions the SMTP module throws +- [] Split config into secrets and non secret config + - [] make the pad url configurable +- [x] Clean up Strict vs Lazy Text diff --git a/app/Main.hs b/app/Main.hs index e311857..1862e64 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -22,7 +22,7 @@ getToday :: IO Day getToday = utctDay <$> getCurrentTime reportErrorLocal :: MonadIO m => String -> m () -reportErrorLocal err = liftIO $ hPutStr stderr err +reportErrorLocal = liftIO . hPutStr stderr 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') @@ -31,7 +31,7 @@ findChoirDay :: Day -> [MailRecord] -> Either String MailRecord findChoirDay today table = maybe (Left "Keine Probe :(") (Right) - (L.find ((isChoirThisWeek today) .date) table) + (L.find ((isChoirThisWeek today) . date) table) main' :: App () @@ -63,7 +63,7 @@ main = do Left error' -> reportErrorLocal error' mailText :: MailRecord -> LT.Text -mailText record = LT.fromStrict $T.concat ["Guten Morgen,\n\n" +mailText record = LT.concat ["Guten Morgen,\n\n" , announcement record ,"\n\ndiesen Donnerstag\n\nDurchsingen: " ,song1 record diff --git a/app/TableParser.hs b/app/TableParser.hs index a422301..3484c8a 100644 --- a/app/TableParser.hs +++ b/app/TableParser.hs @@ -1,22 +1,24 @@ +{-# LANGUAGE RecordWildCards #-} module TableParser(MailRecord(..), parseBString, parseTable) where - + import qualified Text.Parsec as P -- import qualified Text.Parsec.Char as P import qualified Text.Parsec.Text as P -import qualified Data.Text as T -import qualified Data.Text.Encoding as T +import qualified Data.Text.Lazy as LT +import qualified Data.Text as ST +import qualified Data.Text.Encoding as ST import qualified Data.Time.Calendar as D import qualified Data.ByteString as B -import Control.Monad +import Control.Monad(void) data MailRecord = MailRecord { date :: D.Day, - voice1 :: T.Text, - voice2 :: T.Text, - song1 :: T.Text, - song2 :: T.Text, - announcement :: T.Text + voice1 :: LT.Text, + voice2 :: LT.Text, + song1 :: LT.Text, + song2 :: LT.Text, + announcement :: LT.Text } deriving (Show) seperator :: Char @@ -25,8 +27,8 @@ seperator = '\t' sepParser :: P.Parser () sepParser = void $ P.char seperator -textCellParser :: P.Parser T.Text -textCellParser = fmap T.pack $ P.many $ P.noneOf [seperator,'\n','\r'] +textCellParser :: P.Parser LT.Text +textCellParser = fmap LT.pack $ P.many $ P.noneOf [seperator,'\n','\r'] dateCellParser :: P.Parser D.Day dateCellParser = do @@ -58,8 +60,8 @@ parseRow = do sepParser song2 <- textCellParser sepParser - announcments <- textCellParser - return $ MailRecord date voice1 voice2 song1 song2 announcments + announcement <- textCellParser + return $ MailRecord{..} parseFirstRow :: P.Parser () 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 return x -textToMailRecord :: T.Text -> Either String [MailRecord] +textToMailRecord :: ST.Text -> Either String [MailRecord] textToMailRecord t = case P.parse parseTable "" t of Left x -> Left $ show x Right x -> Right x @@ -82,7 +84,7 @@ parseBString t = do text <- toText t textToMailRecord text -toText :: B.ByteString -> Either String T.Text -toText t = case T.decodeUtf8' t of +toText :: B.ByteString -> Either String ST.Text +toText t = case ST.decodeUtf8' t of Left x -> Left $ show x Right x -> Right x