Permalink
Browse files

Improved path handling with the filemanip package.

Finding packages and message files should be more robust.
  • Loading branch information...
1 parent 2c28535 commit d51962a9fc2188bcc6929a2efefbc707e5b22ffd Anthony Cowley committed Feb 12, 2013
Showing with 24 additions and 64 deletions.
  1. +3 −3 Examples/NodeCompose/NodeCompose.cabal
  2. +4 −2 roshask.cabal
  3. +17 −59 src/Ros/Core/Build/DepFinder.hs
View
6 Examples/NodeCompose/NodeCompose.cabal
@@ -11,7 +11,7 @@ Description: A demonstration of composing two Node values in order to
Executable composition
Build-Depends: base >= 4.2 && < 6,
- vector == 0.7.*,
+ vector > 0.7,
time >= 1.1,
roshask == 0.1.*,
mtl,
@@ -25,7 +25,7 @@ Executable composition
Executable scope
Build-Depends: base >= 4.2 && < 6,
- vector == 0.7.*,
+ vector > 0.7,
time >= 1.1,
roshask == 0.1.*,
mtl,
@@ -38,7 +38,7 @@ Executable scope
Executable detect
Build-Depends: base >= 4.2 && < 6,
- vector == 0.7.*,
+ vector > 0.7,
time >= 1.1,
roshask == 0.1.*,
mtl,
View
6 roshask.cabal
@@ -116,7 +116,8 @@ Library
haxr >= 3000.8.3,
utf8-string >= 0.3.6,
uri >= 0.1.5,
- vector-space
+ vector-space,
+ filemanip > 0.3.6
if !os(windows)
Build-depends: unix
@@ -147,7 +148,8 @@ Executable roshask
directory > 1.0,
process >= 1.0.1.2,
xml >= 1.3.5,
- pureMD5 >= 2.1
+ pureMD5 >= 2.1,
+ filemanip > 0.3.6
GHC-Options: -Odph -Wall -fno-warn-name-shadowing -fno-warn-duplicate-exports
Main-Is: Ros/Core/Msg/Main.hs
View
76 src/Ros/Core/Build/DepFinder.hs
@@ -9,25 +9,19 @@ 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,
- getDirectoryContents)
+import System.Directory (doesFileExist, doesDirectoryExist)
import System.Environment (getEnvironment)
-import System.FilePath ((</>), splitSearchPath, takeExtension,
- dropExtension, takeFileName, splitPath)
+import System.FilePath ((</>), splitSearchPath, dropExtension,
+ takeFileName, splitPath)
+import System.FilePath.Find hiding (find)
+import qualified System.FilePath.Find as F
import Text.XML.Light
-import Ros.Core.PathUtil (isPkg, isStack)
-
type Package = String
-- Find the path to a package based on the given search paths.
findPackagePath :: [FilePath] -> Package -> Maybe FilePath
findPackagePath search pkg = find ((== pkg) . last . splitPath) search
--- findPackagePath search pkg = go search
--- where go [] = return Nothing
--- go (p:ps) = let pkgPath = p </> pkg
--- in do e <- doesDirectoryExist pkgPath
--- if e then return (Just pkgPath) else go ps
-- Get the packages listed as dependencies in an XML manifest. NOTE:
-- In version 1.3.7, the xml package gained the ability to work with
@@ -41,36 +35,11 @@ getPackages = (map attrVal .
where pkg = QName "package" Nothing Nothing
dep = QName "depend" Nothing Nothing
--- Directory listing returning the full path to each entry excluding
--- "." and "..".
-dir :: FilePath -> IO [FilePath]
-dir p = getDirectoryContents p >>= return . map (p </>) . filter notDot
- where notDot s = s /= "." && s /= ".."
-
-- The given path is a possible package path root, as are all of its
-- subdirectories that are stacks (indicated by the presence of a
-- stack.xml file). Returns a list of package directories.
packagePaths :: FilePath -> IO [FilePath]
-packagePaths path = do p <- isPkg path
- if p then return [path]
- else do s <- isStack path
- if s
- then concat <$>
- (mapM stackPackages =<< dir path)
- else concat <$>
- (mapM stackPackages =<<
- filterM isStack =<<
- dir path)
- where stackPackages p = do isDir <- doesDirectoryExist p
- if isDir
- then do isp <- isPkg p
- if isp
- then return [p]
- else concat <$>
- (mapM stackPackages
- =<< filterM doesDirectoryExist
- =<< dir p)
- else return []
+packagePaths = F.find always (contains "manifest.xml")
-- Get every package directory on the ROS search path.
getRosPaths :: IO [FilePath]
@@ -96,25 +65,19 @@ ignoredPackages = ["genmsg_cpp", "rospack", "rosconsole", "rosbagmigration",
-- directory.
findPackageDepNames :: FilePath -> IO [String]
findPackageDepNames pkgRoot =
- let man = pkgRoot </> "manifest.xml"
- in do exists <- doesFileExist man
+ let manifest = pkgRoot </> "manifest.xml"
+ in do exists <- doesFileExist manifest
when (not exists)
- (error $ "Couldn't find "++man)
- txt <- readFile man
+ (error $ "Couldn't find "++manifest)
+ txt <- readFile manifest
case getPackages txt of
- Nothing -> error $ "Couldn't parse " ++ man
+ Nothing -> error $ "Couldn't parse " ++ manifest
Just ps -> return . nub $ filter (not . (`elem` ignoredPackages)) ps
-- |Returns 'True' if the ROS package at the given 'FilePath' defines
-- any messages.
hasMsgs :: FilePath -> IO Bool
-hasMsgs pkgPath =
- do e <- doesDirectoryExist msgPath
- if e
- then not . null . filter ((== ".msg") . takeExtension) <$>
- getDirectoryContents msgPath
- else return False
- where msgPath = pkgPath </> "msg"
+hasMsgs = fmap (not . null) . F.find (depth <? 2) (extension ==? ".msg")
{-
-- |Returns 'True' if the ROS package at the given 'FilePath' is a
@@ -132,9 +95,7 @@ findDepsWithMessages :: FilePath -> IO [String]
findDepsWithMessages pkgRoot =
do names <- findPackageDepNames pkgRoot
searchPaths <- getRosPaths
- let pkgPaths = map (findPackagePath searchPaths) names
- map fst <$> filterM (maybe (return False) hasMsgs . snd)
- (zip names pkgPaths)
+ filterM (maybe (return False) hasMsgs . findPackagePath searchPaths) names
-- |Find the paths to the packages this package depends on as
-- indicated by the manifest.xml file in this package's root
@@ -170,16 +131,13 @@ findPackageDepsTrans pkgRoot =
nub . (++[p]) . concat <$> mapM recurse deps
init <$> recurse pkgRoot
-
-
-- |Return the full path to every .msg file in the given package
-- directory.
findMessages :: FilePath -> IO [FilePath]
-findMessages path = aux =<< doesDirectoryExist msgPath
- where msgPath = path </> "msg"
- aux True = return . filter isMsg =<< dir msgPath
- aux False = return []
- isMsg = (==".msg") . takeExtension
+findMessages pkgRoot =
+ do e <- doesDirectoryExist dir
+ if e then F.find (depth <? 1) (extension ==? ".msg") dir else return []
+ where dir = pkgRoot </> "msg"
-- |Find all message definition files in a ROS package. Returns the
-- 'FilePath' to the package, and the 'FilePath' to each message

0 comments on commit d51962a

Please sign in to comment.