works rudimentary
This commit is contained in:
parent
c9580946a9
commit
e4f51183fb
64
app/Main.hs
64
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
|
||||
|
@ -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
|
||||
|
42
src/Lib.hs
42
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
|
||||
|
Loading…
Reference in New Issue
Block a user