Added Text.Pandoc.Writers.OPML.

TODO:

* Document in README
* Add tests
* Add template (and add template to cabal file)

3 files changed, 92 insertions, 1 deletions

diff --git a/src/Text/Pandoc.hs b/src/Text/Pandoc.hs
index 80ddb72d7..ca923d091 100644
--- a/src/Text/Pandoc.hs
+++ b/src/Text/Pandoc.hs
@@ -86,6 +86,7 @@ module Text.Pandoc
                , writeHtml
                , writeHtmlString
                , writeDocbook
+               , writeOPML
                , writeOpenDocument
                , writeMan
                , writeMediaWiki
@@ -131,6 +132,7 @@ import Text.Pandoc.Writers.Docx
 import Text.Pandoc.Writers.EPUB
 import Text.Pandoc.Writers.FB2
 import Text.Pandoc.Writers.Docbook
+import Text.Pandoc.Writers.OPML
 import Text.Pandoc.Writers.OpenDocument
 import Text.Pandoc.Writers.Man
 import Text.Pandoc.Writers.RTF
@@ -230,6 +232,7 @@ writers = [
      writeHtmlString o{ writerSlideVariant = DZSlides
                       , writerHtml5 = True })
   ,("docbook"      , PureStringWriter writeDocbook)
+  ,("opml"         , PureStringWriter writeOPML)
   ,("opendocument" , PureStringWriter writeOpenDocument)
   ,("latex"        , PureStringWriter writeLaTeX)
   ,("beamer"       , PureStringWriter $ \o ->
diff --git a/src/Text/Pandoc/Writers/OPML.hs b/src/Text/Pandoc/Writers/OPML.hs
new file mode 100644
index 000000000..d6c0aa21a
--- /dev/null
+++ b/src/Text/Pandoc/Writers/OPML.hs
@@ -0,0 +1,81 @@
+{-
+Copyright (C) 2013 John MacFarlane <jgm@berkeley.edu>
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+-}
+
+{- |
+   Module      : Text.Pandoc.Writers.OPML
+   Copyright   : Copyright (C) 2013 John MacFarlane
+   License     : GNU GPL, version 2 or above
+
+   Maintainer  : John MacFarlane <jgm@berkeley.edu>
+   Stability   : alpha
+   Portability : portable
+
+Conversion of 'Pandoc' documents to OPML XML.
+-}
+module Text.Pandoc.Writers.OPML ( writeOPML) where
+import Text.Pandoc.Definition
+import Text.Pandoc.XML
+import Text.Pandoc.Shared
+import Text.Pandoc.Options
+import Text.Pandoc.Templates (renderTemplate)
+import Text.Pandoc.Writers.HTML (writeHtmlString)
+import Text.Pandoc.Writers.Markdown (writeMarkdown)
+import Data.List ( intercalate )
+import Text.Pandoc.Pretty
+
+-- | Convert Pandoc document to string in OPML format.
+writeOPML :: WriterOptions -> Pandoc -> String
+writeOPML opts (Pandoc (Meta tit auths dat) blocks) =
+  let title = writeHtmlInlines tit
+      author = writeHtmlInlines $ intercalate [Space,Str ";",Space] auths
+      date = trim $ writeHtmlInlines dat
+      elements = hierarchicalize blocks
+      colwidth = if writerWrapText opts
+                    then Just $ writerColumns opts
+                    else Nothing
+      render' = render colwidth
+      main     = render' $ vcat (map (elementToOPML opts) elements)
+      context = writerVariables opts ++
+                [ ("body", main)
+                , ("title", title)
+                , ("date", date)
+                , ("author", author) ]
+  in  if writerStandalone opts
+         then renderTemplate context $ writerTemplate opts
+         else main
+
+writeHtmlInlines :: [Inline] -> String
+writeHtmlInlines ils = trim $ writeHtmlString def
+                            $ Pandoc (Meta [] [] []) [Plain ils]
+
+-- | Convert an Element to OPML.
+elementToOPML :: WriterOptions -> Element -> Doc
+elementToOPML _ (Blk _) = empty
+elementToOPML opts (Sec _ _num _ title elements) =
+  let isBlk (Blk _) = True
+      isBlk _     = False
+      fromBlk (Blk x) = x
+      fromBlk _ = error "fromBlk called on non-block"
+      (blocks, rest) = span isBlk elements
+      attrs = [("text", writeHtmlInlines title)] ++
+              [("_note", writeMarkdown opts (Pandoc (Meta [] [] [])
+                              (map fromBlk blocks)))
+                | not (null blocks)]
+  in  inTags True "outline" attrs $
+      vcat (map (elementToOPML opts) rest)
+
diff --git a/src/Text/Pandoc/XML.hs b/src/Text/Pandoc/XML.hs
index 31279c3bb..3f684f728 100644
--- a/src/Text/Pandoc/XML.hs
+++ b/src/Text/Pandoc/XML.hs
@@ -64,11 +64,18 @@ escapeCharForXML x = case x of
 escapeStringForXML :: String -> String
 escapeStringForXML = concatMap escapeCharForXML
 
+-- | Escape newline characters as &#10;
+escapeNls :: String -> String
+escapeNls (x:xs)
+  | x == '\n' = "&#10;" ++ escapeNls xs
+  | otherwise = x : escapeNls xs
+escapeNls []     = []
+
 -- | Return a text object with a string of formatted XML attributes.
 attributeList :: [(String, String)] -> Doc
 attributeList = hcat . map
   (\(a, b) -> text (' ' : escapeStringForXML a ++ "=\"" ++
-  escapeStringForXML b ++ "\""))
+  escapeNls (escapeStringForXML b) ++ "\""))
 
 -- | Put the supplied contents between start and end tags of tagType,
 --   with specified attributes and (if specified) indentation.