added functionality

This commit is contained in:
Nicole Dresselhaus 2017-02-06 15:45:50 +01:00
parent aaf5af3319
commit 90c7c4e0cb
Signed by: Drezil
GPG Key ID: 057D94F356F41E25
3 changed files with 56 additions and 6 deletions

View File

@ -3,4 +3,6 @@ module Main where
import Lib
main :: IO ()
main = someFunc
main = do
md <- readFile "test.md"
sequence_ $ sequence . fmap print <$> getMails md

View File

@ -1,7 +1,7 @@
name: md2mail
version: 0.1.0.0
-- synopsis:
-- description:
synopsis: small tool to read a markdown-file and send out mails
description: small tool to read a markdown-file and send out mails
homepage: https://github.com/Drezil/md2mail#readme
license: BSD3
license-file: LICENSE
@ -17,6 +17,9 @@ library
hs-source-dirs: src
exposed-modules: Lib
build-depends: base >= 4.7 && < 5
, time
, pandoc
, pandoc-types
default-language: Haskell2010
executable md2mail

View File

@ -1,6 +1,51 @@
module Lib
( someFunc
( getMails
, Mail
) where
someFunc :: IO ()
someFunc = putStrLn "someFunc"
import Text.Pandoc
import Text.Pandoc.Error (PandocError(..))
import Text.Pandoc.Definition
import Data.Time.Calendar (Day, fromGregorian)
import Data.Time.Format (parseTimeM, defaultTimeLocale)
import Data.Monoid
import Data.Maybe
import Debug.Trace
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)
getMails :: String -> Either PandocError [(Day, Mail)]
getMails markdown = do
(Pandoc meta document) <- readMarkdown def markdown
return $ filter isBullet document >>= mkMail
isBullet :: Block -> Bool
isBullet (BulletList _) = True
isBullet _ = False
mkMail :: Block -> [(Day, Mail)]
mkMail (BulletList blocks) = catMaybes $ blToMail <$> blocks
mkMail _ = []
blToMail :: [Block] -> Maybe (Day, Mail)
blToMail (Para (Str dat:Space:tit):CodeBlock ca cont:_) = trace (show ca) 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
dayMailPair :: Maybe (Day, Mail)
dayMailPair = (,) <$> dayofmail dat
<*> completeMail
blToMail _ = Nothing -- Just $ mkTestmail a