Parse Wavefront OBJ using ReadP

Question

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 :: ReadP Int
parseInteger = do
 sign <- parseSign
 s <- many1 $ satisfy isDigit
 return $ sign * read s
parseDouble :: ReadP Double
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 :: ReadP ObjNormal
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 :: ReadP ObjVertexIndex
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 :: ReadP ObjFace
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 :: ReadP ObjFileLine
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
fileFromLines = foldl addLine emptyFile
 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 :: ReadP ObjFile
parseFile = fileFromLines <$> many (do
 line <- parseLine
 char '\n'
 return line)

Answer 1

Read provides compatibility with ReadP.

parseInteger :: ReadP Int
parseInteger = readS_to_P $ readsPrec 0
parseDouble :: ReadP Double
parseDouble = 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?