EPUB Writer: Added page-progression-direction meta field

1 files changed, 21 insertions, 2 deletions

diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs
index 658fd217c..2aab7701f 100644
--- a/src/Text/Pandoc/Writers/EPUB.hs
+++ b/src/Text/Pandoc/Writers/EPUB.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE PatternGuards, CPP, ScopedTypeVariables #-}
+{-# LANGUAGE PatternGuards, CPP, ScopedTypeVariables, ViewPatterns #-}
 {-
 Copyright (C) 2010-2014 John MacFarlane <jgm@berkeley.edu>
 
@@ -94,6 +94,7 @@ data EPUBMetadata = EPUBMetadata{
   , epubRights             :: Maybe String
   , epubCoverImage         :: Maybe String
   , epubStylesheet         :: Maybe Stylesheet
+  , epubPageDirection      :: ProgressionDirection
   } deriving Show
 
 data Stylesheet = StylesheetPath FilePath
@@ -122,6 +123,8 @@ data Title = Title{
   , titleType              :: Maybe String
   } deriving Show
 
+data ProgressionDirection = LTR | RTL | Default deriving Show
+
 dcName :: String -> QName
 dcName n = QName n Nothing (Just "dc")
 
@@ -296,6 +299,7 @@ metadataFromMeta opts meta = EPUBMetadata{
     , epubRights             = rights
     , epubCoverImage         = coverImage
     , epubStylesheet         = stylesheet
+    , epubPageDirection      = pageDirection
     }
   where identifiers = getIdentifier meta
         titles = getTitle meta
@@ -318,6 +322,14 @@ metadataFromMeta opts meta = EPUBMetadata{
         stylesheet = (StylesheetContents <$> writerEpubStylesheet opts) `mplus`
                      ((StylesheetPath . metaValueToString) <$>
                        lookupMeta "stylesheet" meta)
+        pageDirection = maybe Default stringToPageDirection
+                          (lookupMeta "page-progression-direction" meta)
+        stringToPageDirection (metaValueToString -> s) =
+          case s of
+            "ltr" -> LTR
+            "rtl" -> RTL
+            _ -> Default
+
 
 -- | Produce an EPUB file from a Pandoc document.
 writeEPUB :: WriterOptions  -- ^ Writer options
@@ -382,6 +394,12 @@ writeEPUB opts doc@(Pandoc meta _) = do
   let mkFontEntry f = mkEntry (takeFileName f) `fmap` B.readFile f
   fontEntries <- mapM mkFontEntry $ writerEpubFonts opts'
 
+  -- set page progression direction
+  let progressionDirection = case epubPageDirection metadata of
+                              LTR -> "ltr"
+                              RTL -> "rtl"
+                              Default -> "default"
+
   -- body pages
 
   -- add level 1 header to beginning if none there
@@ -501,7 +519,8 @@ writeEPUB opts doc@(Pandoc meta _) = do
                               (pictureNode x)]) ++
              map pictureNode picEntries ++
              map fontNode fontEntries
-          , unode "spine" ! [("toc","ncx")] $
+          , unode "spine" ! [("toc","ncx")
+                            ,("page-progression-direction", progressionDirection)] $
               case epubCoverImage metadata of
                     Nothing -> []
                     Just _ -> [ unode "itemref" !