@@ -0,0 +1,81 @@
1+{-
2+Copyright (C) 2013 John MacFarlane <jgm@berkeley.edu>
3+
4+This program is free software; you can redistribute it and/or modify
5+it under the terms of the GNU General Public License as published by
6+the Free Software Foundation; either version 2 of the License, or
7+(at your option) any later version.
8+
9+This program is distributed in the hope that it will be useful,
10+but WITHOUT ANY WARRANTY; without even the implied warranty of
11+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12+GNU General Public License for more details.
13+
14+You should have received a copy of the GNU General Public License
15+along with this program; if not, write to the Free Software
16+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
17+-}
18+
19+{- |
20+ Module : Text.Pandoc.Writers.OPML
21+ Copyright : Copyright (C) 2013 John MacFarlane
22+ License : GNU GPL, version 2 or above
23+
24+ Maintainer : John MacFarlane <jgm@berkeley.edu>
25+ Stability : alpha
26+ Portability : portable
27+
28+Conversion of 'Pandoc' documents to OPML XML.
29+-}
30+module Text.Pandoc.Writers.OPML ( writeOPML) where
31+import Text.Pandoc.Definition
32+import Text.Pandoc.XML
33+import Text.Pandoc.Shared
34+import Text.Pandoc.Options
35+import Text.Pandoc.Templates (renderTemplate)
36+import Text.Pandoc.Writers.HTML (writeHtmlString)
37+import Text.Pandoc.Writers.Markdown (writeMarkdown)
38+import Data.List ( intercalate )
39+import Text.Pandoc.Pretty
40+
41+-- | Convert Pandoc document to string in OPML format.
42+writeOPML :: WriterOptions -> Pandoc -> String
43+writeOPML opts (Pandoc (Meta tit auths dat) blocks) =
44+ let title = writeHtmlInlines tit
45+ author = writeHtmlInlines $ intercalate [Space,Str ";",Space] auths
46+ date = trim $ writeHtmlInlines dat
47+ elements = hierarchicalize blocks
48+ colwidth = if writerWrapText opts
49+ then Just $ writerColumns opts
50+ else Nothing
51+ render' = render colwidth
52+ main = render' $ vcat (map (elementToOPML opts) elements)
53+ context = writerVariables opts ++
54+ [ ("body", main)
55+ , ("title", title)
56+ , ("date", date)
57+ , ("author", author) ]
58+ in if writerStandalone opts
59+ then renderTemplate context $ writerTemplate opts
60+ else main
61+
62+writeHtmlInlines :: [Inline] -> String
63+writeHtmlInlines ils = trim $ writeHtmlString def
64+ $ Pandoc (Meta [] [] []) [Plain ils]
65+
66+-- | Convert an Element to OPML.
67+elementToOPML :: WriterOptions -> Element -> Doc
68+elementToOPML _ (Blk _) = empty
69+elementToOPML opts (Sec _ _num _ title elements) =
70+ let isBlk (Blk _) = True
71+ isBlk _ = False
72+ fromBlk (Blk x) = x
73+ fromBlk _ = error "fromBlk called on non-block"
74+ (blocks, rest) = span isBlk elements
75+ attrs = [("text", writeHtmlInlines title)] ++
76+ [("_note", writeMarkdown opts (Pandoc (Meta [] [] [])
77+ (map fromBlk blocks)))
78+ | not (null blocks)]
79+ in inTags True "outline" attrs $
80+ vcat (map (elementToOPML opts) rest)
81+