Permalink
Browse files

Add Ryan's custom setup script

  • Loading branch information...
ian-ross committed Mar 8, 2015
1 parent b6d8901 commit e5f29b832d455dacbddfc093cbbb9d3aa8abdeea
Showing with 92 additions and 0 deletions.
  1. +92 −0 custom-setup.hs
View
@@ -0,0 +1,92 @@
+--
+-- This Cabal setup script should ONLY be used in cases WHERE:
+--
+-- the bare structure wrapper capability of C2HS is used (i.e. '%'
+-- characters on pointer type arguments in "fun" hooks);
+--
+-- AND
+--
+-- a version of Cabal is being used that does not allow
+-- preprocessors to specify extra C sources (versions of
+-- cabal-install <= 1.22.0.0).
+--
+-- Otherwise Cabal should be able to deal with the extra C sources
+-- itself.
+--
+-- If in doubt, ask...
+--
+
+module Main (main) where
+
+import Control.Exception (catch)
+import Control.Monad (forM)
+
+import Distribution.PackageDescription
+ (BuildInfo(..), Executable(..), Library(..), PackageDescription(..))
+import Distribution.Simple (UserHooks(..),
+ defaultMainWithHooks, simpleUserHooks)
+import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..))
+import Distribution.Simple.Setup (BuildFlags)
+-- Test-suites require Cabal-1.10 or greater
+import Distribution.PackageDescription (TestSuite(..))
+-- Benchmarks require Cabal-1.14 or greater
+import Distribution.PackageDescription (Benchmark(..))
+
+import System.Directory (doesDirectoryExist, getDirectoryContents)
+import System.Exit (ExitCode)
+import System.FilePath ((</>), takeExtensions)
+
+main :: IO ()
+main = defaultMainWithHooks simpleUserHooks { buildHook = chsBuildHook }
+
+addCSources :: [FilePath] -> BuildInfo -> BuildInfo
+addCSources newSrcs bi@(BuildInfo { cSources = oldSrcs }) =
+ bi { cSources = newSrcs ++ oldSrcs }
+
+hasChsCExtension :: FilePath -> Bool
+hasChsCExtension file = takeExtensions file == ".chs.c"
+
+getRecursiveContents :: FilePath -> IO [FilePath]
+getRecursiveContents topdir = do
+ topdirExists <- doesDirectoryExist topdir
+ if (not topdirExists)
+ then return []
+ else do
+ names <- getDirectoryContents topdir
+ let properNames = filter (`notElem` [".", ".."]) names
+ paths <- forM properNames $ \name -> do
+ let path = topdir </> name
+ isDirectory <- doesDirectoryExist path
+ if isDirectory
+ then getRecursiveContents path
+ else return [path]
+ return (concat paths)
+
+chsBuildHook :: PackageDescription -> LocalBuildInfo -> UserHooks ->
+ BuildFlags -> IO ()
+chsBuildHook pd lbi uh bf = hook `catchExitCode` \_ -> hook
+ where
+ hook :: IO ()
+ hook = chsBuildHook' pd lbi uh bf
+
+ catchExitCode :: IO a -> (ExitCode -> IO a) -> IO a
+ catchExitCode = catch
+
+chsBuildHook' :: PackageDescription -> LocalBuildInfo -> UserHooks ->
+ BuildFlags -> IO ()
+chsBuildHook' pd@(PackageDescription
+ { library = mbLib
+ , executables = exes
+ , testSuites = tss
+ , benchmarks = bms
+ })
+ lbi uh bf = do
+ let distBuildDir = buildDir lbi
+ chsCFiles <- fmap (filter hasChsCExtension) $
+ getRecursiveContents distBuildDir
+ let pd' = pd { library = fmap (\lib -> lib { libBuildInfo = addCSources chsCFiles (libBuildInfo lib) }) mbLib
+ , executables = fmap (\exe -> exe { buildInfo = addCSources chsCFiles (buildInfo exe) }) exes
+ , testSuites = fmap (\ts -> ts { testBuildInfo = addCSources chsCFiles (testBuildInfo ts) }) tss
+ , benchmarks = fmap (\bm -> bm { benchmarkBuildInfo = addCSources chsCFiles (benchmarkBuildInfo bm) }) bms
+ }
+ buildHook simpleUserHooks pd' lbi uh bf

0 comments on commit e5f29b8

Please sign in to comment.