[commit: haddock] master: Some code simplification by using traverse (39649d7)

[git at git.haskell.org]

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

On branch  : master
Link       : http://git.haskell.org/haddock.git/commitdiff/39649d71ae8462291049710bb5e3c35f5d5b193b

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

commit 39649d71ae8462291049710bb5e3c35f5d5b193b
Author: Simon Hengel <sol at typeful.net>
Date:   Sun Dec 1 00:31:43 2013 +0100

    Some code simplification by using traverse


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

39649d71ae8462291049710bb5e3c35f5d5b193b
 src/Haddock/Interface/Rename.hs |   55 ++++-----------------------------------
 src/Haddock/Types.hs            |    6 +++--
 2 files changed, 9 insertions(+), 52 deletions(-)

diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index fd652cd..97a63b3 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -12,6 +12,8 @@
 module Haddock.Interface.Rename (renameInterface) where
 
 
+import Data.Traversable (traverse)
+
 import Haddock.GhcUtils
 import Haddock.Types
 
@@ -159,50 +161,7 @@ renameLDocHsSyn = return
 
 
 renameDoc :: Doc Name -> RnM (Doc DocName)
-renameDoc d = case d of
-  DocEmpty -> return DocEmpty
-  DocAppend a b -> do
-    a' <- renameDoc a
-    b' <- renameDoc b
-    return (DocAppend a' b')
-  DocString str -> return (DocString str)
-  DocParagraph doc -> do
-    doc' <- renameDoc doc
-    return (DocParagraph doc')
-  DocIdentifier x -> do
-    x' <- rename x
-    return (DocIdentifier x')
-  DocIdentifierUnchecked x -> return (DocIdentifierUnchecked x)
-  DocModule str -> return (DocModule str)
-  DocWarning doc -> do
-    doc' <- renameDoc doc
-    return (DocWarning doc')
-  DocEmphasis doc -> do
-    doc' <- renameDoc doc
-    return (DocEmphasis doc')
-  DocMonospaced doc -> do
-    doc' <- renameDoc doc
-    return (DocMonospaced doc')
-  DocUnorderedList docs -> do
-    docs' <- mapM renameDoc docs
-    return (DocUnorderedList docs')
-  DocOrderedList docs -> do
-    docs' <- mapM renameDoc docs
-    return (DocOrderedList docs')
-  DocDefList docs -> do
-    docs' <- mapM (\(a,b) -> do
-      a' <- renameDoc a
-      b' <- renameDoc b
-      return (a',b')) docs
-    return (DocDefList docs')
-  DocCodeBlock doc -> do
-    doc' <- renameDoc doc
-    return (DocCodeBlock doc')
-  DocHyperlink l -> return (DocHyperlink l)
-  DocPic str -> return (DocPic str)
-  DocAName str -> return (DocAName str)
-  DocProperty p -> return (DocProperty p)
-  DocExamples e -> return (DocExamples e)
+renameDoc = traverse rename
 
 
 renameFnArgsDoc :: FnArgsDoc Name -> RnM (FnArgsDoc DocName)
@@ -215,12 +174,8 @@ renameLType = mapM renameType
 renameLKind :: LHsKind Name -> RnM (LHsKind DocName)
 renameLKind = renameLType
 
-renameMaybeLKind :: Maybe (LHsKind Name)
-                 -> RnM (Maybe (LHsKind DocName))
-renameMaybeLKind Nothing = return Nothing
-renameMaybeLKind (Just ki)
-  = do { ki' <- renameLKind ki
-       ; return (Just ki') }
+renameMaybeLKind :: Maybe (LHsKind Name) -> RnM (Maybe (LHsKind DocName))
+renameMaybeLKind = traverse renameLKind
 
 renameType :: HsType Name -> RnM (HsType DocName)
 renameType t = case t of
diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs
index 19a6c90..73fafd6 100644
--- a/src/Haddock/Types.hs
+++ b/src/Haddock/Types.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveDataTypeable, DeriveFunctor #-}
+{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 -----------------------------------------------------------------------------
 -- |
@@ -20,6 +20,8 @@ module Haddock.Types (
  ) where
 
 
+import Data.Foldable
+import Data.Traversable
 import Control.Exception
 import Control.Arrow
 import Control.DeepSeq
@@ -316,7 +318,7 @@ data Doc id
   | DocAName String
   | DocProperty String
   | DocExamples [Example]
-  deriving (Functor)
+  deriving (Functor, Foldable, Traversable)
 
 
 instance Monoid (Doc id) where