From 5375ad26dd78220185f1ffe05222250c06dc1a0c Mon Sep 17 00:00:00 2001 From: Joris Date: Sat, 21 Nov 2015 21:41:38 +0100 Subject: Get next week birthdays and send an empty mail for the moment --- .gitignore | 1 + README.md | 7 +++-- logs | 2 -- src/Birthdate.hs | 37 ---------------------- src/BirthdateParser.hs | 57 --------------------------------- src/Config.hs | 32 ------------------- src/Date.hs | 51 ------------------------------ src/Logger.hs | 6 ++-- src/Mail.hs | 75 -------------------------------------------- src/Main.hs | 67 +++++++-------------------------------- src/Model/Birthdate.hs | 38 ++++++++++++++++++++++ src/Model/BirthdateParser.hs | 57 +++++++++++++++++++++++++++++++++ src/Model/Config.hs | 32 +++++++++++++++++++ src/Model/Date.hs | 74 +++++++++++++++++++++++++++++++++++++++++++ src/Model/Mail.hs | 60 +++++++++++++++++++++++++++++++++++ src/Model/Path.hs | 10 ++++++ src/Notification.hs | 49 +++++++++++++++++++++++++++++ src/RenderError.hs | 34 ++++++++++++++++++++ src/Time.hs | 12 +++++++ 19 files changed, 387 insertions(+), 314 deletions(-) delete mode 100644 logs delete mode 100644 src/Birthdate.hs delete mode 100644 src/BirthdateParser.hs delete mode 100644 src/Config.hs delete mode 100644 src/Date.hs delete mode 100644 src/Mail.hs create mode 100644 src/Model/Birthdate.hs create mode 100644 src/Model/BirthdateParser.hs create mode 100644 src/Model/Config.hs create mode 100644 src/Model/Date.hs create mode 100644 src/Model/Mail.hs create mode 100644 src/Model/Path.hs create mode 100644 src/Notification.hs create mode 100644 src/RenderError.hs create mode 100644 src/Time.hs diff --git a/.gitignore b/.gitignore index 2a63a4c..22c0c69 100644 --- a/.gitignore +++ b/.gitignore @@ -4,3 +4,4 @@ cabal.sandbox.config dist config.txt deploy +logs diff --git a/README.md b/README.md index 5fa517b..cd90214 100644 --- a/README.md +++ b/README.md @@ -1,8 +1,10 @@ Birthday ======== -Notify by email if there is a birthday today. Birthdates are parsed from -birthdates.csv: +Notify by email if there is a birthday today. This program is intended to be +launched everyday. + +Create birthdates.csv which stores birthdates: ``` 23 Oct 1982, Jean, Dupont @@ -16,6 +18,7 @@ Create config.txt: ``` mail-to = john.dupont@mail.com mail-from = no-reply@service.com +day-for-next-week-notification = Friday ``` The usage is as follow: diff --git a/logs b/logs deleted file mode 100644 index 3269e69..0000000 --- a/logs +++ /dev/null @@ -1,2 +0,0 @@ -[21/11/2015] - Sending mail to joris.guyonvarch@gmail.com with subject “Hey, there is 1 birthday today!” and body “Alain Noe is now 19 years old.” -[21/11/2015, 18:55] - Sending mail to joris.guyonvarch@gmail.com with subject “Hey, there is 1 birthday today!” and body “Alain Noe is now 19 years old.” diff --git a/src/Birthdate.hs b/src/Birthdate.hs deleted file mode 100644 index 48d3a4e..0000000 --- a/src/Birthdate.hs +++ /dev/null @@ -1,37 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Birthdate - ( Birthdate(..) - , fullname - , age - , filterBirthdayAt - ) where - -import Data.Text (Text) -import qualified Data.Text as T - -import Date - -data Birthdate = Birthdate - { date :: Date - , firstname :: Text - , lastname :: Text - } deriving (Eq, Show) - -fullname :: Birthdate -> Text -fullname d = T.concat [firstname d, " ", lastname d] - -age :: Date -> Birthdate -> Int -age currentDate birthdate = yearsGap currentDate (date birthdate) - -filterBirthdayAt :: Date -> [Birthdate] -> [Birthdate] -filterBirthdayAt d = filter (sameDayAndMonth d . date) - -filterBirthdayBetween :: Date -> Date -> [Birthdate] -> [Birthdate] -filterBirthdayBetween begin end = - filter (\bd -> - let d = date bd - in ( d `isAfterOrEqualDayAndMonth` begin - && d `isBeforeOrEqualDayAndMonth` end - ) - ) diff --git a/src/BirthdateParser.hs b/src/BirthdateParser.hs deleted file mode 100644 index 9fa7c50..0000000 --- a/src/BirthdateParser.hs +++ /dev/null @@ -1,57 +0,0 @@ -module BirthdateParser - ( parseBirthdates - ) where - -import Control.Arrow (left) - -import Data.Text (Text) -import qualified Data.Text as T - -import Text.ParserCombinators.Parsec - -import Birthdate -import Date - -parseBirthdates :: Text -> Either Text [Birthdate] -parseBirthdates input = - left - (T.pack . show) - (parse birthdatesParser "" (T.unpack input)) - -birthdatesParser :: Parser [Birthdate] -birthdatesParser = many (many newline >> birthdateParser <* many newline) - -birthdateParser :: Parser Birthdate -birthdateParser = - Birthdate <$> - dateParser <* spaces <* char ',' <*> - valueParser <* char ',' <*> - valueParser - -valueParser :: Parser Text -valueParser = T.strip . T.pack <$> many (noneOf ",\n") - -dateParser :: Parser Date -dateParser = - Date <$> - integerParser <* spaces <*> - monthParser <* spaces <*> - integerParser - -integerParser :: Parser Int -integerParser = (read :: String -> Int) <$> many1 digit - -monthParser :: Parser Int -monthParser = - (try $ string "Jan" >> return 1) - <|> (try $ string "Feb" >> return 2) - <|> (try $ string "Mar" >> return 3) - <|> (try $ string "Apr" >> return 4) - <|> (try $ string "May" >> return 5) - <|> (try $ string "Jun" >> return 6) - <|> (try $ string "Jul" >> return 7) - <|> (try $ string "Aug" >> return 8) - <|> (try $ string "Sep" >> return 9) - <|> (try $ string "Oct" >> return 10) - <|> (try $ string "Nov" >> return 11) - <|> (try $ string "Dec" >> return 12) diff --git a/src/Config.hs b/src/Config.hs deleted file mode 100644 index c01bbe1..0000000 --- a/src/Config.hs +++ /dev/null @@ -1,32 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE FlexibleContexts #-} - -module Config - ( getConfig - , Config(..) - ) where - -import Data.ConfigFile -import Data.Text (Text) -import qualified Data.Text as T - -import Control.Monad.Trans.Error (runErrorT) -import Control.Monad.IO.Class (liftIO) -import Control.Monad (join) -import Control.Arrow (left) -import Control.Applicative (liftA2) - -data Config = Config - { mailTo :: Text - , mailFrom :: Text - } deriving (Read, Eq, Show) - -getConfig :: FilePath -> IO (Either Text Config) -getConfig filePath = - left (T.pack . show) <$> (runErrorT $ do - cp <- join $ liftIO $ readfile emptyCP filePath - liftA2 - Config - (T.pack <$> get cp "DEFAULT" "mail-to") - (T.pack <$> get cp "DEFAULT" "mail-from") - ) diff --git a/src/Date.hs b/src/Date.hs deleted file mode 100644 index 63830d3..0000000 --- a/src/Date.hs +++ /dev/null @@ -1,51 +0,0 @@ -module Date - ( Date(..) - , getCurrentDate - , sameDayAndMonth - , isBeforeOrEqualDayAndMonth - , isAfterOrEqualDayAndMonth - , yearsGap - ) where - -import Data.Time.Clock -import Data.Time.Calendar -import Data.Time.LocalTime - -data Date = Date - { day :: Int - , month :: Int - , year :: Int - } deriving (Eq, Show) - -getCurrentDate :: IO Date -getCurrentDate = do - now <- getCurrentTime - timezone <- getCurrentTimeZone - let zoneNow = utcToLocalTime timezone now - let (y, m, d) = toGregorian $ localDay zoneNow - return $ Date d m (fromIntegral y) - -sameDayAndMonth :: Date -> Date -> Bool -sameDayAndMonth d1 d2 = - ( day d1 == day d2 - && month d1 == month d2 - ) - -isBeforeOrEqualDayAndMonth :: Date -> Date -> Bool -isBeforeOrEqualDayAndMonth d1 d2 = - ( month d1 < month d2 - || ( month d1 == month d2 - && day d1 <= day d2 - ) - ) - -isAfterOrEqualDayAndMonth :: Date -> Date -> Bool -isAfterOrEqualDayAndMonth d1 d2 = - ( month d1 > month d2 - || ( month d1 == month d2 - && day d1 >= day d2 - ) - ) - -yearsGap :: Date -> Date -> Int -yearsGap d1 d2 = abs (year d2 - year d1) diff --git a/src/Logger.hs b/src/Logger.hs index 4be55be..6faa482 100644 --- a/src/Logger.hs +++ b/src/Logger.hs @@ -7,12 +7,12 @@ module Logger import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.IO as T (appendFile) -import Data.Time.LocalTime (getZonedTime) -import Data.Time.Format (formatTime, defaultTimeLocale) + +import Time (formatCurrentLocale) info :: Text -> IO () info message = do - time <- T.pack <$> formatTime defaultTimeLocale "[%d/%m/%Y, %H:%M]" <$> getZonedTime + time <- formatCurrentLocale "[%d/%m/%Y, %H:%M]" T.appendFile "logs" $ T.concat [ time diff --git a/src/Mail.hs b/src/Mail.hs deleted file mode 100644 index dc533ef..0000000 --- a/src/Mail.hs +++ /dev/null @@ -1,75 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Mail - ( mailSubject - , mailBody - ) where - -import Data.Text (Text) -import qualified Data.Text as T - -import Date -import Birthdate - -mailSubject :: [Birthdate] -> Text -mailSubject birthdates = - let count = length birthdates - in T.concat - [ "Hey, " - , if count > 1 then "there are" else "there is" - , " " - , T.pack . show $ count - , " birthday" - , if count > 1 then "s" else "" - , " today!" - ] - -mailBody :: Date -> [Birthdate] -> Text -mailBody currentDate birthdates = - let count = length birthdates - birthdatesWithLines = map (mapFst lineKind) . zip [1..] $ birthdates - lineKind 1 = if count == 1 then SingleLine else FirstLine - lineKind line = if line == count then LastLine else MiddleLine - in T.concat $ map (mailLine currentDate) birthdatesWithLines - -mapFst :: (a -> c) -> (a, b) -> (c, b) -mapFst f (x, y) = (f x, y) - -data Line = - SingleLine - | FirstLine - | MiddleLine - | LastLine - deriving (Eq, Show) - -mailLine :: Date -> (Line, Birthdate) -> Text -mailLine currDate (SingleLine, birthdate) = - T.concat - [ fullname birthdate - , " is now " - , T.pack . show $ age currDate birthdate - , " years old." - ] -mailLine currDate (FirstLine, birthdate) = - T.concat - [ fullname birthdate - , " is now " - , T.pack . show $ age currDate birthdate - , " years old" - ] -mailLine currDate (MiddleLine, birthdate) = - T.concat - [ ", " - , fullname birthdate - , " is " - , T.pack . show $ age currDate birthdate - , " years old" - ] -mailLine currDate (LastLine, birthdate) = - T.concat - [ " and " - , fullname birthdate - , " is " - , T.pack . show $ age currDate birthdate - , " years old." - ] diff --git a/src/Main.hs b/src/Main.hs index 0aa2910..e3bd0ce 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -4,67 +4,24 @@ module Main ( main ) where -import System.IO (stderr) - -import Data.Text (Text) -import qualified Data.Text as T import qualified Data.Text.IO as T -import Date (getCurrentDate) -import Birthdate (Birthdate, filterBirthdayAt) -import BirthdateParser (parseBirthdates) -import Mail (mailSubject, mailBody) -import SendMail (sendMail) -import Config - -birthdatePath :: FilePath -birthdatePath = "birthdates.csv" +import qualified RenderError +import qualified Notification -configPath :: FilePath -configPath = "config.txt" +import Model.Config +import Model.BirthdateParser (parseBirthdates) +import qualified Model.Path as Path main :: IO () main = do - eitherBirthdates <- parseBirthdates <$> T.readFile birthdatePath - eitherConfig <- getConfig configPath + eitherBirthdates <- parseBirthdates <$> T.readFile Path.birthdate + eitherConfig <- getConfig Path.config case (eitherBirthdates, eitherConfig) of (Left err, _) -> - birthdateError err + RenderError.birthdate err (_, Left err) -> - configError err - (Right birthdates, Right config) -> - sendNotificationForBirthdayToday birthdates config - -birthdateError :: Text -> IO () -birthdateError err = - T.hPutStr stderr $ - T.concat - [ "Error while parsing file " - , T.pack birthdatePath - , ":\n" - , err - ] - -configError :: Text -> IO () -configError err = - T.hPutStr stderr $ - T.concat - [ "Error while parsing config file " - , T.pack configPath - , ":\n" - , err - ] - -sendNotificationForBirthdayToday :: [Birthdate] -> Config -> IO () -sendNotificationForBirthdayToday birthdates config = do - currentDate <- getCurrentDate - let birthdays = filterBirthdayAt currentDate birthdates - if not (null birthdays) - then - sendMail - (mailTo config) - (mailFrom config) - (mailSubject birthdays) - (mailBody currentDate birthdays) - else - return () + RenderError.config err + (Right birthdates, Right config) -> do + Notification.today birthdates config + Notification.nextWeek birthdates config diff --git a/src/Model/Birthdate.hs b/src/Model/Birthdate.hs new file mode 100644 index 0000000..d135419 --- /dev/null +++ b/src/Model/Birthdate.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Model.Birthdate + ( Birthdate(..) + , fullname + , age + , filterBirthdayAt + , filterBirthdayBetween + ) where + +import Data.Text (Text) +import qualified Data.Text as T + +import Model.Date + +data Birthdate = Birthdate + { date :: Date + , firstname :: Text + , lastname :: Text + } deriving (Eq, Show) + +fullname :: Birthdate -> Text +fullname d = T.concat [firstname d, " ", lastname d] + +age :: Date -> Birthdate -> Int +age currentDate birthdate = yearsGap currentDate (date birthdate) + +filterBirthdayAt :: Date -> [Birthdate] -> [Birthdate] +filterBirthdayAt d = filter (sameDayAndMonth d . date) + +filterBirthdayBetween :: Date -> Date -> [Birthdate] -> [Birthdate] +filterBirthdayBetween begin end = + filter (\bd -> + let d = date bd + in ( d `isAfterOrEqualDayAndMonth` begin + && d `isBeforeOrEqualDayAndMonth` end + ) + ) diff --git a/src/Model/BirthdateParser.hs b/src/Model/BirthdateParser.hs new file mode 100644 index 0000000..c9ac3b9 --- /dev/null +++ b/src/Model/BirthdateParser.hs @@ -0,0 +1,57 @@ +module Model.BirthdateParser + ( parseBirthdates + ) where + +import Control.Arrow (left) + +import Data.Text (Text) +import qualified Data.Text as T + +import Text.ParserCombinators.Parsec + +import Model.Birthdate +import Model.Date + +parseBirthdates :: Text -> Either Text [Birthdate] +parseBirthdates input = + left + (T.pack . show) + (parse birthdatesParser "" (T.unpack input)) + +birthdatesParser :: Parser [Birthdate] +birthdatesParser = many (many newline >> birthdateParser <* many newline) + +birthdateParser :: Parser Birthdate +birthdateParser = + Birthdate <$> + dateParser <* spaces <* char ',' <*> + valueParser <* char ',' <*> + valueParser + +valueParser :: Parser Text +valueParser = T.strip . T.pack <$> many (noneOf ",\n") + +dateParser :: Parser Date +dateParser = + Date <$> + integerParser <* spaces <*> + monthParser <* spaces <*> + integerParser + +integerParser :: Parser Int +integerParser = (read :: String -> Int) <$> many1 digit + +monthParser :: Parser Int +monthParser = + (try $ string "Jan" >> return 1) + <|> (try $ string "Feb" >> return 2) + <|> (try $ string "Mar" >> return 3) + <|> (try $ string "Apr" >> return 4) + <|> (try $ string "May" >> return 5) + <|> (try $ string "Jun" >> return 6) + <|> (try $ string "Jul" >> return 7) + <|> (try $ string "Aug" >> return 8) + <|> (try $ string "Sep" >> return 9) + <|> (try $ string "Oct" >> return 10) + <|> (try $ string "Nov" >> return 11) + <|> (try $ string "Dec" >> return 12) diff --git a/src/Model/Config.hs b/src/Model/Config.hs new file mode 100644 index 0000000..b583048 --- /dev/null +++ b/src/Model/Config.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleContexts #-} + +module Model.Config + ( getConfig + , Config(..) + ) where + +import Data.ConfigFile +import Data.Text (Text) +import qualified Data.Text as T + +import Control.Monad.Trans.Error (runErrorT) +import Control.Monad.IO.Class (liftIO) +import Control.Monad (join) +import Control.Arrow (left) + +data Config = Config + { mailTo :: Text + , mailFrom :: Text + , dayForNextWeekNotification :: Text + } deriving (Read, Eq, Show) + +getConfig :: FilePath -> IO (Either Text Config) +getConfig filePath = + left (T.pack . show) <$> (runErrorT $ do + cp <- join $ liftIO $ readfile emptyCP filePath + Config <$> + (T.pack <$> get cp "DEFAULT" "mail-to") <*> + (T.pack <$> get cp "DEFAULT" "mail-from") <*> + (T.pack <$> get cp "DEFAULT" "day-for-next-week-notification") + ) diff --git a/src/Model/Date.hs b/src/Model/Date.hs new file mode 100644 index 0000000..96c15e9 --- /dev/null +++ b/src/Model/Date.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Model.Date + ( Date(..) + , getCurrentDate + , getNextWeek + , plusDays + , sameDayAndMonth + , isBeforeOrEqualDayAndMonth + , isAfterOrEqualDayAndMonth + , yearsGap + ) where + +import Data.Time.Clock +import Data.Time.Calendar +import Data.Time.LocalTime +import qualified Data.Text as T + +import Time (formatCurrentLocale) + +data Date = Date + { day :: Int + , month :: Int + , year :: Int + } deriving (Eq, Show) + +getCurrentDate :: IO Date +getCurrentDate = do + now <- getCurrentTime + timezone <- getCurrentTimeZone + let zoneNow = utcToLocalTime timezone now + return . dateFromDay $ localDay zoneNow + +getNextWeek :: IO (Date, Date) +getNextWeek = do + currentDate <- getCurrentDate + currentDayNumberOfWeek <- (read . T.unpack <$> formatCurrentLocale "%u") :: IO Int + let begin = currentDate `plusDays` (8 - currentDayNumberOfWeek) + let end = begin `plusDays` 6 + return (begin, end) + +plusDays :: Date -> Int -> Date +plusDays (Date d m y) n = + dateFromDay . addDays (toInteger n) $ fromGregorian (toInteger y) m d + +dateFromDay :: Day -> Date +dateFromDay dayTime = + let (y, m, d) = toGregorian dayTime + in Date d m (fromIntegral y) + +sameDayAndMonth :: Date -> Date -> Bool +sameDayAndMonth d1 d2 = + ( day d1 == day d2 + && month d1 == month d2 + ) + +isBeforeOrEqualDayAndMonth :: Date -> Date -> Bool +isBeforeOrEqualDayAndMonth d1 d2 = + ( month d1 < month d2 + || ( month d1 == month d2 + && day d1 <= day d2 + ) + ) + +isAfterOrEqualDayAndMonth :: Date -> Date -> Bool +isAfterOrEqualDayAndMonth d1 d2 = + ( month d1 > month d2 + || ( month d1 == month d2 + && day d1 >= day d2 + ) + ) + +yearsGap :: Date -> Date -> Int +yearsGap d1 d2 = abs (year d2 - year d1) diff --git a/src/Model/Mail.hs b/src/Model/Mail.hs new file mode 100644 index 0000000..e730e32 --- /dev/null +++ b/src/Model/Mail.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Model.Mail + ( mailSubject + , mailBody + ) where + +import Data.Text (Text) +import qualified Data.Text as T + +import Model.Date +import Model.Birthdate + +mailSubject :: [Birthdate] -> Text +mailSubject birthdates = + let count = length birthdates + in T.concat + [ "Hey, " + , if count > 1 then "there are" else "there is" + , " " + , T.pack . show $ count + , " birthday" + , if count > 1 then "s" else "" + , " today!" + ] + +mailBody :: Date -> [Birthdate] -> Text +mailBody currentDate birthdates = + T.concat $ map (mailLine currentDate) (attachLines birthdates) + +attachLines :: [Birthdate] -> [(Line, Birthdate)] +attachLines birthdates = + let count = length birthdates + lineKind 1 = if count == 1 then SingleLine else FirstLine + lineKind line = if line == count then LastLine else MiddleLine + mapFst f (x, y) = (f x, y) + in map (mapFst lineKind) . zip [1..] $ birthdates + +data Line = + SingleLine + | FirstLine + | MiddleLine + | LastLine + deriving (Eq, Show) + +mailLine :: Date -> (Line, Birthdate) -> Text +mailLine currDate (line, birthdate) = + T.concat + [ case line of + MiddleLine -> ", " + LastLine -> " and " + _ -> "" + , fullname birthdate + , case line of + x | x `elem` [SingleLine, FirstLine] -> " is now " + _ -> " is " + , T.pack . show $ age currDate birthdate + , " years old" + , if line == LastLine then "." else "" + ] diff --git a/src/Model/Path.hs b/src/Model/Path.hs new file mode 100644 index 0000000..d34716c --- /dev/null +++ b/src/Model/Path.hs @@ -0,0 +1,10 @@ +module Model.Path + ( birthdate + , config + ) where + +birthdate :: FilePath +birthdate = "birthdates.csv" + +config :: FilePath +config = "config.txt" diff --git a/src/Notification.hs b/src/Notification.hs new file mode 100644 index 0000000..de4a591 --- /dev/null +++ b/src/Notification.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Notification + ( today + , nextWeek + ) where + +import qualified Data.Text as T + +import SendMail (sendMail) +import Time (formatCurrentLocale) + +import Model.Date (getCurrentDate, getNextWeek) +import Model.Birthdate (Birthdate, filterBirthdayAt, filterBirthdayBetween) +import Model.Mail (mailSubject, mailBody) +import Model.Config + +today :: [Birthdate] -> Config -> IO () +today birthdates config = do + currentDate <- getCurrentDate + let birthdays = filterBirthdayAt currentDate birthdates + if not (null birthdays) + then + sendMail + (mailTo config) + (mailFrom config) + (mailSubject birthdays) + (mailBody currentDate birthdays) + else + return () + +nextWeek :: [Birthdate] -> Config -> IO () +nextWeek birthdates config = do + currentDayOfWeek <- formatCurrentLocale "%A" + if T.toLower currentDayOfWeek == T.toLower (dayForNextWeekNotification config) + then do + (begin, end) <- getNextWeek + let birthdays = filterBirthdayBetween begin end birthdates + if not (null birthdays) + then + sendMail + (mailTo config) + (mailFrom config) + "" + "" + else + return () + else + return () diff --git a/src/RenderError.hs b/src/RenderError.hs new file mode 100644 index 0000000..9b9732f --- /dev/null +++ b/src/RenderError.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE OverloadedStrings #-} + +module RenderError + ( birthdate + , config + ) where + +import System.IO (stderr) + +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.IO as T + +import qualified Model.Path as Path + +birthdate :: Text -> IO () +birthdate err = + T.hPutStr stderr $ + T.concat + [ "Error while parsing file " + , T.pack Path.birthdate + , ":\n" + , err + ] + +config :: Text -> IO () +config err = + T.hPutStr stderr $ + T.concat + [ "Error while parsing config file " + , T.pack Path.config + , ":\n" + , err + ] diff --git a/src/Time.hs b/src/Time.hs new file mode 100644 index 0000000..97a9317 --- /dev/null +++ b/src/Time.hs @@ -0,0 +1,12 @@ +module Time + ( formatCurrentLocale + ) where + +import Data.Text (Text) +import qualified Data.Text as T +import Data.Time.LocalTime (getZonedTime) +import Data.Time.Format (formatTime, defaultTimeLocale) + +formatCurrentLocale :: Text -> IO Text +formatCurrentLocale format = + T.pack <$> formatTime defaultTimeLocale (T.unpack format) <$> getZonedTime -- cgit v1.2.3