[commit: haddock] ghc-head, ghc-head1, ie_avails, master, wip/T14529, wip/revert-ttg-2017-11-20, wip/ttg-2017-10-13, wip/ttg-2017-10-31, wip/ttg-2017-11-06, wip/ttg2-2017-11-10, wip/ttg3-2017-11-12, wip/ttg4-constraints-2017-11-13, wip/ttg6-unrevert-2017-11-22: Bifoldable and Bitraversable for DocH and MetaDoc (2ad45f6)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/haddock

On branches: ghc-head,ghc-head1,ie_avails,master,wip/T14529,wip/revert-ttg-2017-11-20,wip/ttg-2017-10-13,wip/ttg-2017-10-31,wip/ttg-2017-11-06,wip/ttg2-2017-11-10,wip/ttg3-2017-11-12,wip/ttg4-constraints-2017-11-13,wip/ttg6-unrevert-2017-11-22
Link       : http://git.haskell.org/haddock.git/commitdiff/2ad45f618b9ad2a7a5507e83c3990d93b752a3c0

>---------------------------------------------------------------

commit 2ad45f618b9ad2a7a5507e83c3990d93b752a3c0
Author: alexbiehl <alex.biehl at gmail.com>
Date:   Wed Aug 16 08:20:01 2017 +0200

    Bifoldable and Bitraversable for DocH and MetaDoc


>---------------------------------------------------------------

2ad45f618b9ad2a7a5507e83c3990d93b752a3c0
 haddock-library/CHANGES.md                         |  2 +-
 haddock-library/src/Documentation/Haddock/Types.hs | 61 ++++++++++++++++++++++
 2 files changed, 62 insertions(+), 1 deletion(-)

diff --git a/haddock-library/CHANGES.md b/haddock-library/CHANGES.md
index c52908e..53d17f5 100644
--- a/haddock-library/CHANGES.md
+++ b/haddock-library/CHANGES.md
@@ -2,7 +2,7 @@
 
  * to be released
 
- * Bifunctor instance for DocH
+ * Bifunctor, Bifoldable and Bitraversable instances for DocH and MetaDoc
 
 ## Changes in version 1.4.5
 
diff --git a/haddock-library/src/Documentation/Haddock/Types.hs b/haddock-library/src/Documentation/Haddock/Types.hs
index 22cab42..48b2907 100644
--- a/haddock-library/src/Documentation/Haddock/Types.hs
+++ b/haddock-library/src/Documentation/Haddock/Types.hs
@@ -24,6 +24,11 @@ import Control.Arrow ((***))
 import Data.Bifunctor
 #endif
 
+#if MIN_VERSION_base(4,10,0)
+import Data.Bifoldable
+import Data.Bitraversable
+#endif
+
 -- | With the advent of 'Version', we may want to start attaching more
 -- meta-data to comments. We make a structure for this ahead of time
 -- so we don't have to gut half the core each time we want to add such
@@ -35,6 +40,19 @@ data MetaDoc mod id =
           , _doc :: DocH mod id
           } deriving (Eq, Show, Functor, Foldable, Traversable)
 
+#if MIN_VERSION_base(4,8,0)
+instance Bifunctor MetaDoc where
+  bimap f g (MetaDoc m d) = MetaDoc m (bimap f g d)
+#endif
+
+#if MIN_VERSION_base(4,10,0)
+instance Bifoldable MetaDoc where
+  bifoldr f g z d = bifoldr f g z (_doc d)
+
+instance Bitraversable MetaDoc where
+  bitraverse f g (MetaDoc m d) = MetaDoc m <$> bitraverse f g d
+#endif
+
 overDoc :: (DocH a b -> DocH c d) -> MetaDoc a b -> MetaDoc c d
 overDoc f d = d { _doc = f $ _doc d }
 
@@ -113,6 +131,49 @@ instance Bifunctor DocH where
   bimap f g (DocHeader (Header level title)) = DocHeader (Header level (bimap f g title))
 #endif
 
+#if MIN_VERSION_base(4,10,0)
+instance Bifoldable DocH where
+  bifoldr f g z (DocAppend docA docB) = bifoldr f g (bifoldr f g z docA) docB
+  bifoldr f g z (DocParagraph doc) = bifoldr f g z doc
+  bifoldr _ g z (DocIdentifier i) = g i z
+  bifoldr f _ z (DocIdentifierUnchecked m) = f m z
+  bifoldr f g z (DocWarning doc) = bifoldr f g z doc
+  bifoldr f g z (DocEmphasis doc) = bifoldr f g z doc
+  bifoldr f g z (DocMonospaced doc) = bifoldr f g z doc
+  bifoldr f g z (DocBold doc) = bifoldr f g z doc
+  bifoldr f g z (DocUnorderedList docs) = foldr (flip (bifoldr f g)) z docs
+  bifoldr f g z (DocOrderedList docs) = foldr (flip (bifoldr f g)) z docs
+  bifoldr f g z (DocDefList docs) = foldr (\(l, r) acc -> bifoldr f g (bifoldr f g acc l) r) z docs
+  bifoldr f g z (DocCodeBlock doc) = bifoldr f g z doc
+  bifoldr f g z (DocHeader (Header _ title)) = bifoldr f g z title
+  bifoldr _ _ z _ = z
+
+instance Bitraversable DocH where
+  bitraverse _ _ DocEmpty = pure DocEmpty
+  bitraverse f g (DocAppend docA docB) = DocAppend <$> bitraverse f g docA <*> bitraverse f g docB
+  bitraverse _ _ (DocString s) = pure (DocString s)
+  bitraverse f g (DocParagraph doc) = DocParagraph <$> bitraverse f g doc
+  bitraverse _ g (DocIdentifier i) = DocIdentifier <$> g i
+  bitraverse f _ (DocIdentifierUnchecked m) = DocIdentifierUnchecked <$> f m
+  bitraverse _ _ (DocModule s) = pure (DocModule s)
+  bitraverse f g (DocWarning doc) = DocWarning <$> bitraverse f g doc
+  bitraverse f g (DocEmphasis doc) = DocEmphasis <$> bitraverse f g doc
+  bitraverse f g (DocMonospaced doc) = DocMonospaced <$> bitraverse f g doc
+  bitraverse f g (DocBold doc) = DocBold <$> bitraverse f g doc
+  bitraverse f g (DocUnorderedList docs) = DocUnorderedList <$> traverse (bitraverse f g) docs
+  bitraverse f g (DocOrderedList docs) = DocOrderedList <$> traverse (bitraverse f g) docs
+  bitraverse f g (DocDefList docs) = DocDefList <$> traverse (bitraverse (bitraverse f g) (bitraverse f g)) docs
+  bitraverse f g (DocCodeBlock doc) = DocCodeBlock <$> bitraverse f g doc
+  bitraverse _ _ (DocHyperlink hyperlink) = pure (DocHyperlink hyperlink)
+  bitraverse _ _ (DocPic picture) = pure (DocPic picture)
+  bitraverse _ _ (DocMathInline s) = pure (DocMathInline s)
+  bitraverse _ _ (DocMathDisplay s) = pure (DocMathDisplay s)
+  bitraverse _ _ (DocAName s) = pure (DocAName s)
+  bitraverse _ _ (DocProperty s) = pure (DocProperty s)
+  bitraverse _ _ (DocExamples examples) = pure (DocExamples examples)
+  bitraverse f g (DocHeader (Header level title)) = (DocHeader . Header level) <$> bitraverse f g title
+#endif
+
 -- | 'DocMarkupH' is a set of instructions for marking up documentation.
 -- In fact, it's really just a mapping from 'Doc' to some other
 -- type [a], where [a] is usually the type of the output (HTML, say).