diff options
| -rw-r--r-- | src/Haddock/Interface/Create.hs | 2 | ||||
| -rw-r--r-- | src/Main.hs | 24 |
2 files changed, 16 insertions, 10 deletions
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs index 94c2a7e7..caaed13c 100644 --- a/src/Haddock/Interface/Create.hs +++ b/src/Haddock/Interface/Create.hs @@ -762,7 +762,7 @@ extractClassDecl c tvs0 (L pos (TypeSig lname ltype)) = case ltype of _ -> L pos (TypeSig lname (noLoc (mkImplicitHsForAllTy (lctxt []) ltype))) where lctxt = noLoc . ctxt - ctxt preds = noLoc (HsClassP c (map toTypeNoLoc tvs0)) : preds + ctxt preds = nlHsTyConApp c (map toTypeNoLoc tvs0) : preds extractClassDecl _ _ _ = error "extractClassDecl: unexpected decl" diff --git a/src/Main.hs b/src/Main.hs index cc5d1302..787b5574 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -329,7 +329,7 @@ getHaddockLibDir flags = case [str | Flag_Lib str <- flags] of [] -> #ifdef IN_GHC_TREE - fmap snd getInTreeDirs + getInTreeDir #else getDataDir -- provided by Cabal #endif @@ -338,15 +338,21 @@ getHaddockLibDir flags = getGhcDirs :: [Flag] -> IO (String, String) getGhcDirs flags = do - (ghcPath, libDir) <- + case [ dir | Flag_GhcLibDir dir <- flags ] of + [] -> do #ifdef IN_GHC_TREE - getInTreeDirs + libDir <- getInTreeDir + return (ghcPath, libDir) #else - return (GhcPaths.ghc, GhcPaths.libdir) + return (ghcPath, GhcPaths.libdir) #endif - case [ dir | Flag_GhcLibDir dir <- flags ] of - [] -> return (ghcPath, libDir) xs -> return (ghcPath, last xs) + where +#ifdef IN_GHC_TREE + ghcPath = "not available" +#else + ghcPath = GhcPaths.ghc +#endif shortcutFlags :: [Flag] -> IO () @@ -409,12 +415,12 @@ getPrologue flags = #ifdef IN_GHC_TREE -getInTreeDirs :: IO (String, String) -getInTreeDirs = do +getInTreeDir :: IO String +getInTreeDir = do m <- getExecDir case m of Nothing -> error "No GhcDir found" - Just d -> let p = d </> ".." in return (p </> "bin" </> "ghc", p </> "lib") + Just d -> return (d </> ".." </> "lib") getExecDir :: IO (Maybe String) |