Added Text.Pandoc.Writers.OPML.

TODO:

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

pandoc.cabal

@@ -18,7 +18,7 @@ Description:     Pandoc is a Haskell library for converting from one markup
                  this library. It can read markdown and (subsets of) HTML,
                  reStructuredText, LaTeX, DocBook, MediaWiki markup, OPML,
                  and Textile, and it can write markdown, reStructuredText,
-                 HTML, LaTeX, ConTeXt, Docbook, OpenDocument, ODT,
+                 HTML, LaTeX, ConTeXt, Docbook, OPML, OpenDocument, ODT,
                  Word docx, RTF, MediaWiki, Textile, groff man pages,
                  plain text, Emacs Org-Mode, AsciiDoc, EPUB (v2 and v3),
                  FictionBook2, and S5, Slidy and Slideous HTML slide shows.
@@ -286,6 +286,7 @@ Library
                    Text.Pandoc.Readers.Native,
                    Text.Pandoc.Writers.Native,
                    Text.Pandoc.Writers.Docbook,
+                   Text.Pandoc.Writers.OPML,
                    Text.Pandoc.Writers.HTML,
                    Text.Pandoc.Writers.LaTeX,
                    Text.Pandoc.Writers.ConTeXt,

pandoc.hs

@@ -802,6 +802,7 @@ defaultWriterName x =
     ".asciidoc" -> "asciidoc"
     ".pdf"      -> "latex"
     ".fb2"      -> "fb2"
+    ".opml"     -> "opml"
     ['.',y] | y `elem` ['1'..'9'] -> "man"
     _          -> "html"
 

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 ->

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)
+

src/Text/Pandoc/XML.hs

@@ -64,11 +64,18 @@ escapeCharForXML x = case x of
 escapeStringForXML :: String -> String
 escapeStringForXML = concatMap escapeCharForXML
 
+-- | Escape newline characters as 

+escapeNls :: String -> String
+escapeNls (x:xs)
+  | x == '\n' = "
" ++ 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.