From 7303e1d9c65c6d1c91e89bfdf7b4bf3313ea7b06 Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Tue, 11 Jun 2019 04:06:24 -0400 Subject: Sabadie parser: support trailing blanks. --- src/Codec/Wavefront/Token.hs | 28 +++++++++++++--------------- test/TestSabadie.hs | 5 ++--- 2 files changed, 15 insertions(+), 18 deletions(-) diff --git a/src/Codec/Wavefront/Token.hs b/src/Codec/Wavefront/Token.hs index 71691a8..01acd5c 100644 --- a/src/Codec/Wavefront/Token.hs +++ b/src/Codec/Wavefront/Token.hs @@ -81,7 +81,7 @@ cleanupTokens = catMaybes -- Location ---------------------------------------------------------------------------------------- location :: Parser Location -location = skipSpace *> string "v " *> skipHSpace *> parseXYZW <* eol +location = string "v " *> skipHSpace *> parseXYZW <* eol where parseXYZW = do xyz <- float `sepBy1` skipHSpace @@ -96,7 +96,7 @@ location = skipSpace *> string "v " *> skipHSpace *> parseXYZW <* eol -- Normal ------------------------------------------------------------------------------------------ normal :: Parser Normal -normal = skipSpace *> string "vn " *> skipHSpace *> parseIJK <* eol +normal = string "vn " *> skipHSpace *> parseIJK <* eol where parseIJK = do ijk <- float `sepBy1` skipHSpace @@ -108,7 +108,7 @@ normal = skipSpace *> string "vn " *> skipHSpace *> parseIJK <* eol -- Texture coordinates ----------------------------------------------------------------------------- texCoord :: Parser TexCoord -texCoord = skipSpace *> string "vt " *> skipHSpace *> parseUVW <* eol +texCoord = string "vt " *> skipHSpace *> parseUVW <* eol where parseUVW = do uvw <- float `sepBy1` skipHSpace @@ -121,7 +121,7 @@ texCoord = skipSpace *> string "vt " *> skipHSpace *> parseUVW <* eol -- Parameter-space coordinates ----------------------------------------------------------------------------- paramCoord :: Parser ParamCoord -paramCoord = skipSpace *> string "vp " *> skipHSpace *> parseUVW <* eol +paramCoord = string "vp " *> skipHSpace *> parseUVW <* eol where parseUVW = do uvw <- float `sepBy1` skipHSpace @@ -134,13 +134,12 @@ paramCoord = skipSpace *> string "vp " *> skipHSpace *> parseUVW <* eol -- Points ------------------------------------------------------------------------------------------ points :: Parser [Point] -points = skipSpace *> string "p " *> skipHSpace *> fmap Point decimal `sepBy1` skipHSpace <* eol +points = string "p " *> skipHSpace *> fmap Point decimal `sepBy1` skipHSpace <* eol ---------------------------------------------------------------------------------------------------- -- Lines ------------------------------------------------------------------------------------------- lines :: Parser [Line] lines = do - skipSpace _ <- string "l " skipHSpace pointIndices <- parsePointIndices @@ -159,7 +158,6 @@ lines = do -- Faces ------------------------------------------------------------------------------------------- face :: Parser Face face = do - skipSpace _ <- string "f " skipHSpace faceIndices <- parseFaceIndices @@ -184,37 +182,37 @@ face = do -- Groups ------------------------------------------------------------------------------------------ groups :: Parser [Text] -groups = skipSpace *> string "g " *> skipHSpace *> name `sepBy` skipHSpace <* eol +groups = string "g " *> skipHSpace *> name `sepBy` skipHSpace <* eol ---------------------------------------------------------------------------------------------------- -- Objects ----------------------------------------------------------------------------------------- object :: Parser Text -object = skipSpace *> string "o " *> skipHSpace *> spacedName <* eol +object = string "o " *> skipHSpace *> spacedName <* eol ---------------------------------------------------------------------------------------------------- -- Material libraries ------------------------------------------------------------------------------ mtllib :: Parser [Text] -mtllib = skipSpace *> string "mtllib " *> skipHSpace *> name `sepBy1` skipHSpace <* eol +mtllib = string "mtllib " *> skipHSpace *> name `sepBy1` skipHSpace <* eol ---------------------------------------------------------------------------------------------------- -- Using materials --------------------------------------------------------------------------------- usemtl :: Parser Text -usemtl = skipSpace *> string "usemtl " *> skipHSpace *> spacedName <* eol +usemtl = string "usemtl " *> skipHSpace *> spacedName <* eol ---------------------------------------------------------------------------------------------------- -- Smoothing groups -------------------------------------------------------------------------------- smoothingGroup :: Parser Natural -smoothingGroup = skipSpace *> string "s " *> skipHSpace *> offOrIndex <* skipHSpace <* eol +smoothingGroup = string "s " *> skipHSpace *> offOrIndex <* skipHSpace <* eol where offOrIndex = string "off" *> pure 0 <|> decimal ---------------------------------------------------------------------------------------------------- -- Comments ---------------------------------------------------------------------------------------- comment :: Parser () -comment = skipSpace *> string "#" *> (() <$ manyTill anyChar eol) +comment = string "#" *> (() <$ manyTill anyChar eol) ---------------------------------------------------------------------------------------------------- -- Special parsers --------------------------------------------------------------------------------- @@ -250,6 +248,6 @@ untilEnd :: Parser a -> Parser [a] untilEnd p = go where go = do - a <- p + skipSpace end <- atEnd - if end then pure [a] else fmap (a:) go + if end then pure [] else (:) <$> p <*> go diff --git a/test/TestSabadie.hs b/test/TestSabadie.hs index de13678..d8d1949 100644 --- a/test/TestSabadie.hs +++ b/test/TestSabadie.hs @@ -3,6 +3,7 @@ module TestSabadie where import Codec.Wavefront import System.Directory import System.IO +import Text.Show.Pretty (ppShow) getDataDir :: IO FilePath getDataDir = do @@ -14,6 +15,4 @@ getDataDir = do main = do ddir <- getDataDir r1 <- fromFile (ddir ++ "/01.obj") - print r1 - -- Failed: ` vp ` [...]: Failed reading: empty - -- Reason: blank lines + either print (putStrLn . ppShow) r1 -- cgit v1.2.3