Fix patchBuildToolProgs when haddock cannot be found

Cabal's GHC.configure doesn't demand haddock exist, so we have to handle the case where it's not installed.
DanielG · Feb 10, 2020 · 4ca6570 · 4ca6570
1 parent c677e72
commit 4ca6570
Show file tree

Hide file tree

Showing 3 changed files with 19 additions and 14 deletions.
diff --git a/cabal-helper.cabal b/cabal-helper.cabal
@@ -110,7 +110,7 @@ common build-deps
   build-depends:       unix-compat      < 0.6  && >= 0.4.3.1
 
   if flag(dev)
-    ghc-options:       -Wall
+    ghc-options:       -Wall -fwarn-incomplete-uni-patterns
 
 
 common c-h-internal
@@ -174,14 +174,14 @@ test-suite compile-test
   main-is:             CompileTest.hs
   other-modules:       TestOptions
   hs-source-dirs:      tests
-  ghc-options:         -Wall
+  ghc-options:         -Wall -fwarn-incomplete-uni-patterns
 
 test-suite programs-test
   import:              build-deps, extensions, c-h-internal
   type:                exitcode-stdio-1.0
   main-is:             ProgramsTest.hs
   hs-source-dirs:      tests
-  ghc-options:         -Wall
+  ghc-options:         -Wall -fwarn-incomplete-uni-patterns
   build-depends:       pretty-show
 
 test-suite ghc-session
@@ -190,7 +190,7 @@ test-suite ghc-session
   main-is:             GhcSession.hs
   other-modules:       TestOptions
   hs-source-dirs:      tests
-  ghc-options:         -Wall
+  ghc-options:         -Wall -fwarn-incomplete-uni-patterns
   build-depends:       ghc              < 8.9  && >= 8.0.2
                      , pretty-show      < 1.9  && >= 1.8.1
 
@@ -199,7 +199,7 @@ test-suite examples
   type:                exitcode-stdio-1.0
   main-is:             Examples.hs
   hs-source-dirs:      tests
-  ghc-options:         -Wall
+  ghc-options:         -Wall -fwarn-incomplete-uni-patterns
 
 executable cabal-helper-main
   default-language:    Haskell2010
@@ -220,7 +220,7 @@ executable cabal-helper-main
   else
     buildable:         False
 
-  ghc-options:         -Wall -fno-warn-unused-imports
+  ghc-options:         -Wall -fno-warn-unused-imports -fwarn-incomplete-uni-patterns
   build-depends:       base             < 5    && >= 4.9.1.0
                      , Cabal
                      , containers

diff --git a/src/CabalHelper/Compiletime/CompPrograms.hs b/src/CabalHelper/Compiletime/CompPrograms.hs
@@ -2,6 +2,7 @@
 
 module CabalHelper.Compiletime.CompPrograms where
 
+import Control.Monad (when)
 import Data.List
 import Data.Maybe
 import System.Directory
@@ -10,6 +11,7 @@ import System.IO.Temp
 
 import CabalHelper.Compiletime.Types
 import CabalHelper.Compiletime.Cabal (getCabalVerbosity)
+import CabalHelper.Shared.Common (panicIO)
 import Symlink (createSymbolicLink)
 
 import Distribution.Simple.GHC as GHC (configure)
@@ -80,20 +82,23 @@ patchBuildToolProgs SStack progs = do
   -- being able to pass executable paths straight through to stack but
   -- currently there is no option to let us do that.
   withSystemTempDirectory "cabal-helper-symlinks" $ \bindir -> do
-  createProgSymlink bindir $ ghcProgram progs
-  createProgSymlink bindir $ ghcPkgProgram progs
-  createProgSymlink bindir $ haddockProgram progs
+  createProgSymlink True bindir $ ghcProgram progs
+  createProgSymlink True bindir $ ghcPkgProgram progs
+  createProgSymlink False bindir $ haddockProgram progs
   return $ progs
     { stackEnv =
         [("PATH", EnvPrepend $ bindir ++ [searchPathSeparator])] ++
         stackEnv progs
     }
 
-createProgSymlink :: FilePath -> FilePath -> IO ()
-createProgSymlink bindir target
+createProgSymlink :: Bool -> FilePath -> FilePath -> IO ()
+createProgSymlink required bindir target
   | [exe] <- splitPath target = do
-    Just exe_path <- findExecutable exe
-    createSymbolicLink exe_path (bindir </> takeFileName target)
+    mb_exe_path <- findExecutable exe
+    case mb_exe_path of
+      Just exe_path -> createSymbolicLink exe_path (bindir </> takeFileName target)
+      Nothing -> when required $ panicIO $ "Error trying to create symlink to '" ++ target ++ "': "
+                                        ++ "'" ++ exe ++ "'" ++ " executable not found."
   | otherwise = do
     cwd <- getCurrentDirectory
     createSymbolicLink (cwd </> target) (bindir </> takeFileName target)
diff --git a/src/CabalHelper/Compiletime/Program/Stack.hs b/src/CabalHelper/Compiletime/Program/Stack.hs
@@ -85,7 +85,7 @@ paths qe@QueryEnv{qeProjLoc=ProjLocStackYaml stack_yaml} cwd
     workdirArg qe ++ [ "path", "--stack-yaml="++stack_yaml ]
   return $ \k -> let Just x = lookup k $ map split $ lines out in x
   where
-    split l = let (key, ' ' : val) = span (not . isSpace) l in (key, val)
+    split l = let (key, val) = break isSpace l in (key, dropWhile isSpace val)
 
 listPackageCabalFiles :: QueryEnvI c 'Stack -> IO [CabalFile]
 listPackageCabalFiles qe@QueryEnv{qeProjLoc}