# Parse Wavefront OBJ using ReadP

I've been reading Haskell tutorials and books for a while, but I never actually did serious stuff with it. This is my first attempt.

It parses an OBJ-file in text format. Later on I will add some mesh-representation and more geometry stuff.

Could you please review my code and check for "haskeliness" (like, best practices and maybe if something can be done in a simpler way)? Also I have the feeling, that the ObjFileLine type is redundant. But I can't think of a way to avoid it.

An OBJ-file looks basically like this (see https://en.wikipedia.org/wiki/Wavefront_.obj_file#File_format):

# List of geometric vertices, with (x, y, z [,w]) coordinates, w is optional and defaults to 1.0.
v 0.123 0.234 0.345 1.0
v ...
# List of texture coordinates, in (u, [,v ,w]) coordinates, these will vary between 0 and 1. v, w are optional and default to 0.
vt 0.500 1 [0]
vt ...
# List of vertex normals in (x,y,z) form; normals might not be unit vectors.
vn 0.707 0.000 0.707
vn ...
# Parameter space vertices in ( u [,v] [,w] ) form; free form geometry statement ( see below )
vp 0.310000 3.210000 2.100000
vp ...
# Polygonal face element (see below)
f 1 2 3
f 3/1 4/2 5/3
f 6/4/1 3/5/3 7/6/5
f 7//1 8//2 9//3
f ...
# Line element (see below)
l 5 8 1 2 4 9


I have one file Obj/Obj.hs for the data types, which looks like this:

module Obj.Obj where

import Data.List

-- mesh vertices
data ObjVertex =
Vertex Double Double Double
| Vertex4 Double Double Double Double
deriving Eq

instance Show ObjVertex where
show (Vertex a b c) = "v " ++ show a ++ " " ++ show b ++ " " ++ show c
show (Vertex4 a b c d) = show (Vertex a b c) ++ " " ++ show d

-- uv coordinates for textures
data ObjTexture =
Texture1 Double
| Texture2 Double Double
| Texture3 Double Double Double
deriving Eq

instance Show ObjTexture where
show (Texture1 a) = "vt " ++ show a
show (Texture2 a b) = show (Texture1 a) ++ " " ++ show b
show (Texture3 a b c) = show (Texture2 a b) ++ " " ++ show c

-- face normals
data ObjNormal =
Normal Double Double Double
deriving Eq

instance Show ObjNormal where
show (Normal a b c) = "vn " ++ show a ++ " " ++ show b ++ " " ++ show c

-- parameter space
data ObjParameter =
Parameter1 Double
| Parameter2 Double Double
| Parameter3 Double Double Double
deriving Eq

instance Show ObjParameter where
show (Parameter1 a) = "vp " ++ show a
show (Parameter2 a b) = show (Parameter1 a) ++ " " ++ show b
show (Parameter3 a b c) = show (Parameter2 a b) ++ " " ++ show c

-- face connectivites
data ObjVertexIndex =
VertexIndex Int
| VertexTexture Int Int
| VertexNormal Int Int
| VertexTextureNormal Int Int Int
deriving Eq

instance Show ObjVertexIndex where
show (VertexIndex a) = show a
show (VertexTexture a b) = show a ++ "/" ++ show b
show (VertexNormal a b) = show a ++ "//" ++ show b
show (VertexTextureNormal a b c) = show a ++ "/" ++ show b ++ "/" ++ show c

-- faces
data ObjFace = Face [ObjVertexIndex]
deriving Eq

instance Show ObjFace where
show (Face vertices) = "f " ++ (intercalate " " $map show vertices) -- polylines data ObjPolyLine = Line [Int] deriving Eq instance Show ObjPolyLine where show (Line vertices) = "l " ++ (intercalate " "$ map show vertices)

data ObjFile = File
{ vertices   :: [ObjVertex]
, textures   :: [ObjTexture]
, normals    :: [ObjNormal]
, parameters :: [ObjParameter]
, faces      :: [ObjFace]
, polylines  :: [ObjPolyLine]
}

instance Show ObjFile where
show file = unlines $concat [ fmap show (vertices file), fmap show (textures file), fmap show (normals file), fmap show (parameters file), fmap show (faces file), fmap show (polylines file)] data ObjFileLine = V ObjVertex | VT ObjTexture | VN ObjNormal | VP ObjParameter | F ObjFace | L ObjPolyLine deriving Eq instance Show ObjFileLine where show (V v) = show v show (VT t) = show t show (VN n) = show n show (VP p) = show p show (F f) = show f show (L l) = show l  And a Obj/Parse.hs for the parsers which looks like this: module Obj.Parse ( parseFile ) where import Control.Applicative ((<|>), liftA) import Data.Char (isDigit) import Text.ParserCombinators.ReadP import Obj.Obj -- Parser combinators for an OBJ file. -- Parse numbers. parseSign :: (Num a) => ReadP a parseSign = do sign <- option '+' (char '-') return$ if sign == '+' then 1 else -1

parseInteger = do
sign <- parseSign
s <- many1 $satisfy isDigit return$ sign * read s

parseDouble = (do
sign <- parseSign
int <- many1 $satisfy isDigit char '.' decimal <- many1$ satisfy isDigit
let s = int ++ "." ++ decimal
return $sign * read s ) parseNumber = fmap fromIntegral parseInteger <|> parseDouble -- Parse elements of an OBJ file. vertex :: ReadP ObjVertex vertex = do string "v " numbers <- sepBy parseNumber skipSpaces case numbers of [a, b, c] -> return$ Vertex a b c
[a, b, c, d] -> return $Vertex4 a b c d _ -> fail "" texture :: ReadP ObjTexture texture = do string "vt " numbers <- sepBy parseNumber skipSpaces case numbers of [a] -> return$ Texture1 a
[a, b]    -> return $Texture2 a b [a, b, c] -> return$ Texture3 a b c
_         -> fail ""

normal = do
string "vn "
numbers <- sepBy parseNumber skipSpaces
case numbers of
[a, b, c] -> return $Normal a b c _ -> fail "" parameter :: ReadP ObjParameter parameter = do string "vp " numbers <- sepBy parseNumber skipSpaces case numbers of [a] -> return$ Parameter1 a
[a, b]    -> return $Parameter2 a b [a, b, c] -> return$ Parameter3 a b c
_         -> fail ""

vertexIndex = do
a <- parseInteger
return $VertexIndex a <|> do a <- parseInteger char '/' b <- parseInteger return$ VertexTexture a b
<|> do
a <- parseInteger
string "//"
b <- parseInteger
return $VertexNormal a b <|> do a <- parseInteger char '/' b <- parseInteger char '/' c <- parseInteger return$ VertexTextureNormal a b c

face = do
string "f "
vertices <- sepBy vertexIndex skipSpaces
return $Face vertices objPolyline :: ReadP ObjPolyLine objPolyline = do string "l " elements <- sepBy parseInteger skipSpaces return$ Line elements

-- Parse any line of an OBJ file.
parseLine =
liftA V vertex
<|> liftA VT texture
<|> liftA VN normal
<|> liftA VP parameter
<|> liftA F face
<|> liftA L objPolyline

-- An empty OBJ file.
emptyFile :: ObjFile
emptyFile = File {
vertices = [],
textures = [],
normals = [],
parameters = [],
faces = [],
polylines = []
}

-- Fold a list of lines to an obj file.
fileFromLines :: [ObjFileLine] -> ObjFile
where
addLine file (V vertex) = file { vertices = vertices file ++ [vertex] }
addLine file (VT texture) = file { textures = textures file ++ [texture] }
addLine file (VN normal) = file { normals = normals file ++ [normal] }
addLine file (VP parameter) = file { parameters = parameters file ++ [parameter] }
addLine file (F face) = file { faces = faces file ++ [face] }
addLine file (L line) = file { polylines = polylines file ++ [line] }

-- Parse an OBJ file.
parseFile = fileFromLines <$> many (do line <- parseLine char '\n' return line)  ## 1 Answer Read provides compatibility with ReadP. parseInteger :: ReadP Int parseInteger = readS_to_P$ readsPrec 0

Note that usually, Show instances are supposed to produce strings that can be pasted into .hs files to reproduce the value.
Why not have ObjFile = [ObjFileLine], and ObjFileLine as a single type with 15 constructors?