Compare commits

...

2 commits

View file

@ -10,11 +10,13 @@ module Article (
import Control.Applicative ((<|>)) 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 (
import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds) UTCTime, defaultTimeLocale, getCurrentTimeZone, parseTimeM
import Foreign.C.Types (CTime) , timeZoneOffsetString
)
import Data.Time.Clock.System (systemSeconds, utcToSystemTime)
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 +73,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 . systemSeconds . utcToSystemTime
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 +100,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