    {-# LANGUAGE OverloadedStrings #-}
    {- |
       Module      : Text.Pandoc.Readers.Pptx.Slides
       Copyright   : © 2025 Anton Antic
       License     : GNU GPL, version 2 or above

       Maintainer  : Anton Antic <anton@everworker.ai>
       Stability   : alpha
       Portability : portable

    Conversion of PPTX slides to Pandoc AST blocks.
    -}
    module Text.Pandoc.Readers.Pptx.Slides
      ( pptxToOutput
      ) where

    import Codec.Archive.Zip (Archive)
    import Data.List (find)
    import Data.Maybe (mapMaybe)
    import qualified Data.Text as T
    import Data.Text (Text)
    import Text.Pandoc.Class.PandocMonad (PandocMonad)
    import Text.Pandoc.Definition
    import Text.Pandoc.Options (ReaderOptions)
    import Text.Pandoc.Readers.OOXML.Shared
    import Text.Pandoc.Readers.Pptx.Parse
    import Text.Pandoc.Readers.Pptx.Shapes
    import Text.Pandoc.XML.Light

    -- | Convert Pptx intermediate representation to Pandoc AST
    pptxToOutput :: PandocMonad m => ReaderOptions -> Pptx -> m (Meta, [Block])
    pptxToOutput :: forall (m :: * -> *).
    PandocMonad m =>
    ReaderOptions -> Pptx -> m (Meta, [Block])
    pptxToOutput ReaderOptions
    _opts Pptx
    pptx = do
      let slides :: [PptxSlide]
    slides = Pptx -> [PptxSlide]
    pptxSlides Pptx
    pptx
          archive :: Archive
    archive = Pptx -> Archive
    pptxArchive Pptx
    pptx

      -- Convert each slide to blocks
      slideBlocks <- [[Block]] -> [Block]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Block]] -> [Block]) -> m [[Block]] -> m [Block]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (PptxSlide -> m [Block]) -> [PptxSlide] -> m [[Block]]
    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 (Archive -> PptxSlide -> m [Block]
    forall (m :: * -> *).
    PandocMonad m =>
    Archive -> PptxSlide -> m [Block]
    slideToBlocks Archive
    archive) [PptxSlide]
    slides

      return (mempty, slideBlocks)

    -- | Convert slide to blocks
    slideToBlocks :: PandocMonad m => Archive -> PptxSlide -> m [Block]
    slideToBlocks :: forall (m :: * -> *).
    PandocMonad m =>
    Archive -> PptxSlide -> m [Block]
    slideToBlocks Archive
    archive PptxSlide
    slide = do
      let SlideId Int
    n = PptxSlide -> SlideId
    slideId PptxSlide
    slide
          slideElem :: Element
    slideElem = PptxSlide -> Element
    slideElement PptxSlide
    slide
          rels :: [(Text, Text)]
    rels = PptxSlide -> [(Text, Text)]
    slideRels PptxSlide
    slide
          ns :: NameSpaces
    ns = Element -> NameSpaces
    elemToNameSpaces Element
    slideElem

          -- Extract title from title placeholder
          title :: Text
    title = NameSpaces -> Element -> Text
    extractSlideTitle NameSpaces
    ns Element
    slideElem

          -- Create header
          slideIdent :: Text
    slideIdent = Text
    "slide-" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> String -> Text
    T.pack (Int -> String
    forall a. Show a => a -> String
    show Int
    n)
          headerText :: Text
    headerText = if Text -> Bool
    T.null Text
    title
                       then Text
    "Slide " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> String -> Text
    T.pack (Int -> String
    forall a. Show a => a -> String
    show Int
    n)
                       else Text
    title
          header :: Block
    header = Int -> Attr -> [Inline] -> Block
    Header Int
    2 (Text
    slideIdent, [], []) [Text -> Inline
    Str Text
    headerText]

      -- Parse shapes and convert to blocks
      case NameSpaces -> Text -> Text -> Element -> Maybe Element
    findChildByName NameSpaces
    ns Text
    "p" Text
    "cSld" Element
    slideElem Maybe Element -> (Element -> Maybe Element) -> Maybe Element
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
           NameSpaces -> Text -> Text -> Element -> Maybe Element
    findChildByName NameSpaces
    ns Text
    "p" Text
    "spTree" of
        Maybe Element
    Nothing -> [Block] -> m [Block]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Block
    header]
        Just Element
    spTree -> do
          -- Filter out title placeholder shapes before parsing
          let allShapeElems :: [Element]
    allShapeElems = [Content] -> [Element]
    onlyElems ([Content] -> [Element]) -> [Content] -> [Element]
    forall a b. (a -> b) -> a -> b
    $ Element -> [Content]
    elContent Element
    spTree
              nonTitleShapeElems :: [Element]
    nonTitleShapeElems = (Element -> Bool) -> [Element] -> [Element]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (Element -> Bool) -> Element -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NameSpaces -> Element -> Bool
    isTitlePlaceholder NameSpaces
    ns) [Element]
    allShapeElems
              shapes :: [PptxShape]
    shapes = (Element -> Maybe PptxShape) -> [Element] -> [PptxShape]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (NameSpaces -> Element -> Maybe PptxShape
    parseShape NameSpaces
    ns) [Element]
    nonTitleShapeElems
          shapeBlocks <- [[Block]] -> [Block]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Block]] -> [Block]) -> m [[Block]] -> m [Block]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (PptxShape -> m [Block]) -> [PptxShape] -> m [[Block]]
    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 (Archive -> [(Text, Text)] -> PptxShape -> m [Block]
    forall (m :: * -> *).
    PandocMonad m =>
    Archive -> [(Text, Text)] -> PptxShape -> m [Block]
    shapeToBlocks Archive
    archive [(Text, Text)]
    rels) [PptxShape]
    shapes
          return $ header : shapeBlocks

    -- | Extract title from title placeholder
    extractSlideTitle :: NameSpaces -> Element -> Text
    extractSlideTitle :: NameSpaces -> Element -> Text
    extractSlideTitle NameSpaces
    ns Element
    slideElem =
      case NameSpaces -> Text -> Text -> Element -> Maybe Element
    findChildByName NameSpaces
    ns Text
    "p" Text
    "cSld" Element
    slideElem Maybe Element -> (Element -> Maybe Element) -> Maybe Element
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
           NameSpaces -> Text -> Text -> Element -> Maybe Element
    findChildByName NameSpaces
    ns Text
    "p" Text
    "spTree" of
        Maybe Element
    Nothing -> Text
    ""
        Just Element
    spTree ->
          -- Find shape with ph type="title"
          let shapes :: [Element]
    shapes = [Content] -> [Element]
    onlyElems ([Content] -> [Element]) -> [Content] -> [Element]
    forall a b. (a -> b) -> a -> b
    $ Element -> [Content]
    elContent Element
    spTree
              titleShape :: Maybe Element
    titleShape = (Element -> Bool) -> [Element] -> Maybe Element
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find (NameSpaces -> Element -> Bool
    isTitlePlaceholder NameSpaces
    ns) [Element]
    shapes
           in Text -> (Element -> Text) -> Maybe Element -> Text
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Text
    "" Element -> Text
    extractDrawingMLText Maybe Element
    titleShape

    -- isTitlePlaceholder is imported from Shapes module