Use UTCTime and stay out of the unix package for future possible windows compatibility

This commit is contained in:
Tissevert 2020-01-08 14:39:10 +01:00
parent 36651ddc38
commit bbcffcfefb

View file

@ -11,10 +11,10 @@ import Control.Applicative ((<|>))
import Data.Map (Map) import Data.Map (Map)
import qualified Data.Map as Map (fromList, alter) import qualified Data.Map as Map (fromList, alter)
import Data.Time (defaultTimeLocale, getCurrentTimeZone, parseTimeM, timeZoneOffsetString) import Data.Time (defaultTimeLocale, getCurrentTimeZone, parseTimeM, timeZoneOffsetString)
import Data.Time.Clock (UTCTime)
import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds) import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds)
import Foreign.C.Types (CTime) import System.Directory (getModificationTime)
import System.FilePath (dropExtension, takeFileName) import System.FilePath (dropExtension, takeFileName)
import System.Posix.Files (getFileStatus, modificationTime)
import Text.ParserCombinators.Parsec ( import Text.ParserCombinators.Parsec (
ParseError ParseError
, Parser , Parser
@ -71,16 +71,17 @@ eol = try (string "\r\n") <|> string "\r" <|> string "\n" <?> "newline"
no :: String -> Parser String no :: String -> Parser String
no = many1 . noneOf no = many1 . noneOf
setDate :: String -> CTime -> Metadata -> Metadata getTimestamp :: UTCTime -> String
getTimestamp = show . (truncate :: POSIXTime -> Integer) . utcTimeToPOSIXSeconds
setDate :: String -> String -> Metadata -> Metadata
setDate tzOffset defaultDate = Map.alter timeStamp "date" setDate tzOffset defaultDate = Map.alter timeStamp "date"
where where
formats = ("%Y-%m-%d" ++) . (++ " %z") <$> ["", " %H:%M"] formats = ("%Y-%m-%d" ++) . (++ " %z") <$> ["", " %H:%M"]
epoch = show . (truncate :: POSIXTime -> Integer) . utcTimeToPOSIXSeconds timeStamp = maybe (Just defaultDate) $ \date ->
timeStamp Nothing = Just $ show defaultDate
timeStamp (Just date) =
let dates = [date, date ++ " " ++ tzOffset] in let dates = [date, date ++ " " ++ tzOffset] in
let parsedTimes = parseTimeM True defaultTimeLocale <$> formats <*> dates in let parsedTimes = parseTimeM True defaultTimeLocale <$> formats <*> dates in
foldr (<|>) (timeStamp Nothing) (fmap epoch <$> parsedTimes) foldr (<|>) (timeStamp Nothing) (fmap getTimestamp <$> parsedTimes)
makeArticle :: FilePath -> (Metadata -> Metadata) -> ProtoArticle -> (String, Article) makeArticle :: FilePath -> (Metadata -> Metadata) -> ProtoArticle -> (String, Article)
makeArticle filePath metaFilter (title, metadata, bodyOffset, body) = ( makeArticle filePath metaFilter (title, metadata, bodyOffset, body) = (
@ -97,7 +98,7 @@ makeArticle filePath metaFilter (title, metadata, bodyOffset, body) = (
at :: FilePath -> IO (Either ParseError (String, Article)) at :: FilePath -> IO (Either ParseError (String, Article))
at filePath = do at filePath = do
tzOffset <- timeZoneOffsetString <$> getCurrentTimeZone tzOffset <- timeZoneOffsetString <$> getCurrentTimeZone
fileDate <- modificationTime <$> getFileStatus filePath fileDate <- getTimestamp <$> getModificationTime filePath
let build = makeArticle filePath (setDate tzOffset fileDate) let build = makeArticle filePath (setDate tzOffset fileDate)
fmap build . parse articleP filePath <$> readFile filePath fmap build . parse articleP filePath <$> readFile filePath