1 files changed, 13 insertions, 22 deletions
diff --git a/src/Text/Pandoc/Writers/OPML.hs b/src/Text/Pandoc/Writers/OPML.hs
index 7bbb026bb..83f64ec5e 100644
--- a/src/Text/Pandoc/Writers/OPML.hs
+++ b/src/Text/Pandoc/Writers/OPML.hs
@@ -13,14 +13,12 @@ Conversion of 'Pandoc' documents to OPML XML.
 -}
 module Text.Pandoc.Writers.OPML ( writeOPML) where
 import Prelude
-import Control.Monad.Except (throwError)
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Text.Pandoc.Builder as B
 import Text.Pandoc.Class (PandocMonad)
 import Data.Time
 import Text.Pandoc.Definition
-import Text.Pandoc.Error
 import Text.Pandoc.Options
 import Text.DocLayout
 import Text.Pandoc.Shared
@@ -33,8 +31,7 @@ import Text.Pandoc.XML
 -- | Convert Pandoc document to string in OPML format.
 writeOPML :: PandocMonad m => WriterOptions -> Pandoc -> m Text
 writeOPML opts (Pandoc meta blocks) = do
-  let elements = hierarchicalize blocks
-      colwidth = if writerWrapText opts == WrapAuto
+  let colwidth = if writerWrapText opts == WrapAuto
                     then Just $ writerColumns opts
                     else Nothing
       meta' = B.setMeta "date" (B.str $ convertDate $ docDate meta) meta
@@ -42,7 +39,8 @@ writeOPML opts (Pandoc meta blocks) = do
               (writeMarkdown def . Pandoc nullMeta)
               (\ils -> T.stripEnd <$> writeMarkdown def (Pandoc nullMeta [Plain ils]))
               meta'
-  main <- (render colwidth . vcat) <$> mapM (elementToOPML opts) elements
+  let blocks' = makeSections False (Just 1) blocks
+  main <- (render colwidth . vcat) <$> mapM (blockToOPML opts) blocks'
   let context = defField "body" main metadata
   return $
     (if writerPreferAscii opts then toEntities else id) $
@@ -63,25 +61,18 @@ convertDate :: [Inline] -> String
 convertDate ils = maybe "" showDateTimeRFC822 $
   parseTimeM True defaultTimeLocale "%F" =<< normalizeDate (stringify ils)
 
--- | Convert an Element to OPML.
-elementToOPML :: PandocMonad m => WriterOptions -> Element -> m (Doc Text)
-elementToOPML _ (Blk _) = return empty
-elementToOPML opts (Sec _ _num _ title elements) = do
-  let isBlk :: Element -> Bool
-      isBlk (Blk _) = True
-      isBlk _       = False
-
-      fromBlk :: PandocMonad m => Element -> m Block
-      fromBlk (Blk x) = return x
-      fromBlk _ = throwError $ PandocSomeError "fromBlk called on non-block"
-
-      (blocks, rest) = span isBlk elements
+-- | Convert a Block to OPML.
+blockToOPML :: PandocMonad m => WriterOptions -> Block -> m (Doc Text)
+blockToOPML opts (Div (_,"section":_,_) (Header _ _ title : xs)) = do
+  let isSect (Div (_,"section":_,_) (Header{}:_)) = True
+      isSect _ = False
+  let (blocks, rest) = break isSect xs
   htmlIls <- writeHtmlInlines title
   md <- if null blocks
         then return mempty
-        else do blks <- mapM fromBlk blocks
-                writeMarkdown def $ Pandoc nullMeta blks
+        else writeMarkdown def $ Pandoc nullMeta blocks
   let attrs = ("text", T.unpack htmlIls) :
               [("_note", T.unpack $ T.stripEnd md) | not (null blocks)]
-  o <- mapM (elementToOPML opts) rest
-  return $ inTags True "outline" attrs $ vcat o
+  rest' <- vcat <$> mapM (blockToOPML opts) rest
+  return $ inTags True "outline" attrs rest'
+blockToOPML _ _ = return empty