[darcs-users] darcs patch: Appease ghc -Wall in Setup. (and 3 more)
Petr Rockai
me at mornfall.net
Sun May 24 19:31:57 UTC 2009
Trent W.Buck <trentbuck at gmail.com> writes:
> I'm quite pleased with the last patch in this bundle, I think it
> reduces suck significantly.
>
> Sun May 24 17:51:58 EST 2009 Trent W. Buck <trentbuck at gmail.com>
> * Appease ghc -Wall in Setup.
>
> Sun May 24 17:56:14 EST 2009 Trent W. Buck <trentbuck at gmail.com>
> * Setup.lhs isn't literate.
>
> Sun May 24 20:13:20 EST 2009 Trent W. Buck <trentbuck at gmail.com>
> * Extract Executable darcs by name.
> Don't assume it's the second of exactly three.
>
> Sun May 24 21:36:18 EST 2009 Trent W. Buck <trentbuck at gmail.com>
> * Refactor Setup.commonBuildHook.
> In detail, the changes are: use SHOW instead of nonstandard kludge
> QUOTE; avoid hard-coding the list of executables; move below MAIN so
> the entry point is at the top of the file; move removeFile so HBI is
> used just after it is bound; inline some trivial one-shot top-level
> definitions; and... add comments!
Overall looks good, minor inline comments below.
[snip housecleaning changes]
Extract Executable darcs by name.
---------------------------------
> hunk ./Setup.hs 8
> import Distribution.Simple
> ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )
> import Distribution.PackageDescription
> - ( PackageDescription(executables), Executable(buildInfo)
> + ( PackageDescription(executables), Executable(buildInfo, exeName)
> , BuildInfo(customFieldsBI), emptyBuildInfo
> , updatePackageDescription, cppOptions, ccOptions )
> import Distribution.Package
> hunk ./Setup.hs 146
> Windows -> True
> _ -> False
> customFields = map fst . customFieldsBI . buildInfo $ darcsExe
> - [_, darcsExe, _] = executables pkg
> + -- | The Executable such that { exeName = "darcs", ... }.
> + darcsExe = head [executable | executable <- executables pkg, "darcs" == exeName executable]
>
> archIsLittleEndian :: IO Bool
> archIsLittleEndian =
Ack.
Refactor Setup.commonBuildHook.
-------------------------------
> hunk ./Setup.hs 33
> ( display )
> import Distribution.Package (Package)
>
> -import Control.Monad ( zipWithM_, when, filterM )
> +import Control.Monad ( zipWithM_, when, unless, filterM )
> import Control.Exception ( bracket )
> import System.Directory( doesDirectoryExist, doesFileExist,
> getDirectoryContents, createDirectory,
> hunk ./Setup.hs 57
> import qualified Control.Exception as Exception
> #endif
>
> -hookedInfo :: a -> (Maybe a, [(String, a)])
> -hookedInfo inf = (Just inf, [("darcs", inf), ("witnesses", inf), ("unit", inf)])
> -
> -define :: String -> String -> String
> -define n v = "-D" ++ n ++ (if null v then "" else "=" ++ v ++ "")
> -
> -quote :: String -> String
> -quote s = "\"" ++ s ++ "\""
> -
> -commonBuildHook :: (UserHooks -> PackageDescription -> LocalBuildInfo -> t -> a)
> - -> PackageDescription -> LocalBuildInfo -> t -> Verbosity -> IO a
> -commonBuildHook runHook pkg lbi hooks verbosity = do
> - -- Do some custom stuff:
> - writeGeneratedModules verbosity pkg lbi
> - (version, state) <- determineVersion verbosity pkg
> - autoconfd <- autoconfDefines verbosity pkg lbi
> - let cpp = autoconfd ++
> - [define "PACKAGE_VERSION" $ quote version,
> - define "PACKAGE_VERSION_STATE" $ quote state]
> - hbi = hookedInfo $ emptyBuildInfo { cppOptions = cpp, ccOptions = cpp }
> - pkg' = updatePackageDescription hbi pkg
> - lbi' = lbi { localPkgDescr = pkg' }
> -
> - removeFile "src/Context.hs"
> - `catch` (\e -> if isDoesNotExistError e
> - then return ()
> - else ioError e)
> -
> - return $ runHook simpleUserHooks pkg' lbi' hooks
> -
> main :: IO ()
> main = defaultMainWithHooks simpleUserHooks {
>
> hunk ./Setup.hs 100
> sDistHook simpleUserHooks pkg lbi hooks flags
> }
>
> -autoconfDefines :: t -> PackageDescription -> t1 -> IO [String]
> -autoconfDefines _ pkg _ = do
> - bigendian <- fmap not archIsLittleEndian
> +-- | For @./Setup build@ and @./Setup haddock@, do some unusual
> +-- things, then invoke the base behaviour ("simple hook").
> +commonBuildHook :: (UserHooks -> PackageDescription -> LocalBuildInfo -> t -> a)
> + -> PackageDescription -> LocalBuildInfo -> t -> Verbosity -> IO a
> +commonBuildHook runHook pkg lbi hooks verbosity = do
> + -- Autoconf may have generated a context file. Remove it before
> + -- building, as its existence inexplicably breaks Cabal.
> + removeFile "src/Context.hs"
> + `catch` (\e -> unless (isDoesNotExistError e) (ioError e))
>
> hunk ./Setup.hs 110
> - let features = [ ("HAVE_HTTP", "x-have-http" `elem` customFields)
> - , ("USE_COLOR", "x-use-color" `elem` customFields)
> - , ("HAVE_MAPI", isWindows)
> - , ("BIGENDIAN", bigendian) ]
> + -- Create our own context file.
> + writeGeneratedModules verbosity pkg lbi
>
> hunk ./Setup.hs 113
> - return $ [ define x "" | (x, True) <- features ]
> + -- 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.
> + (version, state) <- determineVersion verbosity pkg
> + littleEndian <- testEndianness
> + let args = ("-DPACKAGE_VERSION=" ++ show version) :
> + ("-DPACKAGE_VERSION_STATE=" ++ show state) :
> + [arg | (arg, True) <- -- include fst iff snd.
> + [("-DHAVE_HTTP", "x-have-http" `elem` customFields),
> + ("-DUSE_COLOR", "x-use-color" `elem` customFields),
> + -- We have MAPI iff building on/for Windows.
> + ("-DHAVE_MAPI", buildOS == Windows),
> + ("-DBIGENDIAN", not littleEndian)]]
> + bi = emptyBuildInfo { cppOptions = args, ccOptions = args }
> + hbi = (Just bi, [(exeName exe, bi) | exe <- executables pkg])
> + pkg' = updatePackageDescription hbi pkg
> + lbi' = lbi { localPkgDescr = pkg' }
> + return $ runHook simpleUserHooks pkg' lbi' hooks
Well, the quote function has a much better type for this use case IMHO (avoids
mistakenly quoting a non-string). There used to be some show-related bugs some
point. (Although this looks safe, but I'd argue that it makes future
refactoring a little harder.) Other than that, fine with me.
> where
> hunk ./Setup.hs 132
> - isWindows = case Distribution.System.buildOS of
> - Windows -> True
> - _ -> False
> customFields = map fst . customFieldsBI . buildInfo $ darcsExe
> hunk ./Setup.hs 133
> - -- | The Executable such that { exeName = "darcs", ... }.
> - darcsExe = head [executable | executable <- executables pkg, "darcs" == exeName executable]
> -
> -archIsLittleEndian :: IO Bool
> -archIsLittleEndian =
> - with (1 :: Word32) $ \p -> do o <- peek $ castPtr p
> - return $ o == (1 :: Word8)
> + darcsExe = head [e | e <- executables pkg, exeName e == "darcs"]
> + testEndianness :: IO Bool
> + testEndianness = with (1 :: Word32) $ \p -> do o <- peek $ castPtr p
> + return $ o == (1 :: Word8)
>
> writeGeneratedModules :: Verbosity
> -> PackageDescription -> LocalBuildInfo -> IO ()
>
Ok.
Yours,
Petr.
--
Peter Rockai | me()mornfall!net | prockai()redhat!com
http://blog.mornfall.net | http://web.mornfall.net
"In My Egotistical Opinion, most people's C programs should be
indented six feet downward and covered with dirt."
-- Blair P. Houghton on the subject of C program indentation
More information about the darcs-users
mailing list