@@ -37,7 +37,7 @@ import Distribution.Simple.GHC ( componentGhcOptions, ghcLibDir )
37
37
import Distribution.Simple.Program.GHC
38
38
( GhcOptions (.. ), GhcDynLinkMode (.. ), renderGhcOptions )
39
39
import Distribution.Simple.Program
40
- ( ConfiguredProgram (.. ), requireProgramVersion
40
+ ( ConfiguredProgram (.. ), lookupProgramVersion , requireProgramVersion
41
41
, rawSystemProgram , rawSystemProgramStdout
42
42
, hscolourProgram , haddockProgram )
43
43
import Distribution.Simple.PreProcess
@@ -79,6 +79,7 @@ import Language.Haskell.Extension
79
79
80
80
import Control.Monad ( when , forM_ )
81
81
import Data.Either ( rights )
82
+ import Data.Functor ( (<$>) )
82
83
import Data.Monoid
83
84
import Data.Maybe ( fromMaybe , listToMaybe )
84
85
@@ -184,8 +185,9 @@ haddock pkg_descr lbi suffixes flags = do
184
185
185
186
initialBuildSteps (flag haddockDistPref) pkg_descr lbi verbosity
186
187
187
- when (flag haddockHscolour) $ hscolour' pkg_descr lbi suffixes $
188
- defaultHscolourFlags `mappend` haddockToHscolour flags
188
+ when (flag haddockHscolour) $
189
+ hscolour' (warn verbosity) pkg_descr lbi suffixes
190
+ (defaultHscolourFlags `mappend` haddockToHscolour flags)
189
191
190
192
libdirArgs <- getGhcLibDir verbosity lbi
191
193
let commonArgs = mconcat
@@ -599,49 +601,52 @@ hscolour pkg_descr lbi suffixes flags = do
599
601
-- we preprocess even if hscolour won't be found on the machine
600
602
-- will this upset someone?
601
603
initialBuildSteps distPref pkg_descr lbi verbosity
602
- hscolour' pkg_descr lbi suffixes flags
604
+ hscolour' die pkg_descr lbi suffixes flags
603
605
where
604
606
verbosity = fromFlag (hscolourVerbosity flags)
605
607
distPref = fromFlag $ hscolourDistPref flags
606
608
607
609
hscolour' :: PackageDescription
610
+ -> (String -> IO () ) -- ^ Called when the 'hscolour' exe is not found.
608
611
-> LocalBuildInfo
609
612
-> [PPSuffixHandler ]
610
613
-> HscolourFlags
611
614
-> IO ()
612
- hscolour' pkg_descr lbi suffixes flags = do
613
- let distPref = fromFlag $ hscolourDistPref flags
614
- (hscolourProg, _, _) <-
615
- requireProgramVersion
616
- verbosity hscolourProgram
617
- (orLaterVersion (Version [1 ,8 ] [] )) (withPrograms lbi)
618
-
619
- setupMessage verbosity " Running hscolour for" (packageId pkg_descr)
620
- createDirectoryIfMissingVerbose verbosity True $ hscolourPref distPref pkg_descr
621
-
622
- let pre c = preprocessComponent pkg_descr c lbi False verbosity suffixes
623
- withAllComponentsInBuildOrder pkg_descr lbi $ \ comp _ -> do
624
- pre comp
625
- let
626
- doExe com = case (compToExe com) of
627
- Just exe -> do
628
- let outputDir = hscolourPref distPref pkg_descr </> exeName exe </> " src"
629
- runHsColour hscolourProg outputDir =<< getExeSourceFiles lbi exe
630
- Nothing -> do
631
- warn (fromFlag $ hscolourVerbosity flags)
632
- " Unsupported component, skipping..."
633
- return ()
634
- case comp of
635
- CLib lib -> do
636
- let outputDir = hscolourPref distPref pkg_descr </> " src"
637
- runHsColour hscolourProg outputDir =<< getLibSourceFiles lbi lib
638
- CExe _ -> when (fromFlag (hscolourExecutables flags)) $ doExe comp
639
- CTest _ -> when (fromFlag (hscolourTestSuites flags)) $ doExe comp
640
- CBench _ -> when (fromFlag (hscolourBenchmarks flags)) $ doExe comp
615
+ hscolour' onNoHsColour pkg_descr lbi suffixes flags = do
616
+ either onNoHsColour (\ (hscolourProg, _, _) -> go hscolourProg) <$>
617
+ lookupProgramVersion verbosity hscolourProgram
618
+ (orLaterVersion (Version [1 ,8 ] [] )) (withPrograms lbi)
641
619
where
620
+ go hscolourProg = do
621
+ setupMessage verbosity " Running hscolour for" (packageId pkg_descr)
622
+ createDirectoryIfMissingVerbose verbosity True $
623
+ hscolourPref distPref pkg_descr
624
+
625
+ let pre c = preprocessComponent pkg_descr c lbi False verbosity suffixes
626
+ withAllComponentsInBuildOrder pkg_descr lbi $ \ comp _ -> do
627
+ pre comp
628
+ let
629
+ doExe com = case (compToExe com) of
630
+ Just exe -> do
631
+ let outputDir = hscolourPref distPref pkg_descr
632
+ </> exeName exe </> " src"
633
+ runHsColour hscolourProg outputDir =<< getExeSourceFiles lbi exe
634
+ Nothing -> do
635
+ warn (fromFlag $ hscolourVerbosity flags)
636
+ " Unsupported component, skipping..."
637
+ return ()
638
+ case comp of
639
+ CLib lib -> do
640
+ let outputDir = hscolourPref distPref pkg_descr </> " src"
641
+ runHsColour hscolourProg outputDir =<< getLibSourceFiles lbi lib
642
+ CExe _ -> when (fromFlag (hscolourExecutables flags)) $ doExe comp
643
+ CTest _ -> when (fromFlag (hscolourTestSuites flags)) $ doExe comp
644
+ CBench _ -> when (fromFlag (hscolourBenchmarks flags)) $ doExe comp
645
+
642
646
stylesheet = flagToMaybe (hscolourCSS flags)
643
647
644
648
verbosity = fromFlag (hscolourVerbosity flags)
649
+ distPref = fromFlag (hscolourDistPref flags)
645
650
646
651
runHsColour prog outputDir moduleFiles = do
647
652
createDirectoryIfMissingVerbose verbosity True outputDir
0 commit comments