module Ros.Internal.DepFinder (findPackageDeps, findPackageDepNames,
findPackageDepsTrans,
findMessages, findMessage, findMessagesInPkg,
findDepsWithMessages, hasMsgsOrSrvs,
findServices
) where
import Control.Applicative ((<$>))
import Control.Monad (when, filterM)
import Data.Maybe (mapMaybe, isNothing, fromJust)
import Data.List (find, findIndex, nub)
import System.Directory (doesFileExist, doesDirectoryExist)
import System.Environment (getEnvironment)
import System.FilePath ((</>), splitSearchPath, dropExtension,
takeFileName, splitPath)
import System.FilePath.Find hiding (find)
import qualified System.FilePath.Find as F
import Text.XML.Light
type Package = String
findPackagePath :: [FilePath] -> Package -> Maybe FilePath
findPackagePath search pkg = find ((== pkg) . last . splitPath) search
getPackages :: String -> Maybe [Package]
getPackages = (map attrVal .
mapMaybe (find ((==pkg).attrKey) . elAttribs) .
findChildren dep <$>) .
parseXMLDoc
where pkg = QName "package" Nothing Nothing
dep = QName "depend" Nothing Nothing
catkinBuildDeps :: String -> Maybe [Package]
catkinBuildDeps = fmap (map strContent . findChildren dep) . parseXMLDoc
where dep = QName "build_depend" Nothing Nothing
packagePaths :: FilePath -> IO [FilePath]
packagePaths = F.find always $
contains "manifest.xml" ||? contains "package.xml"
getRosPaths :: IO [FilePath]
getRosPaths =
do env <- getEnvironment
let pPaths = case lookup "ROS_PACKAGE_PATH" env of
Just s -> s
Nothing -> error "ROS_PACKAGE_PATH not set in environment"
allPaths = splitSearchPath pPaths
concat <$> (mapM packagePaths =<< filterM doesDirectoryExist allPaths)
ignoredPackages :: [String]
ignoredPackages = ["genmsg_cpp", "rospack", "rosconsole", "rosbagmigration",
"roscpp", "rospy", "roslisp", "roslib", "boost"]
findPackageDepNames :: FilePath -> IO [String]
findPackageDepNames pkgRoot =
let manifest = pkgRoot </> "manifest.xml"
pkg = pkgRoot </> "package.xml"
in do exists <- doesFileExist manifest
existsCatkin <- doesFileExist pkg
when (not $ exists || existsCatkin)
(error $ "Couldn't find "++manifest++" or "++pkg)
pkgs <- if exists
then getPackages <$> readFile manifest
else catkinBuildDeps <$> readFile pkg
case pkgs of
Nothing -> error $ "Couldn't parse package file for " ++ pkgRoot
Just ps -> return . nub $ filter (not . (`elem` ignoredPackages)) ps
hasMsgsOrSrvs :: FilePath -> IO Bool
hasMsgsOrSrvs = fmap (not . null) . F.find (depth <? 2) (extension ==? ".msg" ||? extension ==? ".srv")
findDepsWithMessages :: FilePath -> IO [String]
findDepsWithMessages pkgRoot =
do names <- findPackageDepNames pkgRoot
searchPaths <- getRosPaths
filterM (maybe (return False) hasMsgsOrSrvs . findPackagePath searchPaths) names
findPackageDeps :: FilePath -> IO [FilePath]
findPackageDeps pkgRoot =
do pkgs <- findPackageDepNames pkgRoot
searchPaths <- getRosPaths
let pkgPaths = map (findPackagePath searchPaths) pkgs
case findIndex isNothing pkgPaths of
Just i -> putStrLn ("Looking for "++show pkgs++
", dependencies of"++pkgRoot) >>
error ("Couldn't find path to package (1) " ++ (pkgs !! i))
Nothing -> return $ map fromJust pkgPaths
findPackageDepsTrans :: FilePath -> IO [FilePath]
findPackageDepsTrans pkgRoot =
do searchPaths <- getRosPaths
let getDeps pkg =
do pkgDeps <- findPackageDepNames pkg
let pkgPaths = map (findPackagePath searchPaths) pkgDeps
case findIndex isNothing pkgPaths of
Just i -> putStrLn ("Looking for "++show pkgDeps++
", dependencies of "++pkgRoot) >>
error ("Couldn't find path to package (2) " ++
(pkgDeps !! i))
Nothing -> return $ map fromJust pkgPaths
recurse p = do deps <- getDeps p
nub . (++[p]) . concat <$> mapM recurse deps
init <$> recurse pkgRoot
findMessages :: FilePath -> IO [FilePath]
findMessages pkgRoot =
do e <- doesDirectoryExist dir
if e then F.find (depth <? 1) (extension ==? ".msg") dir else return []
where dir = pkgRoot </> "msg"
findServices :: FilePath -> IO [FilePath]
findServices pkgRoot =
do e <- doesDirectoryExist dir
if e then F.find (depth <? 1) (extension ==? ".srv") dir else return []
where dir = pkgRoot </> "srv"
findMessagesInPkg :: String -> IO (FilePath, [FilePath])
findMessagesInPkg pkgName = do searchPaths <- getRosPaths
let pkgPath = maybe err id $
findPackagePath searchPaths pkgName
msgs <- findMessages pkgPath
return (pkgPath, msgs)
where err = error $ "Couldn't find path to package (3) " ++ pkgName
findMessage :: String -> String -> IO (Maybe FilePath)
findMessage pkg msgType =
do searchPaths <- getRosPaths
let pkgPath = findPackagePath searchPaths pkg
case pkgPath of
Just p -> find isMsg <$> findMessages p
Nothing -> putStrLn ("Looking for "++pkg++"."++msgType) >>
error ("Couldn't find path to package " ++ pkg)
where isMsg = (== msgType) . dropExtension . takeFileName