entropy-0.2.2.1: Setup.hs

{-# LANGUAGE TemplateHaskell #-}
import Distribution.Simple
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Setup
import Distribution.PackageDescription
import Distribution.Simple.Utils
import Distribution.Simple.Program
import Distribution.Verbosity
import System.Process
import System.Directory
import System.FilePath
import System.Exit
import Language.Haskell.TH (appE, varE, mkName, conE)

main = defaultMainWithHooks hk
 where
 hk = simpleUserHooks { buildHook = \pd lbi uh bf -> do
                                        let ccProg = Program "gcc" undefined undefined undefined
                                            mConf = lookupProgram ccProg (withPrograms lbi)
                                            err = error "Could not determine C compiler"
                                            cc = locationPath . programLocation  . maybe err id $ mConf
                                        b <- canUseRDRAND cc
                                        let newWithPrograms1 = userSpecifyArgs "gcc" cArgs (withPrograms lbi)
                                            newWithPrograms  = userSpecifyArgs "ghc" cArgsHC newWithPrograms1
                                            lbiNew = if b then (lbi {withPrograms = newWithPrograms }) else lbi
                                        buildHook simpleUserHooks pd lbiNew uh bf
                      }

cArgs :: [String]
cArgs = ["-DHAVE_RDRAND"]

cArgsHC :: [String]
cArgsHC = map ("-optc" ++) cArgs

canUseRDRAND :: FilePath -> IO Bool
canUseRDRAND cc = do
        -- Template haskell to call withTempDirectory in a backward compatible way
        -- withTempDirectory normal False "" "testRDRAND" $ \tmpDir -> do 
        $(if cabalVersion >= Version [1,17,0] []
            then  appE (appE (varE $ mkName "withTempDirectory") (varE 'normal)) (conE (mkName "False"))
            else  appE (varE $ mkName "withTempDirectory") (varE 'normal)) "" "testRDRAND" $ \tmpDir -> do
        writeFile (tmpDir ++ "/testRDRAND.c")
                (unlines        [ "#include <stdint.h>"
                                , "int main() {"
                                , "   uint64_t therand;"
                                , "   unsigned char err;"
                                , "   asm volatile(\"rdrand %0 ; setc %1\""
                                , "     : \"=r\" (therand), \"=qm\" (err));"
                                , "   return (!err);"
                                , "}"
                                ])
        ec <- rawSystemExitCode normal cc [tmpDir </> "testRDRAND.c", "-o" ++ tmpDir ++ "/a.out"]
        notice normal $ "Result of RDRAND Test: " ++ show (ec == ExitSuccess)
        return (ec == ExitSuccess)