minimized text vs lazytext conversions between lib calls
This commit is contained in:
parent
3deede4516
commit
4bc23000bd
3 changed files with 28 additions and 26 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
|
||||||
|
|
Loading…
Reference in a new issue