aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Hengel <sol@typeful.net>2013-12-01 00:31:43 +0100
committerAustin Seipp <austin@well-typed.com>2014-01-12 14:48:35 -0600
commit39649d71ae8462291049710bb5e3c35f5d5b193b (patch)
tree988484a257d8631dc0a865b1c517e5ffd3c8f0ca
parent030c726ac75a16fc13ff6d66357331a37374e65f (diff)
Some code simplification by using traverse
-rw-r--r--src/Haddock/Interface/Rename.hs55
-rw-r--r--src/Haddock/Types.hs6
2 files changed, 9 insertions, 52 deletions
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index fd652cda..97a63b34 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 19a6c90b..73fafd6b 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