$OpenBSD: patch-Setup_lhs,v 1.1 2018/01/08 10:18:39 kili Exp $

Fix configuration with newer ghc/cabal etc.

From upstream commit c9fe8ac1fbffeef0be1c6e0796d798b2280a2e23, with
the \begin{code}/\end{code} bracket left in place, so we don't have
to rename Setup.lhs to Setup.hs.

Index: Setup.lhs
--- Setup.lhs.orig
+++ Setup.lhs
@@ -1,72 +1,45 @@
 \begin{code}
-{-# LANGUAGE TemplateHaskell #-}
 -- copyright (c) 2008 Duncan Coutts
 -- portions copyright (c) 2008 David Roundy
 -- portions copyright (c) 2007-2009 Judah Jacobson
 
-import qualified Distribution.InstalledPackageInfo as Installed
 import Distribution.Simple
          ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )
-import Distribution.Simple.Configure
-         ( checkForeignDeps )
 import Distribution.ModuleName( toFilePath )
 import Distribution.PackageDescription
-         ( PackageDescription(executables, testSuites), Executable(buildInfo, exeName)
-         , BuildInfo(customFieldsBI), emptyBuildInfo
+         ( PackageDescription(executables, testSuites), Executable(exeName)
+         , emptyBuildInfo
          , TestSuite(testBuildInfo)
-         , FlagName(FlagName)
          , updatePackageDescription
-         , cppOptions, ccOptions, ldOptions
-         , library, libBuildInfo, otherModules
-         , extraLibs, extraLibDirs, includeDirs )
+         , cppOptions, ccOptions
+         , library, libBuildInfo, otherModules )
 import Distribution.Package
-         ( packageVersion, packageName, PackageName(..), Package )
-import Distribution.Version
-         ( Version(Version, versionBranch) )
-import Data.Version( showVersion )
+         ( packageVersion )
+import Distribution.Version( Version )
 import Distribution.Simple.LocalBuildInfo
-         ( LocalBuildInfo(..), absoluteInstallDirs, externalPackageDeps )
+         ( LocalBuildInfo(..), absoluteInstallDirs )
 import Distribution.Simple.InstallDirs (mandir, CopyDest (NoCopyDest))
-import Distribution.Simple.PackageIndex ( topologicalOrder )
-import Distribution.Simple.Program ( gccProgram, rawSystemProgramStdoutConf )
 import Distribution.Simple.Setup
     (buildVerbosity, copyDest, copyVerbosity, fromFlag,
-     haddockVerbosity, installVerbosity, sDistVerbosity,
-     configVerbosity, ConfigFlags, configConfigurationsFlags)
-import qualified Distribution.Simple.Setup as DSS -- to get replVerbosity in Cabal > 1.18
-import Distribution.Simple.BuildPaths
-         ( autogenModulesDir, exeExtension )
+     haddockVerbosity, installVerbosity, sDistVerbosity, replVerbosity )
+import Distribution.Simple.BuildPaths ( autogenModulesDir )
 import Distribution.System
          ( OS(Windows), buildOS )
 import Distribution.Simple.Utils
     (copyFiles, createDirectoryIfMissingVerbose, rawSystemStdout,
-     rewriteFile, withTempFile, cabalVersion)
+     rewriteFile )
 import Distribution.Verbosity
          ( Verbosity )
 import Distribution.Text
          ( display )
-import Control.Monad ( zipWithM_, when, unless, filterM )
-import Control.Exception ( bracket, handle, IOException )
+import Control.Monad ( unless, void )
 
-import Language.Haskell.TH ( mkName, newName, recUpdE, varE, appE, lamE, varP )
-
 import System.Directory
-    (copyFile, createDirectory, createDirectoryIfMissing,
-     doesDirectoryExist, doesFileExist,
-     getCurrentDirectory, getDirectoryContents,
-     removeDirectoryRecursive, removeFile, setCurrentDirectory,
-     getTemporaryDirectory
-    )
-import System.Exit ( ExitCode(ExitSuccess) )
+    ( doesDirectoryExist, doesFileExist )
 import System.IO
-    ( openFile, IOMode (..), stdout
-    , hPutStr, hFlush, hClose
-    )
+    ( openFile, IOMode(..) )
 import System.Process (runProcess)
-import System.IO.Error ( isDoesNotExistError )
-import Data.List( isPrefixOf, isSuffixOf, sort )
-import System.Process( rawSystem )
-import System.FilePath       ( (</>), (<.>), splitDirectories, isAbsolute )
+import System.FilePath       ( (</>) )
 import Foreign.Marshal.Utils ( with )
 import Foreign.Storable      ( peek )
 import Foreign.Ptr           ( castPtr )
@@ -75,33 +48,11 @@ import Data.Word             ( Word8, Word32 )
 
 import qualified Control.Exception as Exception
 
+catchAny :: IO a -> (Exception.SomeException -> IO a) -> IO a
 catchAny f h = Exception.catch f (\e -> h (e :: Exception.SomeException))
 
-{- Template Haskell hackery for replHook while we want to support Cabal < 1.18 -}
-replVerbosity =
-  $(if cabalVersion >= Version [1,18,0] []
-        then varE (mkName "DSS.replVerbosity")
-        else [| error "This shouldn't be called" |]
-   )
-
-replHookBody replHookSel =
-  \pkg lbi hooks flags args ->
-    let verb = fromFlag $ replVerbosity flags
-    in commonBuildHook replHookSel pkg lbi hooks verb >>= (\f -> f flags args)
-
-addReplHook =
-  $(if cabalVersion >= Version [1,18,0] []
-        then
-            do hooks <- newName "hooks"
-               let replHook = mkName "replHook"
-               app <- appE (varE (mkName "replHookBody")) (varE replHook)
-               lamE [varP hooks] (recUpdE (varE hooks) [return (replHook, app)])
-        else [| \hooks -> hooks |]
-   )
-{- End of Template Haskell hackery -}
-
 main :: IO ()
-main = defaultMainWithHooks $ addReplHook $ simpleUserHooks {
+main = defaultMainWithHooks $ simpleUserHooks {
 
   buildHook = \ pkg lbi hooks flags ->
               let verb = fromFlag $ buildVerbosity flags
@@ -110,12 +61,9 @@ main = defaultMainWithHooks $ addReplHook $ simpleUser
   haddockHook = \ pkg lbi hooks flags ->
                 let verb = fromFlag $ haddockVerbosity flags
                  in commonBuildHook haddockHook pkg lbi hooks verb >>= ($ flags) ,
-{-
-  -- this is the actual replHook code we want
   replHook = \pkg lbi hooks flags args ->
                 let verb = fromFlag $ replVerbosity flags
                  in commonBuildHook replHook pkg lbi hooks verb >>= (\f -> f flags args) ,
--}
   postBuild = \ _ _ _ lbi -> buildManpage lbi,
   postCopy = \ _ flags pkg lbi ->
              installManpage pkg lbi (fromFlag $ copyVerbosity flags) (fromFlag $ copyDest flags),
@@ -126,7 +74,7 @@ main = defaultMainWithHooks $ addReplHook $ simpleUser
     let pkgVer = packageVersion pkg
         verb = fromFlag $ sDistVerbosity flags
     x <- versionPatches verb pkgVer
-    y <- context verb pkgVer
+    y <- context verb
     rewriteFile "release/distributed-version" $ show x
     rewriteFile "release/distributed-context" $ show y
     putStrLn "about to hand over"
@@ -137,23 +85,6 @@ main = defaultMainWithHooks $ addReplHook $ simpleUser
 
     sDistHook simpleUserHooks pkg' lbi hooks flags
              ,
-  confHook =
-    if buildOS == Windows
-      then confHook simpleUserHooks
-      else
-        \genericDescript flags -> do
-          lbi <- confHook simpleUserHooks genericDescript flags
-          let pkgDescr = localPkgDescr lbi
-          let verb = fromFlag (configVerbosity flags)
-          checkForeignDeps pkgDescr lbi verb
-          let lib = maybe (error "darcs library was not configured - did it end up unbuildable?") id
-                          (library pkgDescr)
-          let bi = libBuildInfo lib
-          bi' <- maybeSetLibiconv flags bi lbi
-          return lbi {localPkgDescr = pkgDescr {
-                                  library = Just lib {
-                                      libBuildInfo = bi'}}}
-              ,
   postConf = \_ _ _ _ -> return () --- Usually this checked for external C
              --- dependencies, but we already have performed such
              --- check in the confHook
@@ -167,7 +98,7 @@ commonBuildHook runHook pkg lbi hooks verbosity = do
   (version, state) <- determineVersion verbosity pkg
 
   -- Create our own context file.
-  generateVersionModule verbosity pkg lbi version state
+  generateVersionModule verbosity lbi version state
 
   -- Add custom -DFOO[=BAR] flags to the cpp (for .hs) and cc (for .c)
   -- invocations, doing a dance to make the base hook aware of them.
@@ -184,16 +115,14 @@ commonBuildHook runHook pkg lbi hooks verbosity = do
 
       -- updatePackageDescription doesn't handle test suites so we
       -- need to do this manually
-      updateTestSuiteBI bi testSuite
-          = testSuite { testBuildInfo = bi `mappend` testBuildInfo testSuite }
+      updateTestSuiteBI bi' testSuite
+          = testSuite { testBuildInfo = bi' `mappend` testBuildInfo testSuite }
       pkg'' = pkg' { testSuites = map (updateTestSuiteBI bi) (testSuites pkg') }
 
       lbi' = lbi { localPkgDescr = pkg'' }
   return $ runHook simpleUserHooks pkg'' lbi' hooks
 
   where
-    customFields = map fst . customFieldsBI . buildInfo $ darcsExe
-    darcsExe = head [e | e <- executables pkg, exeName e == "darcs"]
     show' :: String -> String   -- Petr was worried that we might
     show' = show                -- allow non-String arguments.
     testEndianness :: IO Bool
@@ -209,9 +138,8 @@ buildManpage lbi = do
   let darcs = buildDir lbi </> "darcs/darcs"
       manpage = buildDir lbi </> "darcs/darcs.1"
   manpageHandle <- openFile manpage WriteMode
-  runProcess darcs ["help","manpage"]
+  void $ runProcess darcs ["help","manpage"]
              Nothing Nothing Nothing (Just manpageHandle) Nothing
-  return ()
 
 installManpage :: PackageDescription -> LocalBuildInfo
                   -> Verbosity -> CopyDest -> IO ()
@@ -228,29 +156,21 @@ determineVersion :: Verbosity -> PackageDescription ->
 determineVersion verbosity pkg = do
   let darcsVersion  =  packageVersion pkg
   numPatches <- versionPatches verbosity darcsVersion
-  return (display darcsVersion, versionStateString numPatches darcsVersion)
+  return (display darcsVersion, versionStateString numPatches)
 
   where
-    versionStateString :: Maybe Int -> Version -> String
-    versionStateString Nothing  _ = "unknown"
-    versionStateString (Just 0) v = case versionBranch v of
-                         x | 97 `elem` x -> "alpha " ++ show (after 97 x)
-                           | 98 `elem` x -> "beta " ++ show (after 98 x)
-                           | 99 `elem` x  ->
-                               "release candidate " ++ show (after 99 x)
-                         _ -> "release"
-    versionStateString (Just 1) _ = "+ 1 patch"
-    versionStateString (Just n) _ = "+ " ++ show n ++ " patches"
-    after w (x:r) | w == x = head r
-                  | otherwise = after w r
-    after _ [] = undefined
+    versionStateString :: Maybe Int -> String
+    versionStateString Nothing  = "unknown"
+    versionStateString (Just 0) = "release"
+    versionStateString (Just 1) = "+ 1 patch"
+    versionStateString (Just n) = "+ " ++ show n ++ " patches"
 
 versionPatches :: Verbosity -> Version -> IO (Maybe Int)
 versionPatches verbosity darcsVersion = do
   numPatchesDarcs <- do
       out <- rawSystemStdout verbosity "darcs"
                ["log", "-a", "--from-tag", display darcsVersion, "--count"]
-      case reads (out) of
+      case reads out of
         ((n,_):_) -> return $ Just ((n :: Int) - 1)
         _         -> return Nothing
     `catchAny` \_ -> return Nothing
@@ -264,26 +184,23 @@ versionPatches verbosity darcsVersion = do
  where
   versionFile = "release/distributed-version"
 
-generateVersionModule :: Verbosity -> PackageDescription -> LocalBuildInfo
+generateVersionModule :: Verbosity -> LocalBuildInfo
                       -> String -> String -> IO ()
-generateVersionModule verbosity pkg lbi version state = do
+generateVersionModule verbosity lbi version state = do
   let dir = autogenModulesDir lbi
   createDirectoryIfMissingVerbose verbosity True dir
-  ctx <- context verbosity (packageVersion pkg)
+  ctx <- context verbosity
   rewriteFile (dir </> "Version.hs") $ unlines
     ["module Version where"
-    ,"builddeps, version, context :: String"
+    ,"version, context :: String"
     ,"version = \"" ++ version ++ " (" ++ state ++ ")\""
-    ,"builddeps = " ++ show ( formatdeps (externalPackageDeps lbi))
     ,"context = " ++ case ctx of
                        Just x -> show x
                        Nothing -> show "context not available"
     ]
-  where formatdeps = unlines . map (formatone . snd)
-        formatone p = case packageName p of PackageName n -> n ++ "-" ++ showVersion (packageVersion p)
 
-context :: Verbosity -> Version -> IO (Maybe String)
-context verbosity version = do
+context :: Verbosity -> IO (Maybe String)
+context verbosity = do
   contextDarcs <- do
       inrepo <- doesDirectoryExist "_darcs"
       unless inrepo $ fail "Not a repository."
@@ -307,76 +224,5 @@ parseFile f = do
                ((s,_):_) -> return s
                _         -> return Nothing
              else return Nothing
-
--- Test whether compiling a c program that links against libiconv needs -liconv.
-maybeSetLibiconv :: ConfigFlags -> BuildInfo -> LocalBuildInfo -> IO BuildInfo
-maybeSetLibiconv flags bi lbi = do
-    let biWithIconv = addIconv bi
-    let verb = fromFlag (configVerbosity flags)
-    if hasFlagSet flags (FlagName "libiconv")
-        then do
-            putStrLn "Using -liconv."
-            return biWithIconv
-        else do
-    putStr "checking whether to use -liconv... "
-    hFlush stdout
-    worksWithout <- tryCompile iconv_prog bi lbi verb
-    if worksWithout
-        then do
-            putStrLn "not needed."
-            return bi
-        else do
-    worksWith <- tryCompile iconv_prog biWithIconv lbi verb
-    if worksWith
-        then do
-            putStrLn "using -liconv."
-            return biWithIconv
-        else error "Unable to link against the iconv library."
-
-hasFlagSet :: ConfigFlags -> FlagName -> Bool
-hasFlagSet cflags flag = Just True == lookup flag (configConfigurationsFlags cflags)
-
-tryCompile :: String -> BuildInfo -> LocalBuildInfo -> Verbosity -> IO Bool
-tryCompile program bi lbi verb = handle processExit $ handle processException $ do
-    tempDir <- getTemporaryDirectory
-    withTempFile tempDir ".c" $ \fname cH ->
-      withTempFile tempDir "" $ \execName oH -> do
-        hPutStr cH program
-        hClose cH
-        hClose oH
-        -- TODO take verbosity from the args.
-        rawSystemProgramStdoutConf verb gccProgram (withPrograms lbi)
-                        (fname : "-o" : execName : args)
-        return True
-  where
-    processException :: IOException -> IO Bool
-    processException e = return False
-    processExit = return . (==ExitSuccess)
-    -- Mimicing Distribution.Simple.Configure
-    deps = topologicalOrder (installedPkgs lbi)
-    args = concat
-                  [ ccOptions bi
-                  , cppOptions bi
-                  , ldOptions bi
-                  -- --extra-include-dirs and --extra-lib-dirs are included
-                  -- in the below fields.
-                  -- Also sometimes a dependency like rts points to a nonstandard
-                  -- include/lib directory where iconv can be found. 
-                  , map ("-I" ++) (includeDirs bi ++ concatMap Installed.includeDirs deps)
-                  , map ("-L" ++) (extraLibDirs bi ++ concatMap Installed.libraryDirs deps)
-                  , map ("-l" ++) (extraLibs bi)
-                  ]
-
-addIconv :: BuildInfo -> BuildInfo
-addIconv bi = bi {extraLibs = "iconv" : extraLibs bi}
-
-iconv_prog :: String
-iconv_prog = unlines 
-    [ "#include <iconv.h>"
-    , "int main(void) {"
-    , "    iconv_t t = iconv_open(\"UTF-8\", \"UTF-8\");"
-    , "    return 0;"
-    , "}"
-    ]
 
 \end{code}
