module Distribution.MacOSX.Dependencies (
includeDependencies,
appDependencyGraph
) where
import Control.Monad
import Data.List
import Data.Maybe
import System.Directory
import System.FilePath
import System.Process
import System.Exit
import Text.ParserCombinators.Parsec
import Distribution.MacOSX.Common
import Distribution.MacOSX.DG
includeDependencies ::
FilePath
-> MacApp -> IO ()
includeDependencies appPath app =
do dg <- appDependencyGraph appPath app
let fDeps = dgFDeps dg
mapM_ (copyInDependency appPath app) fDeps
mapM_ (updateDependencies appPath app) fDeps
appDependencyGraph ::
FilePath
-> MacApp -> IO DG
appDependencyGraph appPath app =
case (appDeps app) of
ChaseWithDefaults -> appDependencyGraph appPath app {
appDeps = ChaseWith defaultExclusions
}
ChaseWith xs -> do putStrLn "Building dependency graph"
buildDependencyGraph appPath app dgInitial roots [] xs
DoNotChase -> return dgInitial
where roots = appName app : otherBins app
dgInitial = dgEmpty `dgAddPaths` roots
buildDependencyGraph ::
FilePath
-> MacApp
-> DG
-> [FilePath]
-> [FilePath]
-> Exclusions
-> IO DG
buildDependencyGraph _ _ dg [] _ _ = return dg
buildDependencyGraph appPath app dg (x:xs) done excls =
do (dg', tgts) <- addFilesDependencies appPath app dg x excls
let done' = (x:done)
xs' = addToQueue xs done' tgts
buildDependencyGraph appPath app dg' xs' done' excls
where addToQueue :: [FilePath] -> [FilePath] -> [FilePath] -> [FilePath]
addToQueue q done' = foldl (addOneToQueue (q ++ done')) q
addOneToQueue :: [FilePath] -> [FilePath] -> FilePath -> [FilePath]
addOneToQueue done' q n = if n `elem` done' then q else q ++ [n]
addFilesDependencies ::
FilePath
-> MacApp
-> DG
-> FilePath
-> Exclusions
-> IO (DG, [FilePath])
addFilesDependencies appPath app dg p excls =
do (FDeps _ tgts) <- getFDeps appPath app p excls
let dg' = dgAddFDeps dg (FDeps p tgts)
return (dg', tgts)
getFDeps ::
FilePath
-> MacApp
-> FilePath
-> Exclusions
-> IO FDeps
getFDeps appPath app path exclusions =
do putStrLn $ "path: " ++ path
contents <- readProcess oTool ["-L", absPath] ""
putStrLn $ "contents: " ++ contents
case parse parseFileDeps "" contents of
Left err -> error $ show err
Right fDeps -> return $ exclude exclusions fDeps
where absPath = if path == appName app then
appPath </> pathInApp app (appName app)
else path
parseFileDeps :: Parser FDeps
parseFileDeps = do f <- manyTill (noneOf ":") (char ':')
_ <- char '\n'
deps <- parseDepOrName `sepEndBy` char '\n'
eof
return $ FDeps f $ filter (f /=) $ catMaybes deps
parseDepOrName :: Parser (Maybe FilePath)
parseDepOrName = do c <- oneOf "\t/"
case c of
'\t' ->
do dep <- parseDepOrIgnoreAt
return $ dep
'/' ->
do _ <- manyTill (noneOf ":") (char ':')
return Nothing
_ -> error "Can't happen"
parseDepOrIgnoreAt :: Parser (Maybe FilePath)
parseDepOrIgnoreAt = do c <- lookAhead (oneOf "/@")
case c of
'/' ->
do dep <- parseDep
return $ Just $ dep
'@' ->
do _ <- manyTill (noneOf ")") (char ')')
return Nothing
_ -> error "Can't happen"
parseDep :: Parser FilePath
parseDep = do dep <- manyTill (noneOf " ") (char ' ')
_ <- char '('
_ <- manyTill (noneOf ")") (char ')')
return dep
exclude :: Exclusions -> FDeps -> FDeps
exclude excls (FDeps p ds) = FDeps p $ filter checkExclude ds
where checkExclude :: FilePath -> Bool
checkExclude f = not $ any (`isInfixOf` f) excls
copyInDependency ::
FilePath
-> MacApp
-> FDeps
-> IO ()
copyInDependency appPath app (FDeps src _) =
Control.Monad.unless (src == appName app) $
do putStrLn $ "Copying " ++ src ++ " to " ++ tgt
createDirectoryIfMissing True $ takeDirectory tgt
copyFile src tgt
where tgt = appPath </> pathInApp app src
updateDependencies ::
FilePath
-> MacApp
-> FDeps
-> IO ()
updateDependencies appPath app (FDeps src tgts) =
mapM_ (updateDependency appPath app src) tgts
updateDependency ::
FilePath
-> MacApp
-> FilePath
-> FilePath
-> IO ()
updateDependency appPath app src tgt =
do putStrLn $ "Updating " ++ newLib ++ "'s dependency on " ++ tgt ++
" to " ++ tgt'
perm <- getPermissions newLib
setPermissions newLib perm { writable = True }
let cmd = iTool ++ " -change " ++ show tgt ++ " " ++ show tgt' ++
" " ++ show newLib
exitCode <- system cmd
setPermissions newLib perm
when (exitCode /= ExitSuccess) $
error $ "Failed to update library dependencies on " ++ show newLib ++
" with command: " ++ cmd
return ()
where tgt' = "@executable_path/../Frameworks/" </> makeRelative "/" tgt
newLib = appPath </> pathInApp app src
oTool :: FilePath
oTool = "/usr/bin/otool"
iTool :: FilePath
iTool = "/usr/bin/install_name_tool"