packages feed

rosmsg (empty) → 0.4.3.1

raw patch · 9 files changed

+734/−0 lines, 9 filesdep +attoparsecdep +basedep +binarysetup-changed

Dependencies added: attoparsec, base, binary, bytestring, data-default, lens-family, pureMD5, template-haskell, text

Files

+ 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 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ rosmsg.cabal view
@@ -0,0 +1,39 @@+name:                rosmsg+version:             0.4.3.1+synopsis:            ROS message parser, render, TH+description:         Please see README.md+homepage:            https://github.com/akru/rosmsg#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++library+  hs-source-dirs:      src+  exposed-modules:     Robotics.ROS.Msg+                     , Robotics.ROS.Msg.TH+                     , Robotics.ROS.Msg.Types+                     , Robotics.ROS.Msg.Parser+                     , Robotics.ROS.Msg.Render+  build-depends:       base                 >= 4.7    && < 5+                     , text                 >= 1.2    && < 2+                     , binary               >= 0.7    && < 1+                     , pureMD5              >= 2.1    && < 3+                     , attoparsec           >= 0.13   && < 1+                     , bytestring           >= 0.10   && < 1+                     , lens-family          >= 1.2    && < 2+                     , data-default         >= 0.5    && < 1+                     , template-haskell     >= 2.10   && < 3++  other-modules:       Robotics.ROS.Msg.ROSArray+  default-language:    Haskell2010+  ghc-options:         -Wall+  default-extensions:  OverloadedStrings++source-repository head+  type:     git+  location: https://github.com/akru/rosmsg
+ src/Robotics/ROS/Msg.hs view
@@ -0,0 +1,76 @@+-- |+-- Module      :  Robotics.ROS.Msg+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  POSIX / WIN32+--+-- 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.+--+-- In ROS a node is a process that performs computation. +-- Nodes communicate with each other by publishing messages to topics.+-- A message is a simple data structure, comprising typed fields. Standard+-- primitive types (integer, floating point, boolean, etc.) are supported,+-- as are arrays of primitive types. Messages can include arbitrarily nested+-- structures and arrays (much like C structs).+--+-- This package provide the ROS message language parser and builder. Abstract+-- message representation given by parser can be used in TemplateHaskell codegen+-- for native Haskell structures creation.+--+-- >>> [rosmsgFrom|/opt/ros/jade/share/std_msgs/msg/Byte.msg|]+-- "[Variable (Simple RByte,\"data\")]"+--+-- >>> [rosmsgFrom|/opt/ros/jade/share/geometry_msgs/msg/Polygon.msg|]+-- "[Variable (Array (Custom \"Point32\"),\"points\")]"+--+module Robotics.ROS.Msg (+  -- * Message classes +    Message(..)+  , Stamped(..)+  -- * Common used types+  -- ** Array-like types+  , ROSFixedArray(..)+  , ROSArray(..)+  -- ** Time description+  , ROSDuration+  , ROSTime+  ) where++import Data.Digest.Pure.MD5 (MD5Digest) +import Data.ByteString (ByteString)+import Data.Binary (Binary)+import Data.Word (Word32)+import Data.Text (Text)++import Robotics.ROS.Msg.ROSArray+import Robotics.ROS.Msg.Types++-- | Haskell native type for ROS message language described+-- data structure. Serialization guaranted by 'Binary' super+-- class. And no more is needed for transfer over socket.+class Binary a => Message a where+    -- | Get MD5 of formal message representation+    getDigest :: a -> MD5Digest+    -- | Get message type, e.g. @std_msgs/Char@+    getType   :: a -> Text++-- | Sometime ROS messages have a special @Header@ field.+-- It used for tracking package sequence, time stamping+-- and frame tagging. Headers is frequently field. The+-- 'Stamped' type class lifts header fields on the top+-- of message and abstracting of type.+class Message a => Stamped a where+    -- | Get sequence number+    getSequence :: a -> Word32+    -- | Set sequence number+    setSequence :: Word32 -> a -> a+    -- | Get timestamp of message+    getStamp    :: a -> ROSTime+    -- | Get frame of message+    getFrame    :: a -> ByteString
+ src/Robotics/ROS/Msg/Parser.hs view
@@ -0,0 +1,98 @@+-- |+-- Module      :  Robotics.ROS.Msg.Parser+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  POSIX / WIN32+--+-- Parser components for the ROS message description language (@msg@+-- files). See http://wiki.ros.org/msg for reference.+--+module Robotics.ROS.Msg.Parser (+  -- * Attoparsec re-export+    Result(..)+  , parse+  -- * The ROS message language parser+  , rosmsg+  ) where++import           Data.Text (Text, pack, toLower)+import           Data.Char (isDigit, isAlpha)+import           Data.Attoparsec.Text.Lazy+import           Control.Arrow ((&&&))+import           Data.Either (rights)+import qualified Data.Text as T++import           Robotics.ROS.Msg.Types++-- | Show simple type+showType :: Show a => a -> Text+showType = toLower . T.drop 1 . pack . show++-- | All of simple type and its text representation list+simpleAssoc :: [(SimpleType, Text)]+simpleAssoc = (id &&& showType) <$> enumFrom RBool++-- | Line getter+takeLine :: Parser Text+takeLine = pack <$> manyTill anyChar (eitherP endOfLine endOfInput)++-- | Valid ROS identifier parser+identifier :: Parser Text+identifier = takeWhile1 validChar+  where validChar c = any ($ c) [isDigit, isAlpha, (== '_'), (== '/')]++-- | ROS message comments parser+comment :: Parser ()+comment = skipSpace *> char '#' *> takeLine *> pure ()++-- | Parse fields defined in the message+variableParser :: Parser FieldDefinition+variableParser = do+    typeIdent <- choice [simpleField, customField] +    mkField   <- choice [flat, array, fixedArray]+    return (Variable $ mkField typeIdent)+  where+    simpleField = Simple . fst <$> choice (mapM string <$> simpleAssoc)++    customField = Custom <$> identifier++    -- | Flat type is no array+    flat = do+        name <- space *> skipSpace *> identifier <* takeLine+        return $ flip (,) name++    -- | Variable lenght array+    array = do+        name <- skipSpace *> string "[]" *> skipSpace *> identifier <* takeLine+        return $ flip (,) name . Array++    -- | Fixed lenght array+    fixedArray = do+        len <- skipSpace *> char '[' *> decimal <* char ']'+        name <- skipSpace *> identifier <* takeLine+        return $ flip (,) name . FixedArray len++-- | Parse constants defined in the message+constantParser :: Parser FieldDefinition+constantParser = choice (go <$> enumFrom RBool)+  where+    go t = do+        name <- string (showType t) *> skipSpace *> identifier <* space+        value <- skipSpace *> char '=' *> skipSpace *> takeLine+        return $ Constant (Simple t, name) $+            -- String constants are parsed somewhat differently from numeric+            -- constants. For numerical constants, we drop comments and trailing+            -- spaces. For strings, we take the whole line (so comments aren't+            -- stripped).+            case t of+                RString -> value+                _       -> T.takeWhile (/= '#') value++-- | The ROS message language parser+rosmsg :: Parser MsgDefinition+rosmsg = rights <$> many' (eitherP junk field)+  where field = choice [constantParser, variableParser]+        junk  = choice [comment, endOfLine]
+ src/Robotics/ROS/Msg/ROSArray.hs view
@@ -0,0 +1,75 @@+-- |+-- Module      :  Robotics.ROS.Msg.ROSArray+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  POSIX / WIN32+--+-- Array-like types and instances for Haskell implementation+-- of the ROS message structures.+--+{-# LANGUAGE DataKinds                  #-}+{-# LANGUAGE KindSignatures             #-}+{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Robotics.ROS.Msg.ROSArray+  ( ROSArray(..)+  , ROSFixedArray(..)+  ) where++import GHC.TypeLits (Nat, KnownNat, natVal)+import Data.Binary (Binary(..), Get)+import Control.Monad (replicateM)+import Data.Default (Default(..))+import Data.Typeable (Typeable)+import Data.Word (Word32)+import Data.Data (Data)++-- | Simple 'Array' type+-- TODO: migrate to more performance vector type+type Array = []++-- | A type for arrays in ROS messages+newtype ROSArray a = ROSArray { unArray :: Array a }+  deriving (Show, Eq, Ord, Data, Typeable, Functor, Applicative)++instance Monoid (ROSArray a) where+    mempty = ROSArray []+    mappend a b = ROSArray (unArray a ++ unArray b)++instance Default (ROSArray a) where+    def = mempty++instance Binary a => Binary (ROSArray a) where+    put (ROSArray arr) = put len >> sequence_ (put <$> arr)+      where len :: Word32+            len = fromIntegral (length arr)+    get = do len <- get :: Get Word32+             ROSArray <$> replicateM (fromIntegral len) get++-- | A type for fixed arrays in ROS messages+newtype ROSFixedArray (n :: Nat) a = ROSFixedArray { unFixedArray :: Array a }+  deriving (Show, Eq, Ord, Data, Typeable, Functor, Applicative)++instance Monoid (ROSFixedArray n a) where+    mempty = ROSFixedArray []+    mappend a b = ROSFixedArray (unFixedArray a ++ unFixedArray b)++size :: (KnownNat n, Num b) => ROSFixedArray n a -> b+size = fromIntegral . natVal . proxy+  where proxy :: ROSFixedArray n a -> proxy n+        proxy _ = undefined++modify :: ROSFixedArray n a -> Array b -> ROSFixedArray n b+modify a b = a { unFixedArray = b }++instance (Default a, KnownNat n) => Default (ROSFixedArray n a) where+    def = modify arr (replicate (size arr) def)+      where arr = mempty++instance (Binary a, KnownNat n) => Binary (ROSFixedArray n a) where+    put (ROSFixedArray arr) = sequence_ (put <$> arr)+    get = modify arr <$> replicateM (size arr) get+      where arr = mempty
+ src/Robotics/ROS/Msg/Render.hs view
@@ -0,0 +1,56 @@+-- |+-- Module      :  Robotics.ROS.Msg.Render+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  POSIX / WIN32+--+-- The ROS message language builder from abstract message definition.+--+module Robotics.ROS.Msg.Render (+  -- * Create lazy text builder from message definition+    render+  -- * Create builder with custom type hook+  , render'+  ) where++import Data.Text.Lazy.Builder (Builder, fromText, fromString)+import Data.Char (toLower)+import Data.Monoid ((<>))+import Data.Text (Text)++import Robotics.ROS.Msg.Types++-- | Builder creator from 'FieldType'+rosType :: (Text -> Text) -> FieldType -> Builder+rosType _ (Simple t) = fromString $ fmap toLower $ drop 1 $ show t +rosType u (Custom t) = fromText $ u t+rosType u (Array t)        = rosType u t <> "[]"+rosType u (FixedArray l t) = rosType u t <> "[" <> fromString (show l) <> "]"++-- | Like 'render' by first argument is custom type modifier hook+render' :: (Text -> Text) -> MsgDefinition -> Builder+render' uType = foldl (\a b -> a <> "\n" <> b) mempty . fmap go . sort+  where sort v = filter isConstant v ++ filter (not . isConstant) v+        go (Constant (typ, name) val) = rosType uType typ <> " " <>+                                        fromText name <> "=" <> fromText val+        go (Variable (typ, name)) = rosType uType typ <> " " <> fromText name+        isConstant x = case x of+            Constant _ _ -> True+            _ -> False++-- | Render formal ROS message definition according to:+--+--     * comments removed+--+--     * whitespace removed+--+--     * package names of dependencies removed+--+--     * constants reordered ahead of other declarations+--       from http://www.ros.org/wiki/ROS/Technical%20Overview+--+render :: MsgDefinition -> Builder+render = render' id
+ src/Robotics/ROS/Msg/TH.hs view
@@ -0,0 +1,279 @@+-- |+-- Module      :  Robotics.ROS.Msg.TH+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  POSIX / WIN32+--+-- Template Haskell driven code generator from ROS message language+-- to Haskell native representation.+--+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE TemplateHaskell #-}+module Robotics.ROS.Msg.TH (+  -- * Native Haskell ROS message codegen +    rosmsg+  , rosmsgFrom+  ) where++import qualified Data.ByteString.Lazy.Char8 as LBS+import           Data.Attoparsec.Text.Lazy (Result(..))+import           Data.Text.Lazy.Builder (toLazyText)+import           Data.Char (isAlphaNum, toLower)+import           Data.Text.Lazy (pack, unpack)+import           Data.Digest.Pure.MD5 (md5)+import           Data.Maybe (catMaybes)+import           Text.Printf (printf)+import           Data.List (groupBy)+import           Data.Default (def)+import           Data.Monoid ((<>))+import qualified Lens.Family2 as L+import qualified Data.Text as T++import           Language.Haskell.TH.Quote+import           Language.Haskell.TH++import qualified Robotics.ROS.Msg.Parser as Parser+import           Robotics.ROS.Msg.Render (render')+import           Robotics.ROS.Msg.Types+import           Robotics.ROS.Msg++-- | Generate ROS message declarations from .msg file+rosmsgFrom :: QuasiQuoter+rosmsgFrom = quoteFile rosmsg++-- | QQ for data type and instances generation+-- from ROS message declaration+rosmsg :: QuasiQuoter+rosmsg = QuasiQuoter+  { quoteDec  = quoteMsgDec+  , quoteExp  = quoteMsgExp+  , quotePat  = undefined+  , quoteType = undefined+  }++-- | Take user type from text type name+customType :: T.Text -> TypeQ+customType = conT . mkName . T.unpack . qualify . pkgInTypeHook+  where -- Some messages (e.g. geometry_msgs/Inertia in `com` field)+        -- contains package name in field type declarations+        -- it's too strange but exits now, this fix drop+        -- package name from type declaration+        pkgInTypeHook = last . T.split (== '/')+        qualify t     = t <> "." <> t++-- | Take list of external types used in message+externalTypes :: MsgDefinition -> [TypeQ]+externalTypes msg = customType <$> catMaybes (go <$> msg)+  where+    go (Variable (Custom t, _))                = Just t+    go (Variable (Array (Custom t), _))        = Just t+    go (Variable (FixedArray _ (Custom t), _)) = Just t+    go _ = Nothing++-- | Field to Type converter+typeQ :: FieldType -> TypeQ+typeQ (Simple t)       = conT $ mkName $ mkFlatType t+typeQ (Custom t)       = customType t+typeQ (Array t)        = [t|ROSArray $(typeQ t)|]+typeQ (FixedArray l t) = [t|ROSFixedArray $arrSize $(typeQ t)|]+  where arrSize = litT $ numTyLit $ fromIntegral l++-- | Ensure that field and constant names are valid Haskell identifiers+-- and do not coincide with Haskell reserved words.+sanitizeField :: FieldDefinition -> FieldDefinition+sanitizeField (Constant (a, b) c) = Constant (a, sanitize b) c+sanitizeField (Variable (a, b))   = Variable (a, sanitize b) ++-- | Sanitize identifier for valid Haskell+sanitize :: T.Text -> T.Text+sanitize x | isKeyword x = T.cons '_' x+           | otherwise   = x+  where isKeyword = flip elem [ "as", "case", "of", "class"+                              , "data", "family", "instance"+                              , "default", "deriving", "do"+                              , "forall", "foreign", "hiding"+                              , "if", "then", "else", "import"+                              , "infix", "infixl", "infixr"+                              , "let", "in", "mdo", "module"+                              , "newtype", "proc", "qualified"+                              , "rec", "type", "where"]++-- | Generate the name of the Haskell type that corresponds to a flat+-- (i.e. non-array) ROS type.+mkFlatType :: SimpleType -> String+mkFlatType t = case t of+    RBool     -> "P.Bool"+    RInt8     -> "I.Int8"+    RUInt8    -> "W.Word8"+    RByte     -> "W.Word8"+    RChar     -> "I.Int8"+    RInt16    -> "I.Int16"+    RUInt16   -> "W.Word16"+    RInt32    -> "I.Int32"+    RUInt32   -> "W.Word32"+    RInt64    -> "I.Int64"+    RUInt64   -> "W.Word64"+    RFloat32  -> "P.Float"+    RFloat64  -> "P.Double"+    RString   -> "BS.ByteString"+    RDuration -> "ROSDuration"+    RTime     -> "ROSTime"++-- | Default value of field+defValue :: FieldDefinition -> Maybe ExpQ+defValue (Constant _ _) = Nothing+defValue (Variable (Simple t, _)) = Just $+    case t of+        RBool     -> [|False|]+        RString   -> [|""|]+        _         -> [|def|]+defValue (Variable _) = Just [|def|]++-- | Field definition to record var converter+fieldQ :: FieldDefinition -> Maybe VarStrictTypeQ+fieldQ (Constant _ _)         = Nothing +fieldQ (Variable (typ, name)) = Just $ varStrictType recName recType+  where recName = mkName ('_' : T.unpack name)+        recType = strictType notStrict (typeQ typ)++-- | Generate the getDigest Message class implementation +mkGetDigest :: MsgDefinition -> DecQ+mkGetDigest msg =+    funD' "getDigest" [wildP] [| md5 (LBS.pack $(appsE source)) |]+  where+    source      = ([|printf $(stringE (render msg))|]+                : (depDigest <$> externalTypes msg))+    depDigest t = [|show (getDigest (undefined :: $(t)))|]+    render      = unpack . toLazyText . render' (const "%s")++-- | Generate the getType Message class implementation +mkGetType :: DecQ+mkGetType = do+    l_mod <- loc_module <$> location+    let msgType = let [m, p] = fmap (drop 1) $ take 2 $+                               reverse $ groupBy (const (/= '.')) l_mod+                   in fmap toLower p ++ "/" ++ m+    funD' "getType" [wildP] [|msgType|]++-- | Lens signature+lensSig :: String -> TypeQ -> TypeQ -> DecQ+lensSig name a b = sigD (mkName name)+    [t|forall f. Functor f => ($b -> f $b) -> $a -> f $a|]++-- | Given a record field name,+-- produces a single function declaration:+-- lensName :: forall f. Functor f => (a -> f a') -> b -> f b' +-- lensName f a = (\x -> a { field = x }) `fmap` f (field a)+-- FROM: Lens.Family.THCore+deriveLens :: Name -> FieldDefinition -> [DecQ]+deriveLens _ (Constant _ _) = []+deriveLens dataName (Variable (typ, name)) =+    [ lensSig (T.unpack name) (conT dataName) (typeQ typ)+    , funD' (T.unpack name) pats body]+  where a = mkName "a"+        f = mkName "f"+        fieldName = mkName ('_' : T.unpack name) +        pats = [varP f, varP a]+        body = [| (\x -> $(record a fieldName [|x|]))+                  <$> $(appE (varE f) (appE (varE fieldName) (varE a)))+                |]+        record rec fld val = val >>= \v -> recUpdE (varE rec) [return (fld, v)]++-- | Instance declaration with empty context+instanceD' :: Name -> TypeQ -> [DecQ] -> DecQ+instanceD' name insType insDecs =+    instanceD (cxt []) (appT insType (conT name)) insDecs++-- | Simple function declaration+funD' :: String -> [PatQ] -> ExpQ -> DecQ+funD' name p f = funD (mkName name) [clause p (normalB f) []]++-- | Lenses declarations+mkLenses :: Name -> MsgDefinition -> [DecQ]+mkLenses name msg =+    concat (deriveLens name . sanitizeField <$> msg)++-- | Data type declaration+mkData :: Name -> MsgDefinition -> [DecQ]+mkData name msg = pure $+    dataD (cxt []) name [] [recs] derivingD+  where+    fields     = sanitizeField <$> msg+    recs       = recC name (catMaybes (fieldQ <$> fields))+    derivingD  = [ mkName "P.Show", mkName "P.Eq", mkName "P.Ord"+                 , mkName "Generic", mkName "Data", mkName "Typeable"+                 ]++-- | Binary instance declaration+mkBinary :: Name -> a -> [DecQ]+mkBinary name _ = pure $+    instanceD' name binaryT []+  where+    binaryT    = conT (mkName "Binary")++-- | Default instance declaration+mkDefault :: Name -> MsgDefinition -> [DecQ]+mkDefault name msg = pure $+    instanceD' name defaultT [defFun]+  where+    defaultT = conT (mkName "Default")+    defaults = catMaybes (defValue . sanitizeField <$> msg)+    defFun   = funD' "def" [] $ appsE (conE name : defaults)++-- | Message instance declaration+mkMessage :: Name -> MsgDefinition -> [DecQ]+mkMessage name msg = pure $+    instanceD' name messageT [mkGetDigest msg, mkGetType]+  where+    messageT = conT (mkName "Message")++-- | Stamped instance declaration+mkStamped :: Name -> MsgDefinition -> [DecQ]+mkStamped name msg | hasHeader msg = pure go+                   | otherwise = []+  where+    hasHeader [Variable (Custom "Header", _), _] = True+    hasHeader _ = False++    seqL    = dyn "Header.seq"+    stampL  = dyn "Header.stamp"+    frameL  = dyn "Header.frame_id"+    headerL = dyn "header"++    mkSetSequence = funD' "setSequence" [] [|L.set  ($headerL . $seqL)|]+    mkGetSequence = funD' "getSequence" [] [|L.view ($headerL . $seqL)|]+    mkGetStamp    = funD' "getStamp"    [] [|L.view ($headerL . $stampL)|]+    mkGetFrame    = funD' "getFrame"    [] [|L.view ($headerL . $frameL)|]++    stampedT = conT (mkName "Stamped")++    go = instanceD' name stampedT [ mkGetSequence+                                  , mkSetSequence+                                  , mkGetStamp+                                  , mkGetFrame ]++-- | TemplateHaskell codegen from the ROS message language+quoteMsgDec :: String -> Q [Dec]+quoteMsgDec txt = do+    name <- mkDataName . loc_module <$> location+    sequence $ concatMap (msgRun name) $+      [ mkData+      , mkBinary+      , mkDefault+      , mkMessage+      , mkStamped+      , mkLenses+      ]+  where Done _ msg = Parser.parse Parser.rosmsg (pack txt)+        mkDataName = mkName . drop 1 . last . groupBy (const isAlphaNum)+        msgRun n   = ($ (n, msg)) . uncurry++-- | Simple parse ROS message and show+quoteMsgExp :: String -> ExpQ+quoteMsgExp txt = stringE (show msg)+  where Done _ msg = Parser.parse Parser.rosmsg (pack txt)
+ src/Robotics/ROS/Msg/Types.hs view
@@ -0,0 +1,79 @@+-- |+-- Module      :  Robotics.ROS.Msg.Types+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  POSIX / WIN32+--+-- Common used data types.+--+module Robotics.ROS.Msg.Types (+  -- * ROS message abstract declaration types+    FieldDefinition(..)+  , SimpleType(..)+  , FieldType(..)+  , MsgDefinition+  , FieldName+  , Field+  -- * Time describing+  , ROSDuration+  , ROSTime+  ) where++import Data.Word (Word32)+import Data.Text (Text)++-- | A variant type describing the simple types +-- that may be included in a ROS message.+data SimpleType+  = RBool+  | RByte+  | RChar+  | RInt8+  | RUInt8+  | RInt16+  | RUInt16+  | RInt32+  | RUInt32+  | RInt64+  | RUInt64+  | RFloat32+  | RFloat64+  | RString+  | RTime+  | RDuration+  deriving (Show, Enum, Eq)++-- | A variant type describing the types that may be included in a ROS+-- message.+data FieldType+  = Simple SimpleType+  | Custom Text+  | Array FieldType+  | FixedArray Int FieldType+  deriving (Show, Eq)++-- | Field name is text encoded+type FieldName = Text++-- | Field is a pair of name - value+type Field = (FieldType, FieldName)++-- | ROS message field is a variable or constant declaration+data FieldDefinition+  = Variable Field+  -- ^ Variable field name and type+  | Constant Field Text +  -- ^ Constant field name, type and value+  deriving (Show, Eq)++-- | ROS message is a list of fields+type MsgDefinition = [FieldDefinition]++-- | ROSDuration is a tuple of (seconds, nanoseconds)+type ROSDuration = (Word32, Word32)++-- | ROSTime is a tuple of (seconds, nanoseconds)+type ROSTime = (Word32, Word32)