46 lines
1.5 KiB
Haskell
46 lines
1.5 KiB
Haskell
import Text.Pandoc.Definition
|
|
import Data.Map.Strict (Map)
|
|
import qualified Data.Map.Strict as Map
|
|
import Data.Time
|
|
import Text.Pandoc.JSON
|
|
import Data.Text (Text, unpack, pack)
|
|
import Data.Char (toLower)
|
|
|
|
main :: IO ()
|
|
main = toJSONFilter \(Pandoc (Meta m) body) -> do
|
|
m' <- niceDate m
|
|
pure $ Pandoc (Meta m') body
|
|
|
|
niceDate :: Map Text MetaValue -> IO (Map Text MetaValue)
|
|
niceDate = Map.alterF reformat "date"
|
|
|
|
reformat :: Maybe MetaValue -> IO (Maybe MetaValue)
|
|
reformat Nothing = pure Nothing
|
|
reformat (Just (toText -> Just txt)) = do
|
|
-- extra '-'s in %-m and %-d to allow leading zeroes to be skipped
|
|
date <- parseTimeM True defaultTimeLocale "%Y-%-m-%-d" $ unpack txt
|
|
let str = formatTime defaultTimeLocale "%A %-e %B %Y" (date :: Day)
|
|
pure $ Just $ MetaString $ pack $ map toLower str
|
|
reformat (Just d) = fail $ "date is\n" <> show d <> "\nwanted a string"
|
|
|
|
toText :: MetaValue -> Maybe Text
|
|
toText (MetaString str) = Just str
|
|
toText (MetaInlines is) = foldMap inlineText is
|
|
toText (MetaBlocks bs) = foldMap blockText bs
|
|
toText _ = Nothing
|
|
|
|
inlineText :: Inline -> Maybe Text
|
|
inlineText (Str txt) = Just txt
|
|
inlineText Space = Just " "
|
|
inlineText SoftBreak = Just " "
|
|
inlineText LineBreak = Just " "
|
|
inlineText (RawInline _ txt) = Just txt
|
|
inlineText _ = Nothing
|
|
|
|
blockText :: Block -> Maybe Text
|
|
blockText (Plain is) = foldMap inlineText is
|
|
blockText (Para is) = foldMap inlineText is
|
|
blockText Null = Just ""
|
|
blockText (RawBlock _ txt) = Just txt
|
|
blockText _ = Nothing
|