module PLY.Internal.Parsers where
import Control.Applicative
import Data.Attoparsec.Char8 hiding (char)
import qualified Data.Attoparsec.ByteString as B
import Data.ByteString (ByteString)
import PLY.Types
skip :: Parser ()
skip = skipSpace *> ((ignore *> line *> skip) <|> pure ())
where ignore = string "comment " <|> string "obj_info "
format :: Parser Format
format = "format" .*> skipSpace *> (ascii <|> le <|> be)
where ascii = "ascii 1.0" .*> pure ASCII
le = "binary_little_endian 1.0" .*> pure Binary_LE
be = "binary_big_endian 1.0" .*> pure Binary_BE
char :: Parser Int8
char = signed decimal
uchar :: Parser Word8
uchar = decimal
int :: Parser Int
int = signed decimal
uint :: Parser Word32
uint = decimal
int16 :: Parser Int16
int16 = signed decimal
uint16 :: Parser Word16
uint16 = decimal
float :: Parser Float
float = realToFrac <$> double
line :: Parser ByteString
line = B.takeTill isEndOfLine
scalarProperty :: Parser Property
scalarProperty = ScalarProperty <$> ("property " .*> scalarType) <*> line
scalarType :: Parser ScalarT
scalarType = choice $
[ "char " .*> pure Tchar
, "uchar " .*> pure Tuchar
, "short " .*> pure Tshort
, "ushort " .*> pure Tushort
, "int " .*> pure Tint
, "uint " .*> pure Tuint
, "float " .*> pure Tfloat
, "double " .*> pure Tdouble ]
word :: Parser ByteString
word = skipSpace *> takeTill isSpace <* skipSpace
listProperty :: Parser Property
listProperty = ListProperty <$> ("property list " .*> word *> scalarType)
<*> line
parseList :: ScalarT -> Parser [Scalar]
parseList t = int >>= flip count (parseScalar t)
property :: Parser Property
property = skip *> (scalarProperty <|> listProperty)
element :: Parser Element
element = Element <$> ("element " .*> takeTill isSpace)
<*> (skipSpace *> int <* skipSpace)
<*> many1 property
parseScalar :: ScalarT -> Parser Scalar
parseScalar Tchar = Schar <$> char
parseScalar Tuchar = Suchar <$> uchar
parseScalar Tshort = Sshort <$> int16
parseScalar Tushort = Sushort <$> uint16
parseScalar Tint = Sint <$> int
parseScalar Tuint = Suint <$> uint
parseScalar Tfloat = Sfloat <$> float
parseScalar Tdouble = Sdouble <$> double
multiProps :: [Property] -> Parser [Scalar]
multiProps = go []
where go acc [] = pure (reverse acc)
go acc (ScalarProperty t _:ps) = do !x <- parseScalar t
skipSpace
go (x:acc) ps
go _ (ListProperty t _:_) = int >>= flip count (parseScalar t)
header :: Parser (Format, [Element])
header = (,) <$> preamble <*> elements <*. "end_header"
where preamble = "ply" .*> skip *> format
elements = many1 (skip *> element <* skipSpace)
parseSkip :: Parser a -> ByteString -> ByteString
parseSkip = (aux .) . parse
where aux (Fail _ _ msg) = error $ "parseSkip failed: "++msg
aux (Partial _) = error $ "Incomplete data"
aux (Done t _) = t