rosmsg-bin (empty) → 0.1.0.0
raw patch · 7 files changed
+299/−0 lines, 7 filesdep +basedep +filepathdep +monad-loggersetup-changed
Dependencies added: base, filepath, monad-logger, rosmsg, rospkg, stack, temporary, text
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- app/genhs/Main.hs +29/−0
- app/genhs/Stack.hs +30/−0
- app/genhs/Template.hs +149/−0
- app/rosmsg/Main.hs +16/−0
- rosmsg-bin.cabal +43/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Alexander Krupenkin <mail@akru.me> (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 Alexander Krupenkin 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/genhs/Main.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE OverloadedStrings, RecordWildCards #-}+module Main (main) where++import System.Environment+import Robotics.ROS.Pkg+import Data.Text (pack)+import System.IO.Temp+import Template+import Stack++main :: IO ()+main = withSystemTempDirectory "genhs" $ \tmpDir -> do+ args <- getArgs+ case args of+ [name] -> do+ putStr $ "Search package `" ++ name ++"`..."+ Just pkg <- package (pack name)+ putStrLn "DONE"++ msgs <- pkgMessages pkg+ putStrLn "Found messages:"+ mapM_ (putStrLn . (" - " ++)) msgs++ template <- newTemplate tmpDir pkg msgs+ putStrLn $ "Template created: " ++ template++ msgPkg <- newPackage tmpDir (pkgName (meta pkg)) template+ putStrLn $ "Package created: " ++ msgPkg+ _ -> putStrLn "USAGE: genhs [PACKAGE_NAME]"
+ app/genhs/Stack.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE FlexibleContexts, OverloadedStrings #-}+module Stack (newPackage) where++import qualified Data.Text as T+import Control.Monad.Logger++import Stack.Types.TemplateName+import Stack.Types.PackageName+import Stack.Types.StackT+import Stack.Types.Config+import Stack.Config+import Stack.New++newPackage :: FilePath -> T.Text -> String -> IO FilePath+newPackage dir name templatePath = do+ case parseTemplateNameFromString templatePath of+ Left e -> error e+ Right template -> do manager <- newTLSManager+ config <- (loadConfigWith manager :: IO Config) + runStackWith manager config $ do+ n <- parsePackageName (sanitize name)+ new (NewOpts n False (Just template) mempty) False + return (T.unpack (sanitize name))+ where+ loadConfigWith m = lcConfig <$>+ runStackLoggingT m logging False False+ (loadConfig mempty Nothing Nothing) + runStackWith m c = runStackT m logging c False False+ logging = LevelDebug+ sanitize = T.replace "_" "-"
+ app/genhs/Template.hs view
@@ -0,0 +1,149 @@+{-# LANGUAGE OverloadedStrings #-}+module Template (newTemplate) where++import Data.Text (Text, unpack, pack,+ toUpper, replace, takeEnd)+import qualified Data.Text as T+import Data.Text.Lazy.IO as TL+import Data.Text.Lazy.Builder+import Data.Maybe (catMaybes)+import Control.Monad (forM)+import System.FilePath+import Data.Monoid++import Robotics.ROS.Msg.Parser+import Robotics.ROS.Msg.Types+import Robotics.ROS.Pkg++newTemplate :: FilePath -> Package -> [FilePath] -> IO FilePath+newTemplate dir pkg msgFiles = do+ deps <- forM msgFiles $ \f -> do+ let msgPath = joinPath [path pkg, "msg", f]+ Done _ msg <- parse rosmsg <$> TL.readFile msgPath + depPkgs <- catMaybes <$> mapM package (pkgBuildDeps (meta pkg))+ deps <- zip depPkgs <$> mapM pkgMessages depPkgs+ return $ concatMap (mkDeps msg) ((pkg, msgFiles) : deps)++ TL.writeFile tFileName $ toLazyText $ tBuilder deps+ return tFileName+ where+ tFileName = joinPath [dir, unpack (pkgName (meta pkg)) ++ ".hsfiles"]+ tBuilder deps = cabalBuilder pkg msgFiles+ <> mconcat (msgBuilder pkg <$> zip msgFiles deps)+ <> stackBuilder pkg++upperFirst :: Text -> Text+upperFirst x = toUpper (T.take 1 x) <> T.drop 1 x++-- List of custom type names in Message+customTypes :: MsgDefinition -> [Text]+customTypes = fmap pkgInTypeHook . catMaybes . fmap go+ where go (Variable (t, _)) = custom t+ go (Constant (t, _) _) = custom t+ custom (Custom t) = Just t+ custom (Array (Custom t)) = Just t+ custom (FixedArray _ (Custom t)) = Just t+ custom _ = Nothing+ pkgInTypeHook = last . T.split (== '/')++-- Associate used in message custom type with package+mkDeps :: MsgDefinition -> (Package, [FilePath]) -> [(Package, FilePath)]+mkDeps msg (pkg, files) = catMaybes (go <$> files)+ where go m | isCustomType m = Just (pkg, m) + | otherwise = Nothing+ messageName = pack . takeWhile (/= '.')+ isCustomType m = messageName m `elem` customTypes msg++cabalBuilder :: Package -> [FilePath] -> Builder+cabalBuilder pkg msgs =+ "{-# START_FILE " <> fromText (sanitize name) <> ".cabal #-}"+ <> "\nname: " <> fromText (sanitize name)+ <> "\nversion: 0.1"+ <> "\nsynopsis: Autogenerated " <> fromText name <> " ROS messages"+ <> "\ndescription: " <> fromText description + <> "\nlicense: BSD3"+ <> "\ncategory: Robotics"+ <> "\nbuild-type: Simple"+ <> "\ncabal-version: >=1.10"+ <> "\n"+ <> "\nlibrary"+ <> "\n hs-source-dirs: src"+ <> "\n default-language: Haskell2010"+ <> "\n build-depends: base >= 4.7 && < 5"+ <> "\n , binary"+ <> "\n , pureMD5"+ <> "\n , bytestring"+ <> "\n , lens-family" + <> "\n , data-default" + <> mconcat (msgBuildDeps <$> pkgBuildDeps (meta pkg))+ <> "\n exposed-modules: "+ <> msgMainModule <> "." <> messageName (head msgs) + <> mconcat (msgModule <$> drop 1 msgs)+ <> "\n\n{-# START_FILE Setup.hs #-}"+ <> "\nimport Distribution.Simple"+ <> "\nmain = defaultMain\n"++ where name = pkgName (meta pkg) + description = replace "\n" "" $ pkgDescription (meta pkg)+ sanitize = replace "_" "-"+ messageName = fromString . takeWhile (/= '.')+ space = " " + msgBuildDeps "message_generation" = "\n" <> space <> ", rosmsg"+ msgBuildDeps dep =+ case takeEnd 4 dep of+ "msgs" -> "\n" <> space <> ", " <> fromText (sanitize dep) + _ -> mempty+ msgMainModule = "Robotics.ROS.Msg." <> fromText (upperFirst name)+ msgModule m = "\n" <> space <> ", " <> msgMainModule <> "."+ <> messageName m++msgBuilder :: Package -> (FilePath, [(Package, FilePath)]) -> Builder+msgBuilder pkg (msgFile, deps) =+ "\n{-# START_FILE src/Robotics/ROS/Msg/" <> packageName pkg+ <> "/"+ <> messageName msgFile+ <> ".hs #-}"+ <> "\n{-# LANGUAGE DataKinds, KindSignatures, DeriveGeneric"+ <> "\n , DeriveDataTypeable, QuasiQuotes, OverloadedStrings #-}"+ <> "\nmodule " <> msgMainModule <> "." <> messageName msgFile <> " where\n"+ <> "\nimport Data.Default (Default(..))"+ <> "\nimport Data.Typeable (Typeable)"+ <> "\nimport GHC.Generics (Generic)"+ <> "\nimport Data.Binary (Binary)"+ <> "\nimport Data.Data (Data)"+ <> "\nimport qualified Data.ByteString as BS"+ <> "\nimport qualified Data.Word as W"+ <> "\nimport qualified Data.Int as I"+ <> "\nimport qualified Prelude as P"+ <> "\n"+ <> mconcat (msgImport <$> deps)+ <> "\n"+ <> "\nimport Robotics.ROS.Msg.TH"+ <> "\nimport Robotics.ROS.Msg"+ <> "\n"+ <> "\n[rosmsgFrom|" <> fromString (joinPath [path pkg, "msg", msgFile])+ <> "|]\n"+ where packageName = fromText . upperFirst . pkgName . meta+ messageName = fromString . takeWhile (/= '.')+ msgMainModule = "Robotics.ROS.Msg." <> packageName pkg+ msgImport (p, m) =+ "\nimport qualified Robotics.ROS.Msg."+ <> packageName p+ <> "."+ <> messageName m+ <> " as "+ <> messageName m++stackBuilder :: Package -> Builder+stackBuilder pkg =+ "\n{-# START_FILE stack.yaml #-}"+ <> "\nresolver: lts-6.16"+ <> "\npackages:"+ <> "\n- '.'"+ <> mconcat ((\p -> "\n- '../" <> fromText (sanitize p) <> "'") <$> deps)+ <> "\nextra-deps:"+ <> "\n- rosmsg-0.5.0.0"+ <> "\nflags: {}"+ <> "\nextra-package-dbs: []"+ where deps = filter (elem "msgs" . T.tails) (pkgBuildDeps (meta pkg)) + sanitize = replace "_" "-"
+ app/rosmsg/Main.hs view
@@ -0,0 +1,16 @@+module Main (main) where++import Robotics.ROS.Pkg (Package(..), PackageMeta(..), messageList)+import System.FilePath (takeBaseName)+import System.Environment (getArgs)+import Data.Text (unpack)++main :: IO ()+main = do+ args <- getArgs+ let arg1 = args !! 1+ case take 1 args of+ ["list"] -> messageList >>= mapM_ printMessages+ _ -> putStrLn "USAGE: rosmsg <list>"+ where printMessages (pkg, msgs) = mapM_ (putStrLn . format pkg) msgs+ format p m = unpack (pkgName (meta p)) ++ "/" ++ takeBaseName m
+ rosmsg-bin.cabal view
@@ -0,0 +1,43 @@+name: rosmsg-bin+version: 0.1.0.0+synopsis: ROS message management tools+description: Please see README.md+homepage: https://github.com/RoboticsHS/rosmsg-bin#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 rosmsg+ hs-source-dirs: app/rosmsg+ main-is: Main.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends: base >= 4.7 && < 5+ , text+ , rospkg >= 0.2.3+ , filepath+ default-language: Haskell2010++executable genhs+ hs-source-dirs: app/genhs+ main-is: Main.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends: base >= 4.7 && < 5+ , text+ , stack >= 1.1+ , rospkg >= 0.2.3+ , rosmsg >= 0.5.1+ , filepath+ , temporary+ , monad-logger+ other-modules: Template+ , Stack+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/RoboticsHS/rosmsg-bin