- addBlockText :: Document -> BlockElement -> IO BlockElement
- addBlockText doc b
- = do case b of
- Heading _ text
- -> addText doc text
- _ -> return ()
- return b
-
- addInlineText :: Document -> InlineElement -> IO InlineElement
- addInlineText doc i
- = do case i of
- Text text
- -> addText doc text
- ObjectLink page Nothing
- -> addText doc page
- ObjectLink page (Just text)
- -> do addHiddenText doc page
- addText doc text
- PageLink page fragment Nothing
- -> addText doc (fromMaybe "" page ++
- fromMaybe "" fragment)
- PageLink page fragment (Just text)
- -> do addHiddenText doc (fromMaybe "" page ++
- fromMaybe "" fragment)
- addText doc text
- ExternalLink uri Nothing
- -> addText doc (uriToString id uri "")
- ExternalLink uri (Just text)
- -> do addHiddenText doc (uriToString id uri "")
- addText doc text
- _ -> return ()
- return i
-
--- Perform monadic transformation in top-down order.
-everywhereM' :: Monad m => GenericM m -> GenericM m
-everywhereM' f x = f x >>= gmapM (everywhereM' f)
+ addElemText :: Document -> Element -> IO ()
+ addElemText doc (Block b) = addBlockText doc b
+ addElemText doc (Inline i) = addInlineText doc i
+
+ addBlockText :: Document -> BlockElement -> IO ()
+ addBlockText doc (Heading _ text) = addText doc text
+ addBlockText _ HorizontalLine = return ()
+ addBlockText doc (List _ items) = mapM_ (addListItemText doc) items
+ addBlockText doc (DefinitionList defs) = mapM_ (addDefinitionText doc) defs
+ addBlockText doc (Preformatted inlines) = mapM_ (addInlineText doc) inlines
+ addBlockText doc (Paragraph inlines) = mapM_ (addInlineText doc) inlines
+ addBlockText doc (Div _ elems) = mapM_ (addElemText doc) elems
+ addBlockText _ EmptyBlock = return ()
+ addBlockText doc (BlockCmd bcmd) = addBlockCmdText doc bcmd
+
+ addInlineText :: Document -> InlineElement -> IO ()
+ addInlineText doc (Text text) = addText doc text
+ addInlineText doc (Italic inlines) = mapM_ (addInlineText doc) inlines
+ addInlineText doc (Bold inlines) = mapM_ (addInlineText doc) inlines
+ addInlineText doc (ObjectLink page Nothing) = addText doc page
+ addInlineText doc (ObjectLink page (Just text)) = addHiddenText doc page
+ >> addText doc text
+ addInlineText doc (PageLink page fragm Nothing) = addText doc (fromMaybe "" page ++ fromMaybe "" fragm)
+ addInlineText doc (PageLink page fragm (Just text)) = addHiddenText doc (fromMaybe "" page ++ fromMaybe "" fragm)
+ >> addText doc text
+ addInlineText doc (ExternalLink uri Nothing) = addText doc (uriToString id uri "")
+ addInlineText doc (ExternalLink uri (Just text)) = addHiddenText doc (uriToString id uri "")
+ >> addText doc text
+ addInlineText _ (LineBreak _) = return ()
+ addInlineText doc (Span _ inlines) = mapM_ (addInlineText doc) inlines
+ addInlineText doc (Image src alt) = do case src of
+ Left uri -> addHiddenText doc (uriToString id uri "")
+ Right page -> addHiddenText doc page
+ case alt of
+ Just text -> addHiddenText doc text
+ Nothing -> return ()
+ addInlineText doc (Anchor attrs inlines) = mapM_ (addInlineText doc) inlines
+ addInlineText _ (Input _) = return ()
+ addInlineText _ EmptyInline = return ()
+ addInlineText doc (InlineCmd icmd) = addInlineCmdText doc icmd
+
+ addListItemText :: Document -> ListItem -> IO ()
+ addListItemText = mapM_ . addElemText
+
+ addDefinitionText :: Document -> Definition -> IO ()
+ addDefinitionText doc (Definition term desc)
+ = do mapM_ (addInlineText doc) term
+ mapM_ (addInlineText doc) desc
+
+ addBlockCmdText :: Document -> BlockCommand -> IO ()
+ addBlockCmdText doc (BlockCommand _ _ blocks) = mapM_ (addBlockText doc) blocks
+
+ addInlineCmdText :: Document -> InlineCommand -> IO ()
+ addInlineCmdText doc (InlineCommand _ _ inlines) = mapM_ (addInlineText doc) inlines