diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Alexander Krupenkin (c) 2016 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,29 @@ +module Main (main) where + +import System.Environment (getArgs) +import Data.Text (pack, unpack) +import Robotics.ROS.Pkg + +main :: IO () +main = do + args <- getArgs + let arg1 = args !! 1 + case take 1 args of + ["list"] -> do + pkgs <- packageList + mapM_ (\p -> putStrLn (unpack (pkgName (meta p)) ++ " " ++ path p)) pkgs + ["find"] -> do + pkg <- package (pack arg1) + case pkg of + Just p -> putStrLn (path p) + Nothing -> putStrLn $ "Error: package '" ++ arg1 ++ "' not found" + ["deps"] -> do + pkg <- package (pack arg1) + case pkg of + Just p -> do + putStrLn "Build depend:" + print (pkgBuildDeps (meta p)) + putStrLn "Run depend:" + print (pkgRunDeps (meta p)) + Nothing -> putStrLn $ "Error: package '" ++ arg1 ++ "' not found" + _ -> putStrLn "USAGE: rospkg ( | [package] | [package])" diff --git a/rospkg.cabal b/rospkg.cabal new file mode 100644 --- /dev/null +++ b/rospkg.cabal @@ -0,0 +1,53 @@ +name: rospkg +version: 0.2.2.0 +synopsis: ROS package system information +description: Please see README.md +homepage: https://github.com/RobiticsHS/rospkg#readme +license: BSD3 +license-file: LICENSE +author: Alexander Krupenkin +maintainer: mail@akru.me +copyright: (c) 2016 Alexander Krupenkin +category: Robotics +build-type: Simple +cabal-version: >=1.10 + +executable rospkg + hs-source-dirs: app + main-is: Main.hs + build-depends: base, text, rospkg + default-language: Haskell2010 + ghc-options: -threaded -rtsopts -with-rtsopts=-N + +library + hs-source-dirs: src + exposed-modules: Robotics.ROS.Pkg + , Robotics.ROS.Pkg.Parser + build-depends: base >= 4.7 && < 5 + , text >= 1.2 && < 2 + , split >= 0.2 && < 1 + , async >= 2.1 && < 3 + , tagsoup >= 0.13 && < 1 + , filepath >= 1.4 && < 2 + , directory >= 1.2 && < 2 + , bytestring >= 0.10 && < 1 + , fast-tagsoup >= 1.0 && < 2 + other-modules: Robotics.ROS.Pkg.Finder + , Robotics.ROS.Pkg.Types + , Robotics.ROS.Pkg.Msgs + default-language: Haskell2010 + ghc-options: -Wall + default-extensions: OverloadedStrings + +test-suite rospkg-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , rospkg + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/RoboticsHS/rospkg diff --git a/src/Robotics/ROS/Pkg.hs b/src/Robotics/ROS/Pkg.hs new file mode 100644 --- /dev/null +++ b/src/Robotics/ROS/Pkg.hs @@ -0,0 +1,38 @@ +-- | +-- Module : Robotics.ROS.Pkg +-- Copyright : Alexander Krupenkin 2016 +-- License : BSD3 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : POSIX / WIN32 +-- +-- The Robot Operating System (ROS) is a set of software libraries and tools +-- that help you build robot applications. From drivers to state-of-the-art +-- algorithms, and with powerful developer tools, ROS has what you need for +-- your next robotics project. And it's all open source. +-- +-- Packages are the main unit for organizing software in ROS. A package may +-- contain ROS runtime processes (nodes), a ROS-dependent library, datasets, +-- configuration files, or anything else that is usefully organized together. +-- Packages are the most atomic build item and release item in ROS. Meaning +-- that the most granular thing you can build and release is a package. +-- +-- This package provide utility and library for fast search ROS packages, +-- collect information from @package.xml@ files and some additional power, +-- e.g. message files finder. +-- +module Robotics.ROS.Pkg ( + -- * Package search + module Robotics.ROS.Pkg.Finder + -- * Messages search + , module Robotics.ROS.Pkg.Msgs + -- * Package info types + , PackageMeta(..) + , Package(..) + , PkgName + ) where + +import Robotics.ROS.Pkg.Finder +import Robotics.ROS.Pkg.Types +import Robotics.ROS.Pkg.Msgs diff --git a/src/Robotics/ROS/Pkg/Finder.hs b/src/Robotics/ROS/Pkg/Finder.hs new file mode 100644 --- /dev/null +++ b/src/Robotics/ROS/Pkg/Finder.hs @@ -0,0 +1,49 @@ +-- | +-- Module : Robotics.ROS.Pkg.Finder +-- Copyright : Alexander Krupenkin 2016 +-- License : BSD3 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : POSIX / WIN32 +-- +-- Any ROS package contains @package.xml@ file. It used for package +-- detection and package information collection. This package contains +-- simple parser for @package.xml@ file and recursive file search +-- procedure. +-- +module Robotics.ROS.Pkg.Finder ( + -- ** Single package request + package + -- ** All-in-one request + , packageList + ) where + +import Control.Concurrent.Async (mapConcurrently) +import System.Directory (getDirectoryContents) +import System.Environment (getEnv) +import System.FilePath (joinPath) +import Data.List.Split (splitOn) +import Data.Maybe (listToMaybe) +import Data.Either (rights) +import Data.Text (unpack) + +import Robotics.ROS.Pkg.Parser +import Robotics.ROS.Pkg.Types + +-- | Take a package by name +package :: PkgName -> IO (Maybe Package) +package name = listToMaybe <$> find (const (return [unpack name])) + +-- | Take a full package list +packageList :: IO [Package] +packageList = find getDirectoryContents + +-- | Take a package list with content getter +find :: (FilePath -> IO [FilePath]) -> IO [Package] +find content = do + paths <- splitOn ":" <$> getEnv "ROS_PACKAGE_PATH" + concat <$> mapM go paths + where package_xml b d = joinPath [b, d, "package.xml"] + go d = do candidates <- fmap (package_xml d) <$> content d + rights <$> mapConcurrently parse candidates diff --git a/src/Robotics/ROS/Pkg/Msgs.hs b/src/Robotics/ROS/Pkg/Msgs.hs new file mode 100644 --- /dev/null +++ b/src/Robotics/ROS/Pkg/Msgs.hs @@ -0,0 +1,49 @@ +-- | +-- Module : Robotics.ROS.Pkg.Msgs +-- Copyright : Alexander Krupenkin 2016 +-- License : BSD3 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : POSIX / WIN32 +-- +-- ROS messages placed on "msg" directory in package root. This +-- package contains its directory observer for given package. +-- +module Robotics.ROS.Pkg.Msgs ( + -- ** Single package request + pkgMessages + -- ** All-in-one request + , messageList + ) where + +import System.FilePath (takeExtension, joinPath) +import System.Directory (doesDirectoryExist, + getDirectoryContents) + +import Robotics.ROS.Pkg.Finder +import Robotics.ROS.Pkg.Types + +-- | Take message files of given package +pkgMessages :: Package -> IO [FilePath] +pkgMessages pkg = do + msgDirExist <- doesDirectoryExist msgDir + if msgDirExist + then do msgFiles <- getDirectoryContents msgDir + return $ filter ((== ".msg") . takeExtension) msgFiles + else return [] + where msgDir = joinPath [path pkg, "msg"] + +-- | Search message files for all packages. +-- +-- Like to +-- +-- @ +-- packageList >>= mapM pkgMessages +-- @ +-- +messageList :: IO [(Package, [FilePath])] +messageList = do + pkgs <- packageList + msgs <- mapM pkgMessages pkgs + return (zip pkgs msgs) diff --git a/src/Robotics/ROS/Pkg/Parser.hs b/src/Robotics/ROS/Pkg/Parser.hs new file mode 100644 --- /dev/null +++ b/src/Robotics/ROS/Pkg/Parser.hs @@ -0,0 +1,62 @@ +-- | +-- Module : Robotics.ROS.Pkg.Parser +-- Copyright : Alexander Krupenkin 2016 +-- License : BSD3 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : POSIX / WIN32 +-- +-- This module contains simple 'TagSoup' based XML parser. +-- It used for parsing @package.xml@ file with common +-- ROS package information. +-- +module Robotics.ROS.Pkg.Parser (parse) where + +import Data.ByteString as BS (readFile) +import System.Directory (doesFileExist) +import System.FilePath (takeDirectory) +import Text.HTML.TagSoup.Fast +import Text.HTML.TagSoup +import Data.Text (Text) +import Text.StringLike + +import Robotics.ROS.Pkg.Types + +-- | Parse package.xml file +parse :: FilePath -> IO (Either String Package) +parse pkgFile = do + exist <- doesFileExist pkgFile + if not exist + then return (Left $ "No such file: " ++ pkgFile) + else do content <- parseTagsT <$> BS.readFile pkgFile + return (Package pkgDir <$> packageMeta content) + where pkgDir = takeDirectory pkgFile + +-- | Tag-based parser +packageMeta :: [Tag Text] -> Either String PackageMeta +packageMeta tags = + PackageMeta <$> takeText "name" + <*> takeText "version" + <*> takeText "description" + <*> takeText "license" + <*> takeTexts "build_depend" + <*> takeTexts "run_depend" + where takeText = fmap innerText . slice1 + takeTexts = fmap (fmap innerText) . sliceN tags + slice1 = fmap snd . slice' tags + sliceN t n = case slice' t n of + Left _ -> return [] + Right (xs, r) -> do + r' <- sliceN xs n + return (r : r') + +-- | Slice tags from Open-tag to Close-tag with same name +slice' :: StringLike a => [Tag a] -> a -> Either String ([Tag a], [Tag a]) +slice' tags tagName | length sliceTags > 0 = Right (freeTags, sliceTags) + | otherwise = Left $ "Not found tag name: " + ++ toString tagName + where sliceTags = takeTags (dropTags tags) + freeTags = drop (length sliceTags) (dropTags tags) + dropTags = dropWhile (not . isTagOpenName tagName) + takeTags = takeWhile (not . isTagCloseName tagName) diff --git a/src/Robotics/ROS/Pkg/Types.hs b/src/Robotics/ROS/Pkg/Types.hs new file mode 100644 --- /dev/null +++ b/src/Robotics/ROS/Pkg/Types.hs @@ -0,0 +1,33 @@ +-- | +-- Module : Robotics.ROS.Pkg.Types +-- Copyright : Alexander Krupenkin 2016 +-- License : BSD3 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : POSIX / WIN32 +-- +-- This module contains common used types. +-- +module Robotics.ROS.Pkg.Types where + +import Data.Text (Text) + +-- | ROS package information +data Package = Package + { path :: FilePath -- ^ Package absolute path + , meta :: PackageMeta -- ^ Package meta information + } deriving (Show, Eq, Ord) + +-- | Package name type +type PkgName = Text + +-- | Common used package information +data PackageMeta = PackageMeta + { pkgName :: PkgName -- ^ Name + , pkgVersion :: Text -- ^ Version + , pkgDescription :: Text -- ^ Description + , pkgLicense :: Text -- ^ License + , pkgBuildDeps :: [PkgName] -- ^ List of build dependencies + , pkgRunDeps :: [PkgName] -- ^ List of run dependencies + } deriving (Show, Eq, Ord) diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Test suite not yet implemented"