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)
withBinEmbed :: UserHooks -> UserHooks
withBinEmbed hooks = hooks
{ hookedPreProcessors = ("binembed", binembedPreProcessor) :
hookedPreProcessors hooks
, hookedPrograms = binembedProgram : hookedPrograms hooks
, buildHook = binembedBuild (buildHook hooks)
, cleanHook = binembedClean (cleanHook hooks)
}
binembedProgram :: Program
binembedProgram = simpleProgram "binembed"
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
]
}
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 }
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
binembedX :: String
binembedX = "x-binembed"
sfile :: String -> String
sfile = (++ "_be.s")
sfiles :: String -> [String]
sfiles be = map sfile (words be)