[commit: haddock] master: Style only (f5532d2)

[git at git.haskell.org]

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

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

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

commit f5532d27aa6849305dfa7042ccbf900a56555a2f
Author: Mateusz Kowalczyk <fuuzetsu at fuuzetsu.co.uk>
Date:   Thu Mar 13 21:28:09 2014 +0000

    Style only


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

f5532d27aa6849305dfa7042ccbf900a56555a2f
 src/Haddock.hs |   60 ++++++++++++++++++++++++++------------------------------
 1 file changed, 28 insertions(+), 32 deletions(-)

diff --git a/src/Haddock.hs b/src/Haddock.hs
index 67c4536..6d975c9 100644
--- a/src/Haddock.hs
+++ b/src/Haddock.hs
@@ -1,5 +1,6 @@
 {-# OPTIONS_GHC -Wwarn #-}
 {-# LANGUAGE CPP, ScopedTypeVariables #-}
+{-# LANGUAGE LambdaCase #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Haddock
@@ -296,9 +297,8 @@ readInterfaceFiles name_cache_accessor pairs = do
   catMaybes `liftM` mapM tryReadIface pairs
   where
     -- try to read an interface, warn if we can't
-    tryReadIface (paths, file) = do
-      eIface <- readInterfaceFile name_cache_accessor file
-      case eIface of
+    tryReadIface (paths, file) =
+      readInterfaceFile name_cache_accessor file >>= \case
         Left err -> liftIO $ do
           putStrLn ("Warning: Cannot read " ++ file ++ ":")
           putStrLn ("   " ++ err)
@@ -315,22 +315,21 @@ readInterfaceFiles name_cache_accessor pairs = do
 -- | Start a GHC session with the -haddock flag set. Also turn off
 -- compilation and linking. Then run the given 'Ghc' action.
 withGhc :: String -> [String] -> (DynFlags -> Ghc a) -> IO a
-withGhc libDir flags ghcActs = do
-  runGhc (Just libDir) $ do
-    dynflags  <- getSessionDynFlags
-    let dynflags' = gopt_set dynflags Opt_Haddock
-    let dynflags'' = dynflags' {
-        hscTarget = HscNothing,
-        ghcMode   = CompManager,
-        ghcLink   = NoLink
-      }
-    dynflags''' <- parseGhcFlags dynflags''
-    defaultCleanupHandler dynflags''' $ do
-        -- ignore the following return-value, which is a list of packages
-        -- that may need to be re-linked: Haddock doesn't do any
-        -- dynamic or static linking at all!
-        _ <- setSessionDynFlags dynflags'''
-        ghcActs dynflags'''
+withGhc libDir flags ghcActs = runGhc (Just libDir) $ do
+  dynflags  <- getSessionDynFlags
+  let dynflags' = gopt_set dynflags Opt_Haddock
+  let dynflags'' = dynflags' {
+      hscTarget = HscNothing,
+      ghcMode   = CompManager,
+      ghcLink   = NoLink
+    }
+  dynflags''' <- parseGhcFlags dynflags''
+  defaultCleanupHandler dynflags''' $ do
+      -- ignore the following return-value, which is a list of packages
+      -- that may need to be re-linked: Haddock doesn't do any
+      -- dynamic or static linking at all!
+      _ <- setSessionDynFlags dynflags'''
+      ghcActs dynflags'''
   where
     parseGhcFlags :: MonadIO m => DynFlags -> m DynFlags
     parseGhcFlags dynflags = do
@@ -447,25 +446,22 @@ getPrologue :: DynFlags -> [Flag] -> IO (Maybe (Doc RdrName))
 getPrologue dflags flags =
   case [filename | Flag_Prologue filename <- flags ] of
     [] -> return Nothing
-    [filename] -> do
-      withFile filename ReadMode $ \h -> do
-        hSetEncoding h utf8
-        str <- hGetContents h
-        case parseParasMaybe dflags str of
-          Nothing ->
-            throwE $ "failed to parse haddock prologue from file: " ++ filename
-          Just doc -> return (Just doc)
+    [filename] -> withFile filename ReadMode $ \h -> do
+      hSetEncoding h utf8
+      str <- hGetContents h
+      case parseParasMaybe dflags str of
+        Nothing ->
+          throwE $ "failed to parse haddock prologue from file: " ++ filename
+        Just doc -> return (Just doc)
     _otherwise -> throwE "multiple -p/--prologue options"
 
 
 #ifdef IN_GHC_TREE
 
 getInTreeDir :: IO String
-getInTreeDir = do
-  m <- getExecDir
-  case m of
-    Nothing -> error "No GhcDir found"
-    Just d -> return (d </> ".." </> "lib")
+getInTreeDir = getExecDir >>= \case
+  Nothing -> error "No GhcDir found"
+  Just d -> return (d </> ".." </> "lib")
 
 
 getExecDir :: IO (Maybe String)