Skip to content
Browse files

Add an unregister roshask sub-command.

This command calls ghc-pkg unregister on every package whose name
begins "ROS-" after confirming the user's intent. This is helpful when
upgrading roshask.

Reinstated manual option parsing and help text.
  • Loading branch information...
1 parent 6a36e7f commit a943c2a779f283febbfc878b10420a7b9725e5cc Anthony Cowley committed
Showing with 67 additions and 77 deletions.
  1. +1 −1 roshask.cabal
  2. +28 −76 src/Ros/Core/Msg/Main.hs
  3. +38 −0 src/Ros/Core/Msg/Unregister.hs
View
2 roshask.cabal
@@ -158,5 +158,5 @@ Executable roshask
Ros.Core.Build.Init Ros.Core.Build.SetupUtil
Ros.Core.Msg.Instances.Binary Ros.Core.Msg.Instances.Storable
Ros.Core.Msg.FieldImports Ros.Core.Msg.Instances.NFData
- Ros.Core.PathUtil Paths_roshask
+ Ros.Core.Msg.Unregister Ros.Core.PathUtil Paths_roshask
Hs-Source-Dirs: src
View
104 src/Ros/Core/Msg/Main.hs
@@ -1,15 +1,12 @@
-- |The main entry point for the roshask executable.
module Main (main) where
import Control.Applicative
-import Control.Monad ((>=>), join)
import qualified Data.ByteString.Char8 as B
-import Options.Applicative
-import System.Directory (createDirectoryIfMissing, getCurrentDirectory,
- getDirectoryContents)
+import System.Directory (createDirectoryIfMissing, getCurrentDirectory)
import System.Environment (getArgs)
import System.Exit (exitWith, ExitCode(..))
import System.FilePath (replaceExtension, isRelative, (</>), dropFileName,
- takeFileName, dropExtension, takeExtension)
+ takeFileName)
import Ros.Core.Msg.Analysis (runAnalysis)
import Ros.Core.Msg.Parse
import Ros.Core.Msg.Gen
@@ -19,14 +16,7 @@ import Ros.Core.Msg.Unregister
import Ros.Core.Build.DepFinder (findMessages, findPackageDeps,
findPackageDepsTrans)
import Ros.Core.Build.Init (initPkg)
-import Ros.Core.PathUtil (cap, codeGenDir, pathToPkgName)
-
--- Get a list of all messages defined in a directory.
--- pkgMessages :: FilePath -> IO [FilePath]
--- pkgMessages = fmap (map (cap . dropExtension) .
--- filter ((== ".msg") . takeExtension)) .
--- getDirectoryContents
-pkgMessages = findMessages
+import Ros.Core.PathUtil (codeGenDir, pathToPkgName)
generateAndSave :: FilePath -> IO ()
generateAndSave fname = do msgType <- fst <$> generate fname
@@ -36,12 +26,12 @@ generateAndSave fname = do msgType <- fst <$> generate fname
createDirectoryIfMissing True d'
return $ d' </> f
f = replaceExtension (takeFileName fname) ".hs"
- -- d' = d </> "haskell" </> "Ros" </> pkgName
+-- Generate Haskell code for a message type.
generate :: FilePath -> IO (B.ByteString, String)
generate fname =
do r <- parseMsg fname
- pkgMsgs <- map B.pack <$> pkgMessages dir
+ pkgMsgs <- map B.pack <$> findMessages dir
case r of
Left err -> do putStrLn $ "ERROR: " ++ err
exitWith (ExitFailure (-2))
@@ -58,13 +48,15 @@ generate fname =
buildDepMsgs :: [FilePath] -> IO ()
buildDepMsgs = runAnalysis . mapM_ buildPkgMsgs
+-- When given a relative path, prepend it with the current working
+-- directory.
canonicalizeName :: FilePath -> IO FilePath
canonicalizeName fname = if isRelative fname
then (</> fname) <$> getCurrentDirectory
else return fname
-helP :: [String]
-helP = [ "Usage: roshask command [[arguments]]"
+help :: [String]
+help = [ "Usage: roshask command [[arguments]]"
, "Available commands:"
, " create pkgName [[dependencies]] -- Create a new ROS package with "
, " roshask support"
@@ -80,64 +72,24 @@ helP = [ "Usage: roshask command [[arguments]]"
, " md5 file.msg -- Generate an MD5 sum for a ROS "
, " message type"
, ""
- , " unregister -- Unregister all"
- , " \"ROS-\"-prefixed packages using "
- , " ghc-pkg. This is useful when you "
- , " upgrade roshask and wish to "
- , " remove all previously generated "
- , " message libraries." ]
-
-options :: Parser (IO ())
-options = subparser $
- command "gen" (info genOptions (progDesc genDesc))
- <> command "md5" (info md5Options (progDesc md5Desc))
- <> command "create" (info createOptions (progDesc createDesc))
- <> command "dep" (info depOptions depDesc)
- <> command "unregister" (info unregOptions (progDesc unregDesc))
- where genOptions = (canonicalizeName >=> generateAndSave) <$>
- (helper <*> argument str (metavar "FILE"))
- genDesc = "Generate Haskell message code for the given file.msg"
- md5Options = (canonicalizeName >=> generate >=> putStrLn . snd) <$>
- (helper <*> argument str (metavar "FILE"))
- md5Desc = "Generate an MD5 sum for a ROS message specification"
- createOptions = uncurry initPkg <$>
- (helper <*>
- ((,) <$> argument str (metavar "PACKAGE_NAME")
- <*> arguments str (metavar "dependencies...")))
- createDesc = "Create a new ROS package with roshask support"
- depOptions = depAux <$>
- (helper <*> argument str (metavar "[PACKAGE_DIRECTORY]"))
- depAux "" = do d <- getCurrentDirectory
- findPackageDepsTrans d >>= buildDepMsgs . (++[d])
- depAux d = findPackageDeps d >>= (buildDepMsgs . (++[d]))
- depDesc = progDesc $ unlines
- [ "Build all messages the specified package depends on."
- , "If no argument is given, all messages the package in"
- , "the current directory depends on are built." ]
- unregOptions = helper <*> pure unregisterInteractive
- unregDesc = "Unregister all \"ROS-\"-prefixed packages known to "++
- "ghc-pkg. This is useful when you upgrade roshask, and "++
- "wish to remove all previously generated message libraries."
+ , " unregister -- Unregister all \"ROS-\"-prefixed"
+ , " packages using ghc-pkg. This is"
+ , " useful when you upgrade roshask"
+ , " and wish to remove all "
+ , " previously generated message"
+ , " libraries." ]
main :: IO ()
-main = join . execParser $
- info (helper <*> options)
- (fullDesc <>
- (progDesc $ "The roshask build tool can help with "++
- "initializating new ROS packages, and generating "++
- "Haskell implementations of ROS message "++
- "specifications (.msg files)."))
-
--- main = do args <- getArgs
--- case args of
--- ["gen",name] -> canonicalizeName name >>= generateAndSave
--- ["md5",name] -> canonicalizeName name >>=
--- generate >>= putStrLn . snd
--- ("create":pkgName:deps) -> initPkg pkgName deps
--- ["unregister"] -> unregisterInteractive
--- ["dep"] -> do d <- getCurrentDirectory
--- deps <- findPackageDepsTrans d
--- buildDepMsgs (deps++[d])
--- ["dep",name] -> findPackageDeps name >>= (buildDepMsgs . (++[name]))
--- _ -> do mapM_ putStrLn helP
--- exitWith (ExitFailure (-1))
+main = do args <- getArgs
+ case args of
+ ["gen",name] -> canonicalizeName name >>= generateAndSave
+ ["md5",name] -> canonicalizeName name >>=
+ generate >>= putStrLn . snd
+ ("create":pkgName:deps) -> initPkg pkgName deps
+ ["unregister"] -> unregisterInteractive
+ ["dep"] -> do d <- getCurrentDirectory
+ deps <- findPackageDepsTrans d
+ buildDepMsgs (deps++[d])
+ ["dep",name] -> findPackageDeps name >>= (buildDepMsgs . (++[name]))
+ _ -> do mapM_ putStrLn help
+ exitWith (ExitFailure (-1))
View
38 src/Ros/Core/Msg/Unregister.hs
@@ -0,0 +1,38 @@
+-- |Helper to unregister all ROS-related packages known by @ghc-pkg@.
+module Ros.Core.Msg.Unregister (unregisterInteractive) where
+import Control.Applicative
+import Data.Char
+import Data.List
+import Data.Maybe
+import System.Exit (ExitCode(..))
+import System.IO (hFlush, stdout)
+import System.Process
+
+findROSPackages :: IO [String]
+findROSPackages = mapMaybe (isROS . dropWhile isSpace) . lines
+ <$> readProcess "ghc-pkg" ["list"] ""
+ where isROS s
+ | "ROS-" `isPrefixOf` s = Just s
+ | otherwise = Nothing
+
+unregisterPackage :: String -> IO ()
+unregisterPackage pkg = rawSystem "ghc-pkg" ["unregister", "--force", pkg]
+ >>= aux
+ where aux ExitSuccess = return ()
+ aux (ExitFailure e) = putStrLn $ "ghc-pkg unregister "++pkg++
+ " failed: exit code "++show e
+
+unregisterInteractive :: IO ()
+unregisterInteractive =
+ do pkgs <- findROSPackages
+ if null pkgs
+ then putStrLn "No ROS packages to remove!"
+ else do putStrLn "Ready to remove the following packags:"
+ mapM_ (putStrLn . (" "++)) pkgs
+ putStr "Are you sure you want to continue (y/n)? "
+ hFlush stdout
+ s <- map toLower <$> getLine
+ if s == "n" || s == "no"
+ then putStrLn "Cancelling unregistration."
+ else mapM_ unregisterPackage pkgs >>
+ putStrLn "Unregistration complete!"

0 comments on commit a943c2a

Please sign in to comment.
Something went wrong with that request. Please try again.