[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