BinEmbed.hs

------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Simple.BinEmbed
-- Copyright   :  Claude Heiland-Allen 2010
-- Maintainer  :  claudiusmaximus@goto10.org
--
-- Support code to use @binembed@ as a pre-processor in Cabal.  For
-- example, your @Setup.hs@ might look like:
--
-- > import Distribution.Simple
-- > import Distribution.Simple.BinEmbed
-- > main = defaultMainWithHooks (withBinEmbed simpleUserHooks)
--
-- See the 'binembed-example' package for a more detailed example.

module Distribution.Simple.BinEmbed (withBinEmbed) where

import Distribution.Simple
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.PreProcess
import Distribution.Simple.Program
import Distribution.Simple.Setup
import Distribution.PackageDescription
import Data.Maybe (maybeToList)
import System.FilePath ((</>), dropExtension)

-- | Add hooks to use @binembed@ as a pre-processor, with input files
--   having the file name extension @.binembed@.  These hooks also
--   handle building the assembly output of @binembed@, as well as
--   cleaning it up afterwards.
withBinEmbed :: UserHooks -> UserHooks
withBinEmbed hooks = hooks
  { hookedPreProcessors = ("binembed", binembedPreProcessor) :
                          hookedPreProcessors hooks
  , hookedPrograms = binembedProgram : hookedPrograms hooks
  , buildHook = binembedBuild (buildHook hooks)
  , cleanHook = binembedClean (cleanHook hooks)
  }

--   @binembed@ executable.
binembedProgram :: Program
binembedProgram = simpleProgram "binembed"

--   The pre-processor invokes @binembed@ with sensible options, in
--   particular the output assembler source needs to be next to the data
--   files that it references.
binembedPreProcessor :: BuildInfo -> LocalBuildInfo -> PreProcessor
binembedPreProcessor _bi lbi = PreProcessor
  { platformIndependent = False
  , runPreProcessor = \(inBaseDir, inRelativeFile)
                       (outBaseDir, outRelativeFile)
                       verbosity -> do
      runDbProgram verbosity binembedProgram (withPrograms lbi) $
        [ "--output-hs=" ++ outBaseDir </> outRelativeFile
        , "--output-s=" ++ inBaseDir </> sfile (dropExtension outRelativeFile)
        , inBaseDir </> inRelativeFile
        ]
  }

--   Build by adding the output assembler to the C sources (this assumes
--   that the compiler used for C can also handle assembler sources; this
--   is true of GHC and GCC).
binembedBuild :: (PackageDescription -> LocalBuildInfo -> UserHooks -> BuildFlags -> IO ())
              ->  PackageDescription -> LocalBuildInfo -> UserHooks -> BuildFlags -> IO ()
binembedBuild buildHook0 pd lbi hooks flags = do
  let pd' = pd{ executables = map (\e -> e{ buildInfo = f $ buildInfo e })
                            $ executables pd
              , library = fmap (\l -> l{ libBuildInfo = f $ libBuildInfo l })
                        $ library pd
              }
  buildHook0 pd' lbi hooks flags
  where
    f bi = case lookup binembedX $ customFieldsBI bi of
             Nothing -> bi
             Just be -> bi{ cSources = sfiles be ++ cSources bi }

--   Clean up the intermediary assembler files.
binembedClean :: (PackageDescription -> () -> UserHooks -> CleanFlags -> IO ())
              ->  PackageDescription -> () -> UserHooks -> CleanFlags -> IO ()
binembedClean cleanHook0 pd x hooks flags = do
  let pd' = pd{ extraTmpFiles = concat . concat $
                        [ map (f . buildInfo) (executables pd)
                        , map (f . libBuildInfo) (maybeToList $ library pd)
                        , [extraTmpFiles pd]
                        ]
              }
  cleanHook0 pd' x hooks flags
  where
    f bi = case lookup binembedX $ customFieldsBI bi of
             Nothing -> []
             Just be -> sfiles be

--   The 'build' and 'clean' hooks need to know which modules are really
--   generated by @binembed@ - use the 'x-binembed: ModuleName' field in
--   the @pkgname.cabal@ file to accomplish this.
binembedX :: String
binembedX = "x-binembed"

--   Munge a module name to assembler source file name; don't just add
--   an extension or the generated @.o@ file will clash with the @.o@
--   file generated from the Haskell output.
sfile :: String -> String
sfile = (++ "_be.s")

--   The same, but for more than one module.
sfiles :: String -> [String]
sfiles be = map sfile (words be)