module Robotics.ROS.Msg.Parser (
Result(..)
, parse
, 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
showType :: Show a => a -> Text
showType = toLower . T.drop 1 . pack . show
simpleAssoc :: [(SimpleType, Text)]
simpleAssoc = (id &&& showType) <$> enumFrom RBool
takeLine :: Parser Text
takeLine = pack <$> manyTill anyChar (eitherP endOfLine endOfInput)
identifier :: Parser Text
identifier = takeWhile1 validChar
where validChar c = any ($ c) [isDigit, isAlpha, (== '_'), (== '/')]
comment :: Parser ()
comment = skipSpace *> char '#' *> takeLine *> pure ()
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 . dropPkgSpec <$> identifier
dropPkgSpec = last . T.split (== '/')
flat = do
name <- space *> skipSpace *> identifier <* takeLine
return $ flip (,) name
array = do
name <- skipSpace *> string "[]" *> skipSpace *> identifier <* takeLine
return $ flip (,) name . Array
fixedArray = do
len <- skipSpace *> char '[' *> decimal <* char ']'
name <- skipSpace *> identifier <* takeLine
return $ flip (,) name . FixedArray len
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) $
case t of
RString -> value
_ -> T.takeWhile (/= '#') value
rosmsg :: Parser MsgDefinition
rosmsg = rights <$> many' (eitherP junk field)
where field = choice [constantParser, variableParser]
junk = choice [comment, endOfLine]