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
|
module Main where
|
||||||
|
|
||||||
import Lib
|
import Lib
|
||||||
|
import Data.Time.Clock
|
||||||
|
import Data.Time.Calendar
|
||||||
import System.Environment
|
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 :: IO ()
|
||||||
main = do
|
main = do
|
||||||
args <- getArgs
|
args <- execParser opts
|
||||||
case args of
|
md <- readFile $ filename args
|
||||||
[fn] -> do
|
(UTCTime today _) <- getCurrentTime
|
||||||
md <- readFile fn
|
sequence_ $ sequence . fmap (renderSendMail . snd) . filter (filterToday today) <$> getMails md (mailTo args) (mailFrom args) (mailFromName args)
|
||||||
sequence_ $ sequence . fmap print <$> getMails md
|
|
||||||
_ -> do
|
|
||||||
print "please call with markdown-file"
|
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
|
, time
|
||||||
, pandoc
|
, pandoc
|
||||||
, pandoc-types
|
, pandoc-types
|
||||||
|
, mime-mail
|
||||||
|
, text
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
default-extensions: OverloadedStrings
|
||||||
|
|
||||||
executable md2mail
|
executable md2mail
|
||||||
hs-source-dirs: app
|
hs-source-dirs: app
|
||||||
@ -28,6 +31,9 @@ executable md2mail
|
|||||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||||
build-depends: base
|
build-depends: base
|
||||||
, md2mail
|
, md2mail
|
||||||
|
, time
|
||||||
|
, mime-mail
|
||||||
|
, optparse-applicative
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
test-suite md2mail-test
|
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.Monoid
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Debug.Trace
|
import Debug.Trace
|
||||||
|
import Network.Mail.Mime
|
||||||
|
import qualified Data.Text as T
|
||||||
|
import qualified Data.Text.Lazy as TL
|
||||||
|
|
||||||
data Mail = Mail
|
-- data Mail = Mail
|
||||||
{ title :: String
|
-- { title :: String
|
||||||
, content :: String
|
-- , content :: String
|
||||||
, to :: Maybe String --Alternate Adress to send to
|
-- , to :: Maybe String --Alternate Adress to send to
|
||||||
} deriving (Eq, Show)
|
-- } deriving (Eq, Show)
|
||||||
|
|
||||||
mkTestmail :: (Show a) => a -> (Day,Mail)
|
-- mkTestmail :: (Show a) => a -> (Day,Mail)
|
||||||
mkTestmail s = (fromGregorian 1999 1 1, Mail "Test" (show s) Nothing)
|
-- mkTestmail s = (fromGregorian 1999 1 1, Mail "Test" (show s) Nothing)
|
||||||
|
|
||||||
getMails :: String -> Either PandocError [(Day, Mail)]
|
getMails :: String -> String -> String -> String -> Either PandocError [(Day, Mail)]
|
||||||
getMails markdown = do
|
getMails markdown to from name= do
|
||||||
(Pandoc meta document) <- readMarkdown def markdown
|
(Pandoc meta document) <- readMarkdown def markdown
|
||||||
return $ filter isBullet document >>= mkMail
|
return $ filter isBullet document >>= mkMail to from name
|
||||||
|
|
||||||
|
|
||||||
isBullet :: Block -> Bool
|
isBullet :: Block -> Bool
|
||||||
isBullet (BulletList _) = True
|
isBullet (BulletList _) = True
|
||||||
isBullet _ = False
|
isBullet _ = False
|
||||||
|
|
||||||
mkMail :: Block -> [(Day, Mail)]
|
mkMail :: String -> String -> String -> Block -> [(Day, Mail)]
|
||||||
mkMail (BulletList blocks) = catMaybes $ blToMail <$> blocks
|
mkMail to from name (BulletList blocks) = catMaybes $ blToMail to from name <$> blocks
|
||||||
mkMail _ = []
|
mkMail _ _ _ _ = []
|
||||||
|
|
||||||
blToMail :: [Block] -> Maybe (Day, Mail)
|
blToMail :: String -> String -> String -> [Block] -> Maybe (Day, Mail)
|
||||||
blToMail (Para (Str dat:Space:tit):CodeBlock ca cont:_) = trace (show ca) dayMailPair
|
blToMail to from name (Para (Str dat:Space:tit):CodeBlock ca cont:_) = dayMailPair
|
||||||
where
|
where
|
||||||
dayofmail d = parseTimeM True defaultTimeLocale "%d.%m." d :: Maybe Day
|
dayofmail d = parseTimeM True defaultTimeLocale "%d.%m." d :: Maybe Day
|
||||||
titleofmail = writePlain def (Pandoc (Meta mempty) [Para tit])
|
titleofmail = writePlain def (Pandoc (Meta mempty) [Para tit])
|
||||||
contentofmail (_,a,_) = if "mail" `elem` a then Just cont else Nothing
|
contentofmail (_,a,_) = if "mail" `elem` a then Just cont else Nothing
|
||||||
completeMail :: Maybe Mail
|
completeMail :: Maybe Mail
|
||||||
completeMail = Mail <$> pure titleofmail
|
completeMail = simpleMail' <$> pure (Address (Just "Fachschaft Technik") (T.pack to)) --To
|
||||||
<*> contentofmail ca
|
<*> pure (Address (Just (T.pack name)) (T.pack from)) --From
|
||||||
<*> pure Nothing
|
<*> pure (T.pack titleofmail)
|
||||||
|
<*> (TL.pack <$> contentofmail ca)
|
||||||
dayMailPair :: Maybe (Day, Mail)
|
dayMailPair :: Maybe (Day, Mail)
|
||||||
dayMailPair = (,) <$> dayofmail dat
|
dayMailPair = (,) <$> dayofmail dat
|
||||||
<*> completeMail
|
<*> completeMail
|
||||||
blToMail _ = Nothing -- Just $ mkTestmail a
|
blToMail _ _ _ _ = Nothing -- Just $ mkTestmail a
|
||||||
|
Loading…
Reference in New Issue
Block a user