From 4bd0bf841e324c7e6a716ee3e12a94e73dfaa178 Mon Sep 17 00:00:00 2001
From: David Waern <david.waern@gmail.com>
Date: Fri, 27 Mar 2009 23:12:53 +0000
Subject: -Wall police in H.B.Hoogle

---
 src/Haddock/Backends/Hoogle.hs | 32 ++++++++++++++++++++------------
 1 file changed, 20 insertions(+), 12 deletions(-)

diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
index 99b93847..242d075c 100644
--- a/src/Haddock/Backends/Hoogle.hs
+++ b/src/Haddock/Backends/Hoogle.hs
@@ -12,7 +12,6 @@ module Haddock.Backends.Hoogle (
   ) where
 
 
-import Haddock.GHC
 import Haddock.GHC.Utils
 import Haddock.Types
 import Haddock.Utils hiding (out)
@@ -24,10 +23,10 @@ import Control.Monad
 import Data.Char
 import Data.List
 import Data.Maybe
-import qualified Data.Set as Set
 import System.FilePath
 
 
+prefix :: [String]
 prefix = ["-- Hoogle documentation, generated by Haddock"
          ,"-- See Hoogle, http://www.haskell.org/hoogle/"
          ,""]
@@ -68,19 +67,22 @@ dropHsDocTy = f
         f (HsOpTy a b c) = HsOpTy (g a) b (g c)
         f (HsParTy a) = HsParTy (g a)
         f (HsKindSig a b) = HsKindSig (g a) b
-        f (HsDocTy a b) = f $ unL a
+        f (HsDocTy a _) = f $ unL a
         f x = x
 
 outHsType :: OutputableBndr a => HsType a -> String
 outHsType = out . dropHsDocTy
 
 
+makeExplicit :: HsType a -> HsType a
 makeExplicit (HsForAllTy _ a b c) = HsForAllTy Explicit a b c
 makeExplicit x = x
 
+makeExplicitL :: LHsType a -> LHsType a
 makeExplicitL (L src x) = L src (makeExplicit x)
 
 
+dropComment :: String -> String
 dropComment (' ':'-':'-':' ':_) = []
 dropComment (x:xs) = x : dropComment xs
 dropComment [] = []
@@ -134,14 +136,16 @@ ppClass x = out x{tcdSigs=[]} :
             concatMap (ppSig . addContext . unL) (tcdSigs x)
     where
         addContext (TypeSig name (L l sig)) = TypeSig name (L l $ f sig)
+        addContext _ = error "expected TypeSig"
+
         f (HsForAllTy a b con d) = HsForAllTy a b (reL $ context : unL con) d
-        f x = HsForAllTy Implicit [] (reL [context]) (reL x)
+        f t = HsForAllTy Implicit [] (reL [context]) (reL t)
 
         context = reL $ HsClassP (unL $ tcdLName x)
             (map (reL . HsTyVar . tyVar . unL) (tcdTyVars x))
 
-        tyVar (UserTyVar x) = x
-        tyVar (KindedTyVar x _) = x
+        tyVar (UserTyVar v) = v
+        tyVar (KindedTyVar v _) = v
 
 
 ppInstance :: Instance -> [String]
@@ -154,11 +158,11 @@ ppData x = showData x{tcdCons=[],tcdDerivs=Nothing} :
     where
         -- GHC gives out "data Bar =", we want to delete the equals
         -- also writes data : a b, when we want data (:) a b
-        showData x = unwords $ map f $ if last xs == "=" then init xs else xs
+        showData d = unwords $ map f $ if last xs == "=" then init xs else xs
             where
-                xs = words $ out x
-                nam = out $ tcdLName x
-                f x = if x == nam then operator nam else x
+                xs = words $ out d
+                nam = out $ tcdLName d
+                f w = if w == nam then operator nam else w
 
 
 ppCtor :: TyClDecl Name -> ConDecl Name -> [String]
@@ -174,7 +178,7 @@ ppCtor dat con = ldoc (con_doc con) ++ f (con_details con)
         funs = foldr1 (\x y -> reL $ HsFunTy (makeExplicitL x) (makeExplicitL y))
         apps = foldl1 (\x y -> reL $ HsAppTy x y)
 
-        typeSig name flds = operator name ++ " :: " ++ outHsType (makeExplicit $ unL $ funs flds)
+        typeSig nm flds = operator nm ++ " :: " ++ outHsType (makeExplicit $ unL $ funs flds)
         name = out $ unL $ con_name con
 
         resType = case con_res con of
@@ -204,7 +208,10 @@ data Tag = TagL Char [Tags] | TagP Tags | TagPre Tags | TagInline String Tags |
 
 type Tags = [Tag]
 
+box :: (a -> b) -> a -> [b]
 box f x = [f x]
+
+str :: String -> [Tag]
 str a = [Str a]
 
 -- want things like paragraph, pre etc to be handled by blank lines in the source document
@@ -247,6 +254,7 @@ showBlock (TagPre xs) = ["<pre>"] ++ showPre xs ++ ["</pre>"]
 showBlock x = showInline [x]
 
 
+asInline :: Tag -> Tags
 asInline (TagP xs) = xs
 asInline (TagPre xs) = [TagInline "pre" xs]
 asInline (TagL t xs) = [TagInline (t:"l") $ map (TagInline "li") xs]
@@ -282,7 +290,7 @@ showPre = trimFront . trimLines . lines . concatMap f
 unwordsWrap :: Int -> [String] -> [String]
 unwordsWrap n = f n []
     where
-        f i s [] = [g s | s /= []]
+        f _ s [] = [g s | s /= []]
         f i s (x:xs) | nx > i = g s : f (n - nx - 1) [x] xs
                      | otherwise = f (i - nx - 1) (x:s) xs
             where nx = length x
-- 
cgit v1.2.3