aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorDavid Waern <david.waern@gmail.com>2009-03-27 23:12:53 +0000
committerDavid Waern <david.waern@gmail.com>2009-03-27 23:12:53 +0000
commit4bd0bf841e324c7e6a716ee3e12a94e73dfaa178 (patch)
tree80af4eba5e791f2404f3eccdececd891e3554bf8 /src
parent801a6bfe801fa971a5d1b937ba260af94f1d8854 (diff)
-Wall police in H.B.Hoogle
Diffstat (limited to 'src')
-rw-r--r--src/Haddock/Backends/Hoogle.hs32
1 files 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