Add an Arbitrary instance for HsDoc

1 files changed, 25 insertions, 0 deletions

diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs
index 0a8f0407..86e4cea2 100644
--- a/src/Haddock/Types.hs
+++ b/src/Haddock/Types.hs
@@ -29,6 +29,9 @@ import qualified Data.Map as Map
 import GHC hiding (NoLink)
 import Name
 
+#ifdef TEST
+import Test.QuickCheck
+#endif
 
 -- convenient short-hands
 type Decl = LHsDecl Name
@@ -289,6 +292,28 @@ data HsDoc id
   deriving (Eq, Show, Functor)
 
 
+#ifdef TEST
+-- TODO: use derive
+instance Arbitrary a => Arbitrary (HsDoc a) where
+  arbitrary =
+    oneof [ return DocEmpty
+          , do { a <- arbitrary; b <- arbitrary; return (DocAppend a b) }
+          , fmap DocString arbitrary
+          , fmap DocParagraph arbitrary
+          , fmap DocIdentifier arbitrary
+          , fmap DocModule arbitrary
+          , fmap DocEmphasis arbitrary
+          , fmap DocMonospaced arbitrary
+          , fmap DocUnorderedList arbitrary
+          , fmap DocOrderedList arbitrary
+          , fmap DocDefList arbitrary
+          , fmap DocCodeBlock arbitrary
+          , fmap DocURL arbitrary
+          , fmap DocPic arbitrary
+          , fmap DocAName arbitrary ]
+#endif
+
+
 type LHsDoc id = Located (HsDoc id)