From e4f51183fb30706a4766d1626a8b54ca96d728b5 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Fri, 10 Feb 2017 20:36:41 +0100 Subject: [PATCH] works rudimentary --- app/Main.hs | 64 +++++++++++++++++++++++++++++++++++++++++++++------ md2mail.cabal | 6 +++++ src/Lib.hs | 42 ++++++++++++++++++--------------- 3 files changed, 86 insertions(+), 26 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index b2dd598..5fa1639 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,14 +1,64 @@ module Main where import Lib +import Data.Time.Clock +import Data.Time.Calendar import System.Environment +import Data.Monoid +import Debug.Trace +import Network.Mail.Mime hiding (mailFrom, mailTo) +import Options.Applicative + +data CLIOptions = CLIOptions + { filename :: String + , mailTo :: String + , mailFrom :: String + , mailFromName :: String + } + +options :: Parser CLIOptions +options = CLIOptions + <$> strOption + ( long "filename" + <> short 'f' + <> metavar "FILE" + <> help "Filename of Markdown-File" + ) + <*> strOption + ( long "to" + <> short 't' + <> metavar "TO" + <> help "Mail-address to send the reminder to" + ) + <*> strOption + ( long "from" + <> short 'f' + <> metavar "FROM" + <> help "Mail-address of the reminder" + ) + <*> strOption + ( long "name" + <> short 'n' + <> metavar "NAME" + <> help "Name in the reminder-mails" + ) + +opts = info (options <**> helper) + ( fullDesc + <> progDesc "Send reminder from FILE to mail TO using FROM and NAME as identification for the sender" + <> header "md2mail - a small program for sending out reminder-mails from markdown" + ) main :: IO () main = do - args <- getArgs - case args of - [fn] -> do - md <- readFile fn - sequence_ $ sequence . fmap print <$> getMails md - _ -> do - print "please call with markdown-file" + args <- execParser opts + md <- readFile $ filename args + (UTCTime today _) <- getCurrentTime + sequence_ $ sequence . fmap (renderSendMail . snd) . filter (filterToday today) <$> getMails md (mailTo args) (mailFrom args) (mailFromName args) + + +filterToday :: Day -> (Day, Mail) -> Bool +filterToday d (d2,_) = trace (show d <> "==" <> show d2 <> "?") day1 == day2 && m1 == m2 + where + (_,m1,day1) = toGregorian d + (_,m2,day2) = toGregorian d2 diff --git a/md2mail.cabal b/md2mail.cabal index dc0ccad..cc917e6 100644 --- a/md2mail.cabal +++ b/md2mail.cabal @@ -20,7 +20,10 @@ library , time , pandoc , pandoc-types + , mime-mail + , text default-language: Haskell2010 + default-extensions: OverloadedStrings executable md2mail hs-source-dirs: app @@ -28,6 +31,9 @@ executable md2mail ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: base , md2mail + , time + , mime-mail + , optparse-applicative default-language: Haskell2010 test-suite md2mail-test diff --git a/src/Lib.hs b/src/Lib.hs index 3180f1e..6d71454 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -11,41 +11,45 @@ import Data.Time.Format (parseTimeM, defaultTimeLocale) import Data.Monoid import Data.Maybe import Debug.Trace +import Network.Mail.Mime +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL -data Mail = Mail - { title :: String - , content :: String - , to :: Maybe String --Alternate Adress to send to - } deriving (Eq, Show) +-- data Mail = Mail +-- { title :: String +-- , content :: String +-- , to :: Maybe String --Alternate Adress to send to +-- } deriving (Eq, Show) -mkTestmail :: (Show a) => a -> (Day,Mail) -mkTestmail s = (fromGregorian 1999 1 1, Mail "Test" (show s) Nothing) +-- mkTestmail :: (Show a) => a -> (Day,Mail) +-- mkTestmail s = (fromGregorian 1999 1 1, Mail "Test" (show s) Nothing) -getMails :: String -> Either PandocError [(Day, Mail)] -getMails markdown = do +getMails :: String -> String -> String -> String -> Either PandocError [(Day, Mail)] +getMails markdown to from name= do (Pandoc meta document) <- readMarkdown def markdown - return $ filter isBullet document >>= mkMail + return $ filter isBullet document >>= mkMail to from name isBullet :: Block -> Bool isBullet (BulletList _) = True isBullet _ = False -mkMail :: Block -> [(Day, Mail)] -mkMail (BulletList blocks) = catMaybes $ blToMail <$> blocks -mkMail _ = [] +mkMail :: String -> String -> String -> Block -> [(Day, Mail)] +mkMail to from name (BulletList blocks) = catMaybes $ blToMail to from name <$> blocks +mkMail _ _ _ _ = [] -blToMail :: [Block] -> Maybe (Day, Mail) -blToMail (Para (Str dat:Space:tit):CodeBlock ca cont:_) = trace (show ca) dayMailPair +blToMail :: String -> String -> String -> [Block] -> Maybe (Day, Mail) +blToMail to from name (Para (Str dat:Space:tit):CodeBlock ca cont:_) = dayMailPair where dayofmail d = parseTimeM True defaultTimeLocale "%d.%m." d :: Maybe Day titleofmail = writePlain def (Pandoc (Meta mempty) [Para tit]) contentofmail (_,a,_) = if "mail" `elem` a then Just cont else Nothing completeMail :: Maybe Mail - completeMail = Mail <$> pure titleofmail - <*> contentofmail ca - <*> pure Nothing + completeMail = simpleMail' <$> pure (Address (Just "Fachschaft Technik") (T.pack to)) --To + <*> pure (Address (Just (T.pack name)) (T.pack from)) --From + <*> pure (T.pack titleofmail) + <*> (TL.pack <$> contentofmail ca) dayMailPair :: Maybe (Day, Mail) dayMailPair = (,) <$> dayofmail dat <*> completeMail -blToMail _ = Nothing -- Just $ mkTestmail a +blToMail _ _ _ _ = Nothing -- Just $ mkTestmail a