Permalink
Browse files

Address all compiler warnings.

  • Loading branch information...
1 parent 3d5df65 commit aa521a6ef08a26a566411ce9f638f2e114ce8e15 @acowley committed Feb 5, 2013
Showing with 150 additions and 148 deletions.
  1. +5 −4 roshask.cabal
  2. 0 { → src}/Ros/BinaryIter.hs
  3. 0 { → src}/Ros/ConnectionHeader.hs
  4. 0 { → src}/Ros/Core/Build/DepFinder.hs
  5. 0 { → src}/Ros/Core/Build/Init.hs
  6. 0 { → src}/Ros/Core/Build/SetupUtil.hs
  7. 0 { → src}/Ros/Core/Header.hs
  8. +7 −7 { → src}/Ros/Core/Log.hs
  9. 0 { → src}/Ros/Core/Msg/Analysis.hs
  10. 0 { → src}/Ros/Core/Msg/FieldImports.hs
  11. 0 { → src}/Ros/Core/Msg/Gen.hs
  12. 0 { → src}/Ros/Core/Msg/HeaderSupport.hs
  13. 0 { → src}/Ros/Core/Msg/Instances/Binary.hs
  14. 0 { → src}/Ros/Core/Msg/Instances/NFData.hs
  15. 0 { → src}/Ros/Core/Msg/Instances/Storable.hs
  16. 0 { → src}/Ros/Core/Msg/MD5.hs
  17. 0 { → src}/Ros/Core/Msg/Main.hs
  18. 0 { → src}/Ros/Core/Msg/MsgInfo.hs
  19. 0 { → src}/Ros/Core/Msg/Parse.hs
  20. 0 { → src}/Ros/Core/Msg/PkgBuilder.hs
  21. 0 { → src}/Ros/Core/Msg/ResolutionTypes.hs
  22. 0 { → src}/Ros/Core/Msg/Test.hs
  23. 0 { → src}/Ros/Core/Msg/Types.hs
  24. +1 −1 { → src}/Ros/Core/PathUtil.hs
  25. +2 −4 { → src}/Ros/Core/RosBinary.hs
  26. 0 { → src}/Ros/Core/RosTime.hs
  27. 0 { → src}/Ros/Core/RosTypes.hs
  28. 0 { → src}/Ros/Core/Util/AppConfig.hs
  29. 0 { → src}/Ros/Core/Util/ArgRemapping.hs
  30. 0 { → src}/Ros/Core/Util/BytesToVector.hs
  31. +6 −5 { → src}/Ros/Core/Util/RingChan.hs
  32. 0 { → src}/Ros/Core/Util/StorableMonad.hs
  33. +9 −8 { → src}/Ros/Logging.hs
  34. 0 { → src}/Ros/MasterAPI.hs
  35. +16 −16 { → src}/Ros/Node.hs
  36. +4 −4 { → src}/Ros/NodeType.hs
  37. 0 { → src}/Ros/ParameterServerAPI.hs
  38. 0 { → src}/Ros/Rate.hs
  39. +7 −8 { → src}/Ros/RosTcp.hs
  40. +5 −6 { → src}/Ros/RunNode.hs
  41. +17 −14 { → src}/Ros/SlaveAPI.hs
  42. +10 −10 { → src}/Ros/Topic.hs
  43. 0 { → src}/Ros/TopicMT.hs
  44. 0 { → src}/Ros/TopicPID.hs
  45. +5 −5 { → src}/Ros/TopicStamped.hs
  46. 0 { → src}/Ros/TopicStats.hs
  47. +52 −52 { → src}/Ros/TopicUtil.hs
  48. +4 −4 { → src}/Ros/Util/PID.hs
View
@@ -1,5 +1,5 @@
Name: roshask
-Version: 0.1.0
+Version: 0.1.1
Synopsis: Haskell support for the ROS robotics framework.
License: BSD3
License-file: LICENSE
@@ -108,6 +108,7 @@ Library
BoundedChan >= 1.0.0.2,
parsec >= 3.1,
process >= 1.0.1.3,
+ SafeSemaphore,
snap-core >= 0.9,
snap-server >= 0.9,
storable-tuple >= 0.0.2,
@@ -121,8 +122,8 @@ Library
Build-depends: unix
- GHC-Options: -Odph -Wall -fno-warn-name-shadowing -fno-warn-duplicate-exports
- Hs-Source-Dirs: .
+ GHC-Options: -O2 -Wall
+ Hs-Source-Dirs: src
-- Modules not exported by this package.
Other-modules: Ros.MasterAPI Ros.SlaveAPI Ros.ParameterServerAPI
@@ -156,4 +157,4 @@ Executable roshask
Ros.Core.Msg.Instances.Binary Ros.Core.Msg.Instances.Storable
Ros.Core.Msg.FieldImports Ros.Core.Msg.Instances.NFData
Ros.Core.PathUtil Paths_roshask
- Hs-Source-Dirs: .
+ Hs-Source-Dirs: src
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
@@ -10,14 +10,14 @@ import Ros.Core.Msg.HeaderSupport
import qualified Data.Word as Word
import qualified Ros.Core.Header as Header
-data Log = Log { header :: Header.Header
- , level :: Word.Word8
- , name :: P.String
- , msg :: P.String
- , file :: P.String
+data Log = Log { header :: Header.Header
+ , level :: Word.Word8
+ , name :: P.String
+ , msg :: P.String
+ , file :: P.String
, function :: P.String
- , line :: Word.Word32
- , topics :: [P.String]
+ , line :: Word.Word32
+ , topics :: [P.String]
} deriving (P.Show, P.Eq, P.Ord, T.Typeable)
instance RosBinary Log where
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
@@ -42,6 +42,6 @@ codeGenDir f = do s <- stackName f
r <- getDataDir
let base = case s of
Nothing -> r
- Just s -> r </> s
+ Just s' -> r </> s'
return $ base </> pkg </> "Ros" </> pkg
where pkg = pathToPkgName f
@@ -1,8 +1,6 @@
{-# LANGUAGE ScopedTypeVariables, TypeSynonymInstances, FlexibleInstances #-}
--- |Binary serialization deserialization utilities for types used in
--- ROS messages. This module is used by generated code for .msg
--- types.
-
+-- |Binary serialization/deserialization utilities for types used in
+-- ROS messages. This module is used by generated code for .msg types.
-- NOTE: The native byte ordering of the host is used to support the
-- common scenario of same-machine transport.
module Ros.Core.RosBinary where
File renamed without changes.
File renamed without changes.
File renamed without changes.
@@ -2,7 +2,8 @@ module Ros.Core.Util.RingChan (RingChan, newRingChan, writeChan,
readChan, getChanContents, getBuffered) where
import Control.Monad (join)
import Control.Concurrent.MVar
-import Control.Concurrent.QSem
+import Control.Concurrent.SSem (SSem)
+import qualified Control.Concurrent.SSem as Sem
import qualified Data.Foldable as F
import Data.Sequence (Seq, (|>), viewl, ViewL(..))
import qualified Data.Sequence as Seq
@@ -17,11 +18,11 @@ import System.IO.Unsafe (unsafeInterleaveIO)
-- |A 'RingChan' is an 'MVar' containing a triple of maximum capacity, a
-- semaphore used to indicate that the chan has gone from empty to
-- non-empty, and a sequence of items.
-type RingChan a = (Int, QSem, MVar (Seq a))
+type RingChan a = (Int, SSem, MVar (Seq a))
-- |Create a 'RingChan' with the specified maximum capacity.
newRingChan :: Int -> IO (RingChan a)
-newRingChan n = do sem <- newQSem 0
+newRingChan n = do sem <- Sem.new 0
q <- newMVar Seq.empty
return (n,sem,q)
@@ -30,14 +31,14 @@ newRingChan n = do sem <- newQSem 0
writeChan :: RingChan a -> a -> IO ()
writeChan (n,sem,mv) x =
join $ modifyMVar mv (\q -> if Seq.length q < n
- then return (q |> x, signalQSem sem)
+ then return (q |> x, Sem.signal sem)
else let _ :< t = viewl q
in return (t |> x, return ()))
-- else return (q, return ()))
-- |Read an item from the channel. Blocks until an item is available.
readChan :: RingChan a -> IO a
-readChan (_,sem,mv) = do waitQSem sem
+readChan (_,sem,mv) = do Sem.wait sem
modifyMVar mv (\q -> let h :< t = viewl q
in return (t,h))
@@ -9,7 +9,8 @@ import Control.Monad (when)
import Data.IORef
import System.IO.Unsafe
import Data.Word (Word8)
-import Ros.Core.Log
+import Ros.Core.Log (Log(Log))
+import qualified Ros.Core.Log as Log
import Ros.Core.Header
import Ros.Node
import Ros.TopicUtil (fromList)
@@ -31,11 +32,11 @@ mkLogMsg level msg = do Loc fname _ _ start _ <- location
--
-- > $(logDebug "This is my message to you")
logDebug, logWarn, logInfo, logError, logFatal :: String -> Q Exp
-logDebug = mkLogMsg dEBUG
-logInfo = mkLogMsg iNFO
-logWarn = mkLogMsg wARN
-logError = mkLogMsg eRROR
-logFatal = mkLogMsg fATAL
+logDebug = mkLogMsg Log.dEBUG
+logInfo = mkLogMsg Log.iNFO
+logWarn = mkLogMsg Log.wARN
+logError = mkLogMsg Log.eRROR
+logFatal = mkLogMsg Log.fATAL
-- The 'Chan' into which all log messages are funneled. This Chan's
-- contents are fed into the /rosout 'Topic'.
@@ -58,15 +59,15 @@ nodeName = unsafePerformIO $ newIORef ""
-- Publish a log message.
sendMsg :: Log -> IO ()
sendMsg msg = do n <- readIORef nodeName
- let msg' = msg { name = n }
+ let msg' = msg { Log.name = n }
($ msg') =<< readIORef showLevel
writeChan rosOutChan msg'
-- Prints messages whose level is greater than or equal to the
-- specified level.
printLog :: LogLevel -> Log -> IO ()
printLog lvl = let code = 2 ^ fromEnum lvl
- in \msg -> when (level msg >= code) (putStrLn (show msg))
+ in \msg -> when (Log.level msg >= code) (putStrLn (show msg))
-- |Log message levels. These allow for simple filtering of messages.
data LogLevel = Debug | Info | Warn | Error | Fatal deriving (Eq, Enum)
File renamed without changes.
@@ -129,14 +129,14 @@ advertise :: (RosBinary a, MsgInfo a, Typeable a) =>
TopicName -> Topic IO a -> Node ()
advertise = advertiseBuffered 1
--- |Existentially quantified message type that roshask can
--- serialize. This type provides a way to work with collections of
--- differently typed 'Topic's.
-data SomeMsg = forall a. (RosBinary a, MsgInfo a, Typeable a) => SomeMsg a
+-- -- |Existentially quantified message type that roshask can
+-- -- serialize. This type provides a way to work with collections of
+-- -- differently typed 'Topic's.
+-- data SomeMsg = forall a. (RosBinary a, MsgInfo a, Typeable a) => SomeMsg a
--- |Advertise projections of a 'Topic' as discrete 'Topic's.
-advertiseSplit :: [(TopicName, a -> SomeMsg)] -> Topic IO a -> Node ()
-advertiseSplit = undefined
+-- -- |Advertise projections of a 'Topic' as discrete 'Topic's.
+-- advertiseSplit :: [(TopicName, a -> SomeMsg)] -> Topic IO a -> Node ()
+-- advertiseSplit = undefined
-- |Get an action that will shutdown this Node.
getShutdownAction :: Node (IO ())
@@ -193,27 +193,27 @@ getNamespace = namespace <$> get
-- |Run a ROS Node.
runNode :: NodeName -> Node a -> IO ()
-runNode name (Node n) =
+runNode name (Node nConf) =
do myURI <- newEmptyMVar
sigStop <- newEmptyMVar
env <- liftIO getEnvironment
(conf, args) <- parseAppConfig <$> liftIO getArgs
let getConfig' var def = maybe def id $ lookup var env
getConfig = flip lookup env
- master = getConfig' "ROS_MASTER_URI" "http://localhost:11311"
- namespace = let ns = getConfig' "ROS_NAMESPACE" "/"
- in if last ns == '/' then ns else ns ++ "/"
+ masterConf = getConfig' "ROS_MASTER_URI" "http://localhost:11311"
+ namespaceConf = let ns = getConfig' "ROS_NAMESPACE" "/"
+ in if last ns == '/' then ns else ns ++ "/"
(nameMap, params) = parseRemappings args
name' = case lookup "__name" params of
Just x -> fromParam x
Nothing -> case name of
'/':_ -> name
- _ -> namespace ++ name
+ _ -> namespaceConf ++ name
-- Name remappings apply to exact strings and resolved names.
resolve p@(('/':_),_) = [p]
resolve (('_':n),v) = [(name'++"/"++n, v)]
resolve (('~':n),v) = [(name'++"/"++ n, v)] --, ('_':n,v)]
- resolve (n,v) = [(namespace ++ n,v), (n,v)]
+ resolve (n,v) = [(namespaceConf ++ n,v), (n,v)]
nameMap' = concatMap resolve nameMap
params' = concatMap resolve params
when (not $ null nameMap')
@@ -225,8 +225,8 @@ runNode name (Node n) =
Nothing -> return ()
Just n -> putMVar myURI $! "http://"++n
Just ip -> putMVar myURI $! "http://"++ip
- let configuredNode = runReaderT n (NodeConfig params' nameMap' conf)
- initialState = NodeState name' namespace master myURI sigStop
- M.empty M.empty
+ let configuredNode = runReaderT nConf (NodeConfig params' nameMap' conf)
+ initialState = NodeState name' namespaceConf masterConf myURI
+ sigStop M.empty M.empty
statefulNode = execStateT configuredNode initialState
statefulNode >>= flip runReaderT conf . RN.runNode name'
@@ -83,11 +83,11 @@ instance RosSlave NodeState where
Nothing -> return (return ())
Just sub -> do let add = addPub sub >=> \_ -> return ()
known <- readTVar (knownPubs sub)
- (act,known') <- foldM (connectToPub add)
- (return (), known)
- uris
+ (act',known') <- foldM (connectToPub add)
+ (return (), known)
+ uris
writeTVar (knownPubs sub) known'
- return act
+ return act'
in act
getTopicPortTCP = ((pubPort <$> ) .) . flip M.lookup . publications
setShutdownAction ns a = putMVar (signalShutdown ns) a
File renamed without changes.
File renamed without changes.
@@ -1,6 +1,5 @@
{-# LANGUAGE ScopedTypeVariables, BangPatterns #-}
-module Ros.RosTcp (subStream, runServer) where
-import Prelude hiding (catch)
+module Ros.RosTcp (subStream, runServer, runServers) where
import Control.Applicative ((<$>))
import Control.Arrow (first)
import Control.Concurrent (forkIO, killThread, newEmptyMVar, takeMVar, putMVar)
@@ -40,7 +39,7 @@ serviceClient c s = forever $ do bs <- readChan c
sendMany s (BL.toChunks (BL.append len bs))
recvAll :: Socket -> Int -> IO B.ByteString
-recvAll s len = go len []
+recvAll s = flip go []
where go len acc = do bs <- recv s len
if B.length bs < len
then go (len - B.length bs) (bs:acc)
@@ -103,7 +102,7 @@ acceptClients sock clients negotiate mkBuffer = forever acceptClient
-- |Publish each item obtained from a 'Topic' to each connected client.
pubStream :: RosBinary a => Topic IO a -> TVar [(b, RingChan ByteString)] -> Config ()
-pubStream t clients = liftIO $ go 0 t
+pubStream t0 clients = liftIO $ go 0 t0
where go !n t = do (x, t') <- runTopic t
let bytes = runPut $ putMsg n x
cs <- readTVarIO clients
@@ -173,7 +172,7 @@ subStream target tname _updateStats =
return $ streamIn h
where host = case parseURI target of
Just u -> case uriRegName u of
- Just host -> host
+ Just host' -> host'
Nothing -> error $ "Couldn't parse hostname "++
"from "++target
Nothing -> error $ "Couldn't parse URI "++target
@@ -222,7 +221,7 @@ runServer stream = runServerAux (mkPubNegotiator (undefined::a))
-- |The 'MsgInfo' type class dictionary made explicit to strip off the
-- actual message type.
-data MsgInfoRcd = MsgInfoRcd { md5, typeName :: String }
+data MsgInfoRcd = MsgInfoRcd { _md5, _typeName :: String }
-- |A 'Feeder' represents a 'Topic' fully prepared to accept
-- subscribers.
@@ -251,6 +250,6 @@ feedTopic updateStats bufSize =
-- the input 'Feeder's.
runServers :: [Feeder] -> Config (Config (), [Int])
runServers = return . first sequence_ . unzip <=< mapM feed
- where feed (Feeder info bufSize stats push) =
- let pub = negotiatePub (typeName info) (md5 info)
+ where feed (Feeder (MsgInfoRcd md5 typeName) bufSize stats push) =
+ let pub = negotiatePub typeName md5
in runServerAux pub push stats bufSize
@@ -1,7 +1,6 @@
module Ros.RunNode (runNode) where
-import Prelude hiding (catch)
import Control.Concurrent (readMVar,forkIO, killThread)
-import Control.Concurrent.QSem (newQSem, signalQSem, waitQSem)
+import qualified Control.Concurrent.SSem as Sem
import Control.Exception (catch, SomeException)
import Control.Monad.IO.Class
import System.Posix.Signals (installHandler, Handler(..), sigINT)
@@ -49,14 +48,14 @@ runNode :: RosSlave s => String -> s -> Config ()
runNode name s = do (wait, _port) <- liftIO $ runSlave s
registerNode name s
debug "Spinning"
- allDone <- liftIO $ newQSem 0
+ allDone <- liftIO $ Sem.new 0
let ignoreEx :: SomeException -> IO ()
ignoreEx _ = return ()
shutdown = do putStrLn "Shutting down"
cleanupNode s `catch` ignoreEx
- signalQSem allDone
+ Sem.signal allDone
liftIO $ setShutdownAction s shutdown
_ <- liftIO $ installHandler sigINT (CatchOnce shutdown) Nothing
- t <- liftIO . forkIO $ wait >> signalQSem allDone
- liftIO $ waitQSem allDone
+ t <- liftIO . forkIO $ wait >> Sem.signal allDone
+ liftIO $ Sem.wait allDone
liftIO $ killThread t `catch` ignoreEx
Oops, something went wrong. Retry.

0 comments on commit aa521a6

Please sign in to comment.