From 3a0b3df00701eef2a0549487e08fa4d63c3ab8d9 Mon Sep 17 00:00:00 2001
From: John MacFarlane <fiddlosopher@gmail.com>
Date: Sat, 28 Jan 2012 15:54:05 -0800
Subject: Put date in YYYY-MM-DD format if possible for HTML, docx metadata.

Added normalizeDate to Text.Pandoc.Shared.
---
 src/Text/Pandoc/Shared.hs       | 17 +++++++++++++++++
 src/Text/Pandoc/Writers/Docx.hs |  7 ++++---
 src/Text/Pandoc/Writers/HTML.hs |  4 ++--
 3 files changed, 23 insertions(+), 5 deletions(-)

(limited to 'src/Text')

diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs
index 952218176..7e63c2161 100644
--- a/src/Text/Pandoc/Shared.hs
+++ b/src/Text/Pandoc/Shared.hs
@@ -46,6 +46,8 @@ module Text.Pandoc.Shared (
                      toRomanNumeral,
                      escapeURI,
                      tabFilter,
+                     -- * Date/time
+                     normalizeDate,
                      -- * Pandoc block and inline list processing
                      orderedListMarkers,
                      normalizeSpaces,
@@ -81,9 +83,12 @@ import System.Directory
 import System.FilePath ( (</>) )
 import Data.Generics (Typeable, Data)
 import qualified Control.Monad.State as S
+import Control.Monad (msum)
 import Paths_pandoc (getDataFileName)
 import Text.Pandoc.Highlighting (Style, pygments)
 import Text.Pandoc.Pretty (charWidth)
+import System.Locale (defaultTimeLocale)
+import Data.Time
 
 --
 -- List processing
@@ -217,6 +222,18 @@ tabFilter tabStop =
         x : go (spsToNextStop - 1) xs
   in  go tabStop
 
+--
+-- Date/time
+--
+
+-- | Parse a date and convert (if possible) to "YYYY-MM-DD" format.
+normalizeDate :: String -> Maybe String
+normalizeDate s = fmap (formatTime defaultTimeLocale "%F")
+  (msum $ map (\fs -> parsetimeWith fs s) formats :: Maybe Day)
+   where parsetimeWith = parseTime defaultTimeLocale
+         formats = ["%x","%m/%d/%Y", "%D","%F", "%d %b %Y",
+                    "%d %B %Y", "%b. %d, %Y", "%B %d, %Y"]
+
 --
 -- Pandoc block and inline list processing
 --
diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
index fb05c18a3..218a6e42a 100644
--- a/src/Text/Pandoc/Writers/Docx.hs
+++ b/src/Text/Pandoc/Writers/Docx.hs
@@ -97,7 +97,7 @@ writeDocx :: Maybe FilePath -- ^ Path specified by --reference-docx
           -> WriterOptions  -- ^ Writer options
           -> Pandoc         -- ^ Document to convert
           -> IO B.ByteString
-writeDocx mbRefDocx opts doc@(Pandoc (Meta tit auths _) _) = do
+writeDocx mbRefDocx opts doc@(Pandoc (Meta tit auths date) _) = do
   let datadir = writerUserDataDir opts
   refArchive <- liftM toArchive $
        case mbRefDocx of
@@ -161,7 +161,8 @@ writeDocx mbRefDocx opts doc@(Pandoc (Meta tit auths _) _) = do
           ,("xmlns:dcmitype","http://purl.org/dc/dcmitype/")
           ,("xmlns:xsi","http://www.w3.org/2001/XMLSchema-instance")]
           $ mknode "dc:title" [] (stringify tit)
-          : mknode "dcterms:created" [("xsi:type","dcterms:W3CDTF")] ()  -- put doc date here
+          : mknode "dcterms:created" [("xsi:type","dcterms:W3CDTF")]
+            (maybe "" id $ normalizeDate $ stringify date)
           : mknode "dcterms:modified" [("xsi:type","dcterms:W3CDTF")] () -- put current time here
           : map (mknode "dc:creator" [] . stringify) auths
   let docPropsEntry = toEntry docPropsPath epochtime $ fromString $ showTopElement' docProps
@@ -653,4 +654,4 @@ inlineToOpenXML opts (Image alt (src, tit)) = do
      else do
        liftIO $ UTF8.hPutStrLn stderr $
           "Could not find image `" ++ src ++ "', skipping..."
-       inlinesToOpenXML opts alt
\ No newline at end of file
+       inlinesToOpenXML opts alt
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index 5530247a2..8ca7aca62 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -182,13 +182,13 @@ inTemplate :: TemplateTarget a
 inTemplate opts tit auths authsMeta date toc body' newvars =
   let title'      = renderHtml tit
       date'       = renderHtml date
+      dateMeta    = maybe [] (\x -> [("date-meta",x)]) $ normalizeDate date'
       variables   = writerVariables opts ++ newvars
-      context     = variables ++
+      context     = variables ++ dateMeta ++
                     [ ("body", dropWhile (=='\n') $ renderHtml body')
                     , ("pagetitle", stripTags title')
                     , ("title", title')
                     , ("date", date')
-                    , ("date-meta", stripTags date')
                     , ("idprefix", writerIdentifierPrefix opts)
                     , ("slidy-url", "http://www.w3.org/Talks/Tools/Slidy2")
                     , ("s5-url", "s5/default") ] ++
-- 
cgit v1.2.3