{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP               #-}
{- |
   Module      : Text.Pandoc.Writers.OPML
   Copyright   : Copyright (C) 2013-2023 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 Data.Text (Text)
import qualified Data.Text as T
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Class.PandocMonad (PandocMonad)
import Data.Time
import Text.Pandoc.Definition
import Text.Pandoc.Options
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.HTML (writeHtml5String)
import Text.Pandoc.Writers.Markdown (writeMarkdown)
import Text.Pandoc.Writers.Shared
import Text.Pandoc.XML

-- | Convert Pandoc document to string in OPML format.
writeOPML :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeOPML :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeOPML WriterOptions
opts (Pandoc Meta
meta [Block]
blocks) = do
  let colwidth :: Maybe Int
colwidth = if WriterOptions -> WrapOption
writerWrapText WriterOptions
opts forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
                    then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
opts
                    else forall a. Maybe a
Nothing
      meta' :: Meta
meta' = forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
B.setMeta Text
"date" (Text -> Inlines
B.str forall a b. (a -> b) -> a -> b
$ [Inline] -> Text
convertDate forall a b. (a -> b) -> a -> b
$ Meta -> [Inline]
docDate Meta
meta) Meta
meta
  Context Text
metadata <- forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
opts
              (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. HasChars a => a -> Doc a
literal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeMarkdown forall a. Default a => a
def forall b c a. (b -> c) -> (a -> b) -> a -> c
. Meta -> [Block] -> Pandoc
Pandoc Meta
nullMeta)
              (\[Inline]
ils -> forall a. HasChars a => a -> Doc a
literal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.stripEnd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeMarkdown forall a. Default a => a
def (Meta -> [Block] -> Pandoc
Pandoc Meta
nullMeta [[Inline] -> Block
Plain [Inline]
ils]))
              Meta
meta'
  let blocks' :: [Block]
blocks' = Bool -> Maybe Int -> [Block] -> [Block]
makeSections Bool
False (forall a. a -> Maybe a
Just Int
1) [Block]
blocks
  Text
main <- forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Doc a] -> Doc a
vcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
             forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> m (Doc Text)
blockToOPML WriterOptions
opts) [Block]
blocks'
  let context :: Context Text
context = forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" Text
main Context Text
metadata
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    (if WriterOptions -> Bool
writerPreferAscii WriterOptions
opts then Text -> Text
toEntities else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$
    case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
       Maybe (Template Text)
Nothing  -> Text
main
       Just Template Text
tpl -> forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth forall a b. (a -> b) -> a -> b
$ forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl Context Text
context


writeHtmlInlines :: PandocMonad m => [Inline] -> m Text
writeHtmlInlines :: forall (m :: * -> *). PandocMonad m => [Inline] -> m Text
writeHtmlInlines [Inline]
ils =
  Text -> Text
T.strip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeHtml5String forall a. Default a => a
def (Meta -> [Block] -> Pandoc
Pandoc Meta
nullMeta [[Inline] -> Block
Plain [Inline]
ils])

-- date format: RFC 822: Thu, 14 Jul 2005 23:41:05 GMT
showDateTimeRFC822 :: UTCTime -> Text
showDateTimeRFC822 :: UTCTime -> Text
showDateTimeRFC822 = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%a, %d %b %Y %X %Z"

convertDate :: [Inline] -> Text
convertDate :: [Inline] -> Text
convertDate [Inline]
ils = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" UTCTime -> Text
showDateTimeRFC822 forall a b. (a -> b) -> a -> b
$
  forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
"%F" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Maybe Text
normalizeDate (forall a. Walkable Inline a => a -> Text
stringify [Inline]
ils)

-- | Convert a Block to OPML.
blockToOPML :: PandocMonad m => WriterOptions -> Block -> m (Doc Text)
blockToOPML :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> m (Doc Text)
blockToOPML WriterOptions
opts (Div (Text
_,Text
"section":[Text]
_,[(Text, Text)]
_) (Header Int
_ (Text, [Text], [(Text, Text)])
_ [Inline]
title : [Block]
xs)) = do
  let isSect :: Block -> Bool
isSect (Div (Text
_,Text
"section":[Text]
_,[(Text, Text)]
_) (Header{}:[Block]
_)) = Bool
True
      isSect Block
_ = Bool
False
  let ([Block]
blocks, [Block]
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break Block -> Bool
isSect [Block]
xs
  Text
htmlIls <- forall (m :: * -> *). PandocMonad m => [Inline] -> m Text
writeHtmlInlines [Inline]
title
  Text
md <- if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
blocks
        then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
        else forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeMarkdown forall a. Default a => a
def forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc Meta
nullMeta [Block]
blocks
  let attrs :: [(Text, Text)]
attrs = (Text
"text", Text
htmlIls) forall a. a -> [a] -> [a]
:
              [(Text
"_note", Text -> Text
T.stripEnd Text
md) | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
blocks)]
  Doc Text
rest' <- forall a. [Doc a] -> Doc a
vcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> m (Doc Text)
blockToOPML WriterOptions
opts) [Block]
rest
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"outline" [(Text, Text)]
attrs Doc Text
rest'
blockToOPML WriterOptions
_ Block
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty