Setup.hs · typeable/entropy

1{-# LANGUAGE TemplateHaskell #-}

2import Distribution.Simple

3import Distribution.Simple.LocalBuildInfo

4import Distribution.Simple.Setup

5import Distribution.PackageDescription

6import Distribution.Simple.Utils

7import Distribution.Simple.Program

8import Distribution.Verbosity

9import System.Process

10import System.Directory

11import System.FilePath

12import System.Exit

13import Language.Haskell.TH (appE, varE, mkName, conE)

14

15main = defaultMainWithHooks hk

16 where

17 hk = simpleUserHooks { buildHook = \pd lbi uh bf -> do

18 let ccProg = Program "gcc" undefined undefined undefined

19 mConf = lookupProgram ccProg (withPrograms lbi)

20 err = error "Could not determine C compiler"

21 cc = locationPath . programLocation . maybe err id $ mConf

22 b <- canUseRDRAND cc

23 let newWithPrograms1 = userSpecifyArgs "gcc" cArgs (withPrograms lbi)

24 newWithPrograms = userSpecifyArgs "ghc" cArgsHC newWithPrograms1

25 lbiNew = if b then (lbi {withPrograms = newWithPrograms }) else lbi

26 buildHook simpleUserHooks pd lbiNew uh bf

27 }

28

29cArgs :: [String]

30cArgs = ["-DHAVE_RDRAND"]

31

32cArgsHC :: [String]

33cArgsHC = map ("-optc" ++) cArgs

34

35canUseRDRAND :: FilePath -> IO Bool

36canUseRDRAND cc = do

37 -- Template haskell to call withTempDirectory in a backward compatible way

38 -- withTempDirectory normal False "" "testRDRAND" $ \tmpDir -> do

39 $(if cabalVersion >= Version [1,17,0] []

40 then appE (appE (varE $ mkName "withTempDirectory") (varE 'normal)) (conE (mkName "False"))

41 else appE (varE $ mkName "withTempDirectory") (varE 'normal)) "" "testRDRAND" $ \tmpDir -> do

42 writeFile (tmpDir ++ "/testRDRAND.c")

43 (unlines [ "#include <stdint.h>"

44 , "int main() {"

45 , " uint64_t therand;"

46 , " unsigned char err;"

47 , " asm volatile(\"rdrand %0 ; setc %1\""

48 , " : \"=r\" (therand), \"=qm\" (err));"

49 , " return (!err);"

50 , "}"

51 ])

52 ec <- rawSystemExitCode normal cc [tmpDir </> "testRDRAND.c", "-o" ++ tmpDir ++ "/a.out"]

53 notice normal $ "Result of RDRAND Test: " ++ show (ec == ExitSuccess)

54 return (ec == ExitSuccess)