    {-# LANGUAGE OverloadedStrings #-}
    {- |
       Module      : Text.Pandoc.Readers.OPML
       Copyright   : Copyright (C) 2013-2024 John MacFarlane
       License     : GNU GPL, version 2 or above

       Maintainer  : John MacFarlane <jgm@berkeley.edu>
       Stability   : alpha
       Portability : portable

    Conversion of OPML to 'Pandoc' document.
    -}

    module Text.Pandoc.Readers.OPML ( readOPML ) where
    import Control.Monad.State.Strict
    import Data.Default
    import Data.Maybe (fromMaybe)
    import Data.Text (Text)
    import qualified Data.Text as T
    import qualified Data.Text.Lazy as TL
    import Text.Pandoc.Builder
    import Text.Pandoc.Class.PandocMonad (PandocMonad)
    import Text.Pandoc.Options
    import Text.Pandoc.Error (PandocError(..))
    import Text.Pandoc.Readers.HTML (readHtml)
    import Text.Pandoc.Readers.Markdown (readMarkdown)
    import Text.Pandoc.Shared (blocksToInlines')
    import Text.Pandoc.Sources (ToSources(..), sourcesToText)
    import Text.Pandoc.XML.Light
    import Control.Monad.Except (throwError)

    type OPML m = StateT OPMLState m

    data OPMLState = OPMLState{
                            OPMLState -> Int
    opmlSectionLevel :: Int
                          , OPMLState -> Inlines
    opmlDocTitle     :: Inlines
                          , OPMLState -> [Inlines]
    opmlDocAuthors   :: [Inlines]
                          , OPMLState -> Inlines
    opmlDocDate      :: Inlines
                          , OPMLState -> ReaderOptions
    opmlOptions      :: ReaderOptions
                          } deriving Int -> OPMLState -> ShowS
    [OPMLState] -> ShowS
    OPMLState -> String
    (Int -> OPMLState -> ShowS)
    -> (OPMLState -> String)
    -> ([OPMLState] -> ShowS)
    -> Show OPMLState
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> OPMLState -> ShowS
    showsPrec :: Int -> OPMLState -> ShowS
    $cshow :: OPMLState -> String
    show :: OPMLState -> String
    $cshowList :: [OPMLState] -> ShowS
    showList :: [OPMLState] -> ShowS
    Show

    instance Default OPMLState where
      def :: OPMLState
    def = OPMLState{ opmlSectionLevel :: Int
    opmlSectionLevel = Int
    0
                     , opmlDocTitle :: Inlines
    opmlDocTitle = Inlines
    forall a. Monoid a => a
    mempty
                     , opmlDocAuthors :: [Inlines]
    opmlDocAuthors = []
                     , opmlDocDate :: Inlines
    opmlDocDate = Inlines
    forall a. Monoid a => a
    mempty
                     , opmlOptions :: ReaderOptions
    opmlOptions = ReaderOptions
    forall a. Default a => a
    def
                     }

    readOPML :: (PandocMonad m, ToSources a)
             => ReaderOptions
             -> a
             -> m Pandoc
    readOPML :: forall (m :: * -> *) a.
    (PandocMonad m, ToSources a) =>
    ReaderOptions -> a -> m Pandoc
    readOPML ReaderOptions
    opts a
    inp  = do
      let sources :: Sources
    sources = a -> Sources
    forall a. ToSources a => a -> Sources
    toSources a
    inp
      (bs, st') <-
        StateT OPMLState m [Blocks] -> OPMLState -> m ([Blocks], OPMLState)
    forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
    runStateT (case Text -> Either Text [Content]
    parseXMLContents (Text -> Text
    TL.fromStrict (Text -> Text) -> (Sources -> Text) -> Sources -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Sources -> Text
    sourcesToText (Sources -> Text) -> Sources -> Text
    forall a b. (a -> b) -> a -> b
    $ Sources
    sources) of
                         Left Text
    msg -> PandocError -> StateT OPMLState m [Blocks]
    forall a. PandocError -> StateT OPMLState m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (PandocError -> StateT OPMLState m [Blocks])
    -> PandocError -> StateT OPMLState m [Blocks]
    forall a b. (a -> b) -> a -> b
    $ Text -> Text -> PandocError
    PandocXMLError Text
    "" Text
    msg
                         Right [Content]
    ns -> (Content -> StateT OPMLState m Blocks)
    -> [Content] -> StateT OPMLState m [Blocks]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Content -> StateT OPMLState m Blocks
    forall (m :: * -> *). PandocMonad m => Content -> OPML m Blocks
    parseBlock [Content]
    ns)
                     OPMLState
    forall a. Default a => a
    def{ opmlOptions = opts }
      return $
        setTitle (opmlDocTitle st') $
        setAuthors (opmlDocAuthors st') $
        setDate (opmlDocDate st') $
        doc $ mconcat bs

    -- convenience function to get an attribute value, defaulting to ""
    attrValue :: Text -> Element -> Text
    attrValue :: Text -> Element -> Text
    attrValue Text
    attr Element
    elt =
      Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe Text
    "" ((QName -> Bool) -> [Attr] -> Maybe Text
    lookupAttrBy (\QName
    x -> QName -> Text
    qName QName
    x Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    attr) (Element -> [Attr]
    elAttribs Element
    elt))

    -- exceptT :: PandocMonad m => Either PandocError a -> OPML m a
    -- exceptT = either throwError return

    asHtml :: PandocMonad m => Text -> OPML m Inlines
    asHtml :: forall (m :: * -> *). PandocMonad m => Text -> OPML m Inlines
    asHtml Text
    s = do
      opts <- (OPMLState -> ReaderOptions) -> StateT OPMLState m ReaderOptions
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets OPMLState -> ReaderOptions
    opmlOptions
      Pandoc _ bs <- readHtml def{ readerExtensions = readerExtensions opts } s
      return $ blocksToInlines' bs

    asMarkdown :: PandocMonad m => Text -> OPML m Blocks
    asMarkdown :: forall (m :: * -> *). PandocMonad m => Text -> OPML m Blocks
    asMarkdown Text
    s = do
      opts <- (OPMLState -> ReaderOptions) -> StateT OPMLState m ReaderOptions
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets OPMLState -> ReaderOptions
    opmlOptions
      Pandoc _ bs <- readMarkdown def{ readerExtensions = readerExtensions opts } s
      return $ fromList bs

    getBlocks :: PandocMonad m => Element -> OPML m Blocks
    getBlocks :: forall (m :: * -> *). PandocMonad m => Element -> OPML m Blocks
    getBlocks Element
    e =  [Blocks] -> Blocks
    forall a. Monoid a => [a] -> a
    mconcat ([Blocks] -> Blocks)
    -> StateT OPMLState m [Blocks] -> StateT OPMLState m Blocks
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Content -> StateT OPMLState m Blocks)
    -> [Content] -> StateT OPMLState m [Blocks]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Content -> StateT OPMLState m Blocks
    forall (m :: * -> *). PandocMonad m => Content -> OPML m Blocks
    parseBlock (Element -> [Content]
    elContent Element
    e)

    parseBlock :: PandocMonad m => Content -> OPML m Blocks
    parseBlock :: forall (m :: * -> *). PandocMonad m => Content -> OPML m Blocks
    parseBlock (Elem Element
    e) =
      case QName -> Text
    qName (Element -> QName
    elName Element
    e) of
            Text
    "ownerName"    -> Blocks
    forall a. Monoid a => a
    mempty Blocks -> StateT OPMLState m () -> OPML m Blocks
    forall a b. a -> StateT OPMLState m b -> StateT OPMLState m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ (OPMLState -> OPMLState) -> StateT OPMLState m ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\OPMLState
    st ->
                                  OPMLState
    st{opmlDocAuthors = [text $ strContent e]})
            Text
    "dateModified" -> Blocks
    forall a. Monoid a => a
    mempty Blocks -> StateT OPMLState m () -> OPML m Blocks
    forall a b. a -> StateT OPMLState m b -> StateT OPMLState m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ (OPMLState -> OPMLState) -> StateT OPMLState m ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\OPMLState
    st ->
                                  OPMLState
    st{opmlDocDate = text $ strContent e})
            Text
    "title"        -> Blocks
    forall a. Monoid a => a
    mempty Blocks -> StateT OPMLState m () -> OPML m Blocks
    forall a b. a -> StateT OPMLState m b -> StateT OPMLState m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ (OPMLState -> OPMLState) -> StateT OPMLState m ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\OPMLState
    st ->
                                  OPMLState
    st{opmlDocTitle = text $ strContent e})
            Text
    "outline" -> (OPMLState -> Int) -> StateT OPMLState m Int
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets OPMLState -> Int
    opmlSectionLevel StateT OPMLState m Int -> (Int -> OPML m Blocks) -> OPML m Blocks
    forall a b.
    StateT OPMLState m a
    -> (a -> StateT OPMLState m b) -> StateT OPMLState m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Int -> OPML m Blocks
    forall {m :: * -> *}.
    PandocMonad m =>
    Int -> StateT OPMLState m Blocks
    sect (Int -> OPML m Blocks) -> (Int -> Int) -> Int -> OPML m Blocks
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1)
            Text
    "?xml"  -> Blocks -> OPML m Blocks
    forall a. a -> StateT OPMLState m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Blocks
    forall a. Monoid a => a
    mempty
            Text
    _       -> Element -> OPML m Blocks
    forall (m :: * -> *). PandocMonad m => Element -> OPML m Blocks
    getBlocks Element
    e
       where sect :: Int -> StateT OPMLState m Blocks
    sect Int
    n = do headerText <- Text -> OPML m Inlines
    forall (m :: * -> *). PandocMonad m => Text -> OPML m Inlines
    asHtml (Text -> OPML m Inlines) -> Text -> OPML m Inlines
    forall a b. (a -> b) -> a -> b
    $ Text -> Element -> Text
    attrValue Text
    "text" Element
    e
                         noteBlocks <- asMarkdown $ attrValue "_note" e
                         modify $ \OPMLState
    st -> OPMLState
    st{ opmlSectionLevel = n }
                         bs <- getBlocks e
                         modify $ \OPMLState
    st -> OPMLState
    st{ opmlSectionLevel = n - 1 }
                         let headerText' = case Text -> Text
    T.toUpper (Text -> Element -> Text
    attrValue Text
    "type" Element
    e) of
                                                 Text
    "LINK"  -> Text -> Text -> Inlines -> Inlines
    link
                                                   (Text -> Element -> Text
    attrValue Text
    "url" Element
    e) Text
    "" Inlines
    headerText
                                                 Text
    _ -> Inlines
    headerText
                         return $ header n headerText' <> noteBlocks <> bs
    parseBlock Content
    _ = Blocks -> OPML m Blocks
    forall a. a -> StateT OPMLState m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Blocks
    forall a. Monoid a => a
    mempty