From 2ad45f618b9ad2a7a5507e83c3990d93b752a3c0 Mon Sep 17 00:00:00 2001
From: alexbiehl <alex.biehl@gmail.com>
Date: Wed, 16 Aug 2017 08:20:01 +0200
Subject: Bifoldable and Bitraversable for DocH and MetaDoc
---
haddock-library/src/Documentation/Haddock/Types.hs | 61 ++++++++++++++++++++++
1 file changed, 61 insertions(+)
(limited to 'haddock-library/src/Documentation')
diff --git a/haddock-library/src/Documentation/Haddock/Types.hs b/haddock-library/src/Documentation/Haddock/Types.hs
index 22cab425..48b29075 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).
--
cgit v1.2.3