content: {-# LANGUAGE CPP #-}
  -- Use a package's manifest.xml file to find paths to the packages on
  -- which this package is dependent.
  module Ros.Internal.DepFinder (findPackageDeps, findPackageDepNames,
                                 findPackageDepsTrans,
                                 findMessages, findMessage, findMessagesInPkg,
                                 findDepsWithMessages, hasMsgsOrSrvs,
                                 findServices
                                ) where
  #if __GLASGOW_HASKELL__ < 710                              
  import Control.Applicative ((<$>))
  #endif
  import Control.Monad (when, filterM)
  import Data.Maybe (mapMaybe, isJust, catMaybes)
  import Data.List (find, 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
  
  -- 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
  
  -- 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
  -- ByteStrings via the XmlSource typeclass. Consider that upgrade if
  -- performance is causing trouble.
  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
  
  -- The catkin build system uses a @package.xml@ file that is somewhat
  -- different from the older @manifest.xml@.
  catkinBuildDeps :: String -> Maybe [Package]
  catkinBuildDeps = fmap (map strContent . findChildren dep) . parseXMLDoc
    where dep = QName "build_depend" Nothing Nothing
  
  -- 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 = F.find always $
                 contains "manifest.xml" ||? contains "package.xml"
  
  -- Get every package directory on the ROS search path.
  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"
             -- rPath = case lookup "ROS_ROOT" env of
             --           Just s -> s
             --           Nothing -> error "ROS_ROOT not set in environment"
             allPaths = splitSearchPath pPaths
         concat <$> (mapM packagePaths =<< filterM doesDirectoryExist allPaths)
  
  -- Packages that we will ignore for tracking down message definition
  -- dependencies.
  ignoredPackages :: [String]
  ignoredPackages = [ "genmsg_cpp", "rospack", "rosconsole", "rosbagmigration"
                    , "roscpp", "rospy", "roslisp", "roslib", "boost"
                    , "libconsole-bridge-dev" ]
  
  -- |Find the names of the ROS packages this package depends on as
  -- indicated by the manifest.xml or package.xml file in this package's root
  -- directory.
  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
  
  -- |Returns 'True' if the ROS package at the given 'FilePath' defines
  -- any messages or services
  hasMsgsOrSrvs :: FilePath -> IO Bool
  hasMsgsOrSrvs = fmap (not . null) . F.find (depth <? 2) (extension ==? ".msg" ||? extension ==? ".srv")
  
  {-
  -- |Returns 'True' if the ROS package at the given 'FilePath' is a
  -- roshask package (determined by the presence of a @.cabal@ file in
  -- the package's root directory).
  isRoshask :: FilePath -> IO Bool
  isRoshask pkgPath = not . null . filter ((== ".cabal") . takeExtension) <$>
                      getDirectoryContents pkgPath
  -}
  
  -- |Find the names of the ROS packages the package at the given
  -- 'FilePath' depends on as indicated by its @manifest.xml@ file. Only
  -- those packages that define messages or services are returned.
  findDepsWithMessages :: FilePath -> IO [String]
  findDepsWithMessages pkgRoot =
    do names <- findPackageDepNames pkgRoot
       searchPaths <- getRosPaths
       filterM (maybe (return False) hasMsgsOrSrvs . 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
  -- directory.
  findPackageDeps :: FilePath -> IO [FilePath]
  findPackageDeps pkgRoot =
      do pkgs <- findPackageDepNames pkgRoot
         searchPaths <- getRosPaths
         let pkgPaths = map (findPackagePath searchPaths) pkgs
         putStrLn $ "Looking for " ++ show pkgs ++ ", dependencies of" ++ pkgRoot
         noticeNotFound (zip pkgPaths pkgs)
         return $ catMaybes pkgPaths
  
  -- |Notify end-user when packages or deps are not found.
  noticeNotFound :: [(Maybe FilePath, String)] -> IO ()
  noticeNotFound pkgs =
      case dropWhile (isJust . fst) pkgs of
          [] -> return ()
          (x : xs) -> do
              notice (snd x)
              noticeNotFound xs
    where notice = putStrLn . ("Couldn't find path to package " ++)
  
  -- |Transitive closure of 'findPackageDeps'. Find the paths to the
  -- packages this package depends on as indicated by the manifest.xml
  -- file in this package's root directories and the manifests in the
  -- root directories of the dependencies, and so on.
  findPackageDepsTrans :: FilePath -> IO [FilePath]
  findPackageDepsTrans pkgRoot =
    -- searchPaths is a list of all directories on the ROS package path that have
    -- either a manifest.xml(rosbuild), or a package.xml(new replacement for manifest.xml)
    do searchPaths <- getRosPaths
       let getDeps pkg =
             do pkgDeps <- findPackageDepNames pkg
                let pkgPaths = map (findPackagePath searchPaths) pkgDeps
                putStrLn $ "Looking for " ++ show pkg ++ ", dependencies of" ++ pkgRoot
                noticeNotFound (zip pkgPaths pkgDeps)
                return $ catMaybes pkgPaths
           recurse p = do deps <- getDeps p
                          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 pkgRoot =
    do e <- doesDirectoryExist dir
       if e then F.find (depth <? 1) (extension ==? ".msg") dir else return []
    where dir = pkgRoot </> "msg"
  
  --TODO: refactor with findMessages
  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"
  
  -- |Find all message definition files in a ROS package. Returns the
  -- 'FilePath' to the package, and the 'FilePath' to each message
  -- definition in the package.
  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
  
  -- |Find the path to the message definition (.msg) file for a message
  -- type with the given name. The first argument is a home package used
  -- to resolve unqualified message names. The second argument is the
  -- name of the message type either in the form "pkgName/typeName" or
  -- "typeName". The specified package will be searched for using the
  -- search paths indicated in the current environment (ROS_PACKAGE_PATH
  -- and ROS_ROOT).
  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
  