Initial commit.

12 files changed, 655 insertions, 0 deletions

diff --git a/src/Codec/Wavefront.hs b/src/Codec/Wavefront.hs
new file mode 100644
index 0000000..affec01
--- /dev/null
+++ b/src/Codec/Wavefront.hs
@@ -0,0 +1,49 @@
+{-# LANGUAGE PatternSynonyms #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Copyright   : (C) 2015 Dimitri Sabadie
+-- License     : BSD3
+--
+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>
+-- Stability   : experimental
+-- Portability : portable
+--
+-- Currently, you can parse a file and get a 'WavefrontOBJ' with the 'fromFile'
+-- function.
+-----------------------------------------------------------------------------
+
+module Codec.Wavefront (
+    -- * Vertex location
+    Location(..)
+    -- * Vertex texture coordinates
+  , TexCoord(..)
+    -- * Vertex normals
+  , Normal(..)
+    -- * Points
+  , Point(..)
+    -- * Lines
+  , Line(..)
+  , LineIndex(..)
+    -- * Faces
+  , Face(..)
+  , FaceIndex(..)
+  , pattern Triangle
+  , pattern Quad
+    -- * Element
+  , Element(..)
+    -- * Object
+  , WavefrontOBJ(..)
+    -- * Re-exports
+  , module Codec.Wavefront.IO
+  ) where
+
+import Codec.Wavefront.Element
+import Codec.Wavefront.Face
+import Codec.Wavefront.IO
+import Codec.Wavefront.Line
+import Codec.Wavefront.Location
+import Codec.Wavefront.Normal
+import Codec.Wavefront.Object
+import Codec.Wavefront.Point
+import Codec.Wavefront.TexCoord
diff --git a/src/Codec/Wavefront/Element.hs b/src/Codec/Wavefront/Element.hs
new file mode 100644
index 0000000..846b603
--- /dev/null
+++ b/src/Codec/Wavefront/Element.hs
@@ -0,0 +1,29 @@
+-----------------------------------------------------------------------------
+-- |
+-- Copyright   : (C) 2015 Dimitri Sabadie
+-- License     : BSD3
+--
+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>
+-- Stability   : experimental
+-- Portability : portable
+--
+-----------------------------------------------------------------------------
+
+module Codec.Wavefront.Element (
+    -- * Element
+    Element(..)
+  ) where
+
+import Data.Text ( Text )
+import Numeric.Natural ( Natural )
+
+-- |An element holds a value along with the user-defined object’s name (if any), the associated
+-- groups, the used material and the smoothing group the element belongs to (if any). Those values
+-- can be used to sort the data per object or per group and to lookup materials.
+data Element a = Element {
+    elObject :: Maybe Text
+  , elGroups :: [Text]
+  , elMtl :: Maybe Text
+  , elSmoothingGroup :: Natural
+  , elValue :: a
+  } deriving (Eq,Show)
diff --git a/src/Codec/Wavefront/Face.hs b/src/Codec/Wavefront/Face.hs
new file mode 100644
index 0000000..f055dd0
--- /dev/null
+++ b/src/Codec/Wavefront/Face.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE PatternSynonyms #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Copyright   : (C) 2015 Dimitri Sabadie
+-- License     : BSD3
+--
+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>
+-- Stability   : experimental
+-- Portability : portable
+--
+-----------------------------------------------------------------------------
+
+module Codec.Wavefront.Face where
+
+-- |A face index is a triplet of indices. @'FaceIndex' vi vti vni@ is a face that indexes the
+-- locations with @vi@, the texture coordinates with @vti@ and the normals with @vni@. An index set
+-- to 'Nothing' means /no information/. That is, if @vni == 'Nothing'@, then that 'FaceIndex'
+-- doesn’t have a normal associated with.
+data FaceIndex = FaceIndex {
+    faceLocIndex :: {-# UNPACK #-} !Int
+  , faceTexCoordIndex :: !(Maybe Int)
+  , faceNorIndex :: !(Maybe Int)
+  } deriving (Eq,Show)
+
+-- |A face gathers several 'FaceIndex' to build up faces. It has a least three vertices
+data Face = Face FaceIndex FaceIndex FaceIndex [FaceIndex] deriving (Eq,Show)
+
+pattern Triangle :: FaceIndex -> FaceIndex -> FaceIndex -> Face
+pattern Triangle a b c = Face a b c []
+
+pattern Quad :: FaceIndex -> FaceIndex -> FaceIndex -> FaceIndex -> Face
+pattern Quad a b c d = Face a b c [d]
diff --git a/src/Codec/Wavefront/IO.hs b/src/Codec/Wavefront/IO.hs
new file mode 100644
index 0000000..2bcf2b3
--- /dev/null
+++ b/src/Codec/Wavefront/IO.hs
@@ -0,0 +1,22 @@
+-----------------------------------------------------------------------------
+-- |
+-- Copyright   : (C) 2015 Dimitri Sabadie
+-- License     : BSD3
+--
+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>
+-- Stability   : experimental
+-- Portability : portable
+--
+-----------------------------------------------------------------------------
+
+module Codec.Wavefront.IO where
+
+import Codec.Wavefront.Lexer ( lexer )
+import Codec.Wavefront.Object ( WavefrontOBJ, ctxtToWavefrontOBJ )
+import Codec.Wavefront.Token ( tokenize )
+import Control.Monad.IO.Class ( MonadIO(..) )
+import qualified Data.Text.IO as T ( readFile )
+
+-- |Extract a 'WavefrontOBJ' from a Wavefront OBJ formatted file.
+fromFile :: (MonadIO m) => FilePath -> m (Either String WavefrontOBJ)
+fromFile fd = liftIO $ fmap (fmap (ctxtToWavefrontOBJ . lexer) . tokenize) (T.readFile fd)
diff --git a/src/Codec/Wavefront/Lexer.hs b/src/Codec/Wavefront/Lexer.hs
new file mode 100644
index 0000000..79b167a
--- /dev/null
+++ b/src/Codec/Wavefront/Lexer.hs
@@ -0,0 +1,106 @@
+-----------------------------------------------------------------------------
+-- |
+-- Copyright   : (C) 2015 Dimitri Sabadie
+-- License     : BSD3
+--
+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>
+-- Stability   : experimental
+-- Portability : portable
+--
+-----------------------------------------------------------------------------
+
+module Codec.Wavefront.Lexer where
+
+import Codec.Wavefront.Element
+import Codec.Wavefront.Face
+import Codec.Wavefront.Line
+import Codec.Wavefront.Location
+import Codec.Wavefront.Normal
+import Codec.Wavefront.Point
+import Codec.Wavefront.Token
+import Codec.Wavefront.TexCoord
+import Data.DList ( DList, append, empty, fromList, snoc )
+import Data.Text ( Text )
+import Control.Monad.State ( State, execState, gets, modify )
+import Data.Foldable ( traverse_ )
+import Numeric.Natural ( Natural )
+
+-- |The lexer context. The result of lexing a stream of tokens is this exact type.
+data Ctxt = Ctxt {
+    -- |Locations.
+    ctxtLocations :: DList Location
+    -- |Texture coordinates.
+  , ctxtTexCoords :: DList TexCoord
+    -- |Normals.
+  , ctxtNormals :: DList Normal
+    -- |Points.
+  , ctxtPoints :: DList (Element Point)
+    -- |Lines.
+  , ctxtLines :: DList (Element Line)
+    -- |Faces.
+  , ctxtFaces :: DList (Element Face)
+    -- |Current object.
+  , ctxtCurrentObject :: Maybe Text
+    -- |Current groups.
+  , ctxtCurrentGroups :: [Text]
+    -- |Current material.
+  , ctxtCurrentMtl :: Maybe Text
+    -- |Material libraries.
+  , ctxtMtlLibs :: DList Text
+    -- |Current smoothing group.
+  , ctxtCurrentSmoothingGroup :: Natural
+  } deriving (Eq,Show)
+
+-- |The empty 'Ctxt'. Such a context exists at the beginning of the token stream and gets altered
+-- as we consume tokens.
+emptyCtxt :: Ctxt 
+emptyCtxt = Ctxt {
+    ctxtLocations = empty
+  , ctxtTexCoords = empty
+  , ctxtNormals = empty
+  , ctxtPoints = empty
+  , ctxtLines = empty
+  , ctxtFaces = empty
+  , ctxtCurrentObject = Nothing
+  , ctxtCurrentGroups = ["default"]
+  , ctxtCurrentMtl = Nothing
+  , ctxtMtlLibs = empty
+  , ctxtCurrentSmoothingGroup = 0
+  }
+
+-- |The lexer function, consuming tokens and yielding a 'Ctxt'.
+lexer :: TokenStream -> Ctxt
+lexer stream = execState (traverse_ consume stream) emptyCtxt
+  where
+    consume tk = case tk of
+      TknV v -> do
+        locations <- gets ctxtLocations
+        modify $ \ctxt -> ctxt { ctxtLocations = locations `snoc` v }
+      TknVN vn -> do
+        normals <- gets ctxtNormals
+        modify $ \ctxt -> ctxt { ctxtNormals = normals `snoc` vn }
+      TknVT vt -> do
+        texCoords <- gets ctxtTexCoords
+        modify $ \ctxt -> ctxt { ctxtTexCoords = texCoords `snoc` vt }
+      TknP p -> do
+        (pts,element) <- prepareElement ctxtPoints
+        modify $ \ctxt -> ctxt { ctxtPoints = pts `append` fmap element (fromList p) }
+      TknL l -> do
+        (lns,element) <- prepareElement ctxtLines
+        modify $ \ctxt -> ctxt { ctxtLines = lns `append` fmap element (fromList l) }
+      TknF f -> do
+        (fcs,element) <- prepareElement ctxtFaces
+        modify $ \ctxt -> ctxt { ctxtFaces = fcs `snoc` element f }
+      TknG g -> modify $ \ctxt -> ctxt { ctxtCurrentGroups = g }
+      TknO o -> modify $ \ctxt -> ctxt { ctxtCurrentObject = Just o }
+      TknMtlLib l -> do
+        libs <- gets ctxtMtlLibs
+        modify $ \ctxt -> ctxt { ctxtMtlLibs = libs `append` fromList l }
+      TknUseMtl mtl -> modify $ \ctxt -> ctxt { ctxtCurrentMtl = Just mtl }
+      TknS sg -> modify $ \ctxt -> ctxt { ctxtCurrentSmoothingGroup = sg }
+
+-- Prepare to create a new 'Element' by retrieving its associated list.
+prepareElement :: (Ctxt -> DList (Element a)) -> State Ctxt (DList (Element a),a -> Element a)
+prepareElement field = do
+  (aList,obj,grp,mtl,sg) <- gets $ (\ctxt -> (field ctxt,ctxtCurrentObject ctxt,ctxtCurrentGroups ctxt,ctxtCurrentMtl ctxt,ctxtCurrentSmoothingGroup ctxt))
+  pure (aList,Element obj grp mtl sg)
diff --git a/src/Codec/Wavefront/Line.hs b/src/Codec/Wavefront/Line.hs
new file mode 100644
index 0000000..d44e9e2
--- /dev/null
+++ b/src/Codec/Wavefront/Line.hs
@@ -0,0 +1,26 @@
+-----------------------------------------------------------------------------
+-- |
+-- Copyright   : (C) 2015 Dimitri Sabadie
+-- License     : BSD3
+--
+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>
+-- Stability   : experimental
+-- Portability : portable
+--
+-----------------------------------------------------------------------------
+
+module Codec.Wavefront.Line where
+
+-- |A line index is a pair of indices. @'LineIndex' vi vti@. @vi@ references the locations and @vti@
+-- indexes the texture coordinates. If @vti == 'Nothing'@, then that 'LineIndex' doesn’t have
+-- texture coordinates associated with.
+data LineIndex = LineIndex {
+    lineLocIndex :: {-# UNPACK #-} !Int
+  , lineTexCoordIndex :: !(Maybe Int)
+  } deriving (Eq,Show)
+
+-- A line gathers two line indices accessible by pattern matching or 'lineIndexA' and 'lineIndexB'.
+data Line = Line {
+    lineIndexA :: LineIndex
+  , lineIndexB :: LineIndex
+  } deriving (Eq,Show)
diff --git a/src/Codec/Wavefront/Location.hs b/src/Codec/Wavefront/Location.hs
new file mode 100644
index 0000000..abdbc6a
--- /dev/null
+++ b/src/Codec/Wavefront/Location.hs
@@ -0,0 +1,26 @@
+-----------------------------------------------------------------------------
+-- |
+-- Copyright   : (C) 2015 Dimitri Sabadie
+-- License     : BSD3
+--
+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>
+-- Stability   : experimental
+-- Portability : portable
+--
+-----------------------------------------------------------------------------
+
+module Codec.Wavefront.Location where
+
+-- |A location is a 4-floating vector. You can access to its components by pattern matching on them:
+--
+-- @
+--   let Location x y z w = Location 1 2 3 4
+-- @
+--
+-- That type is strict and unboxed.
+data Location = Location {
+    locX :: {-# UNPACK #-} !Float
+  , locY :: {-# UNPACK #-} !Float
+  , locZ :: {-# UNPACK #-} !Float
+  , locW :: {-# UNPACK #-} !Float
+  } deriving (Eq,Show)
diff --git a/src/Codec/Wavefront/Normal.hs b/src/Codec/Wavefront/Normal.hs
new file mode 100644
index 0000000..adf6221
--- /dev/null
+++ b/src/Codec/Wavefront/Normal.hs
@@ -0,0 +1,25 @@
+-----------------------------------------------------------------------------
+-- |
+-- Copyright   : (C) 2015 Dimitri Sabadie
+-- License     : BSD3
+--
+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>
+-- Stability   : experimental
+-- Portability : portable
+--
+-----------------------------------------------------------------------------
+
+module Codec.Wavefront.Normal where
+
+-- |A normal is a 3-floating vector. You can access to its components by pattern matching on them:
+--
+-- @
+--   let Normal nx ny nz = Normal 0.1 0.2 0.3
+-- @
+--
+-- That type is strict and unboxed.
+data Normal = Normal {
+    norX :: {-# UNPACK #-} !Float
+  , norY :: {-# UNPACK #-} !Float
+  , norZ :: {-# UNPACK #-} !Float
+  } deriving (Eq,Show)
diff --git a/src/Codec/Wavefront/Object.hs b/src/Codec/Wavefront/Object.hs
new file mode 100644
index 0000000..15557fe
--- /dev/null
+++ b/src/Codec/Wavefront/Object.hs
@@ -0,0 +1,55 @@
+-----------------------------------------------------------------------------
+-- |
+-- Copyright   : (C) 2015 Dimitri Sabadie
+-- License     : BSD3
+--
+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>
+-- Stability   : experimental
+-- Portability : portable
+--
+-----------------------------------------------------------------------------
+
+module Codec.Wavefront.Object where
+
+import Codec.Wavefront.Element
+import Codec.Wavefront.Face
+import Codec.Wavefront.Lexer ( Ctxt(..) )
+import Codec.Wavefront.Line
+import Codec.Wavefront.Location
+import Codec.Wavefront.Normal
+import Codec.Wavefront.Point
+import Codec.Wavefront.TexCoord
+import Data.DList ( DList, toList )
+import Data.Text ( Text )
+import Data.Vector ( Vector, fromList )
+
+data WavefrontOBJ = WavefrontOBJ {
+    -- |Locations.
+    objLocations :: Vector Location
+    -- |Texture coordinates.
+  , objTexCoords :: Vector TexCoord
+    -- |Normals.
+  , objNormals :: Vector Normal
+    -- |Points.
+  , objPoints :: Vector (Element Point)
+    -- |Lines.
+  , objLines :: Vector (Element Line)
+    -- |Faces.
+  , objFaces :: Vector (Element Face)
+    -- |Material libraries.
+  , objMtlLibs :: Vector Text
+  } deriving (Eq,Show)
+
+ctxtToWavefrontOBJ :: Ctxt -> WavefrontOBJ
+ctxtToWavefrontOBJ ctxt = WavefrontOBJ {
+    objLocations = fromDList (ctxtLocations ctxt)
+  , objTexCoords = fromDList (ctxtTexCoords ctxt)
+  , objNormals = fromDList (ctxtNormals ctxt)
+  , objPoints = fromDList (ctxtPoints ctxt)
+  , objLines = fromDList (ctxtLines ctxt)
+  , objFaces = fromDList (ctxtFaces ctxt)
+  , objMtlLibs = fromDList (ctxtMtlLibs ctxt)
+  }
+
+fromDList :: DList a -> Vector a
+fromDList = fromList . toList
diff --git a/src/Codec/Wavefront/Point.hs b/src/Codec/Wavefront/Point.hs
new file mode 100644
index 0000000..698aeca
--- /dev/null
+++ b/src/Codec/Wavefront/Point.hs
@@ -0,0 +1,18 @@
+-----------------------------------------------------------------------------
+-- |
+-- Copyright   : (C) 2015 Dimitri Sabadie
+-- License     : BSD3
+--
+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>
+-- Stability   : experimental
+-- Portability : portable
+--
+-----------------------------------------------------------------------------
+
+module Codec.Wavefront.Point where
+
+-- |A point is a single index that references the locations. It’s a canonical type that truly
+-- represents a polygonal point.
+data Point = Point {
+    pointLocIndex :: {-# UNPACK #-} !Int
+  } deriving (Eq,Show)
diff --git a/src/Codec/Wavefront/TexCoord.hs b/src/Codec/Wavefront/TexCoord.hs
new file mode 100644
index 0000000..02e5c5a
--- /dev/null
+++ b/src/Codec/Wavefront/TexCoord.hs
@@ -0,0 +1,27 @@
+-----------------------------------------------------------------------------
+-- |
+-- Copyright   : (C) 2015 Dimitri Sabadie
+-- License     : BSD3
+--
+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>
+-- Stability   : experimental
+-- Portability : portable
+--
+-----------------------------------------------------------------------------
+
+module Codec.Wavefront.TexCoord where
+
+-- |A texture coordinate is a 3D-floating vector. You can access to its components by pattern
+-- matching on them:
+--
+-- @
+--   let TexCoord r s t = TexCoord 0.1 0.2 0.3
+-- @
+--
+-- That type is strcit and unboxed.
+data TexCoord = TexCoord {
+    texcoordR :: {-# UNPACK #-} !Float
+  , texcoordS :: {-# UNPACK #-} !Float
+  , texcoordT :: {-# UNPACK #-} !Float
+  } deriving (Eq,Show)
+
diff --git a/src/Codec/Wavefront/Token.hs b/src/Codec/Wavefront/Token.hs
new file mode 100644
index 0000000..76540c9
--- /dev/null
+++ b/src/Codec/Wavefront/Token.hs
@@ -0,0 +1,239 @@
+-----------------------------------------------------------------------------
+-- |
+-- Copyright   : (C) 2015 Dimitri Sabadie
+-- License     : BSD3
+--
+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>
+-- Stability   : experimental
+-- Portability : portable
+--
+-----------------------------------------------------------------------------
+
+module Codec.Wavefront.Token where
+
+import Codec.Wavefront.Face
+import Codec.Wavefront.Line
+import Codec.Wavefront.Location
+import Codec.Wavefront.Normal
+import Codec.Wavefront.Point
+import Codec.Wavefront.TexCoord
+import Control.Applicative ( Alternative(..) )
+import Data.Attoparsec.Text as AP
+import Data.Char ( isSpace )
+import Data.Maybe ( catMaybes )
+import Data.Text ( Text, unpack, strip )
+import qualified Data.Text as T ( empty )
+import Numeric.Natural ( Natural )
+import Prelude hiding ( lines )
+
+----------------------------------------------------------------------------------------------------
+-- Token -------------------------------------------------------------------------------------------
+
+data Token
+  = TknV Location
+  | TknVN Normal
+  | TknVT TexCoord
+  | TknP [Point]
+  | TknL [Line]
+  | TknF Face
+  | TknG [Text]
+  | TknO Text
+  | TknMtlLib [Text]
+  | TknUseMtl Text
+  | TknS Natural
+    deriving (Eq,Show)
+
+-- |A stream of 'Token'.
+type TokenStream = [Token]
+
+tokenize :: Text -> Either String TokenStream
+tokenize = fmap cleanupTokens . analyseResult False . parse (untilEnd tokenizer)
+  where
+    tokenizer = choice
+      [
+        fmap (Just . TknV) location
+      , fmap (Just . TknVN) normal
+      , fmap (Just . TknVT) texCoord
+      , fmap (Just . TknP) points
+      , fmap (Just . TknL) lines
+      , fmap (Just . TknF) face
+      , fmap (Just . TknG) groups
+      , fmap (Just . TknO) object
+      , fmap (Just . TknMtlLib) mtllib
+      , fmap (Just . TknUseMtl) usemtl
+      , fmap (Just . TknS) smoothingGroup
+      , Nothing <$ comment
+      ]
+
+analyseResult :: Bool -> Result [Maybe Token] -> Either String [Maybe Token]
+analyseResult partial r = case r of
+  Done _ tkns -> Right tkns
+  Fail i _ e -> Left $ "`" ++ Prelude.take 10 (unpack i) ++ "` [...]: " ++ e
+  Partial p -> if partial then Left "not completely tokenized" else analyseResult True (p T.empty)
+
+cleanupTokens :: [Maybe Token] -> TokenStream
+cleanupTokens = catMaybes
+
+----------------------------------------------------------------------------------------------------
+-- Location ----------------------------------------------------------------------------------------
+
+location :: Parser Location
+location = skipSpace *> string "v " *> skipHSpace *> parseXYZW <* eol
+  where
+    parseXYZW = do
+      xyz <- float `sepBy1` skipHSpace
+      case xyz of
+        [x,y,z] -> pure (Location x y z 1)
+        [x,y,z,w] -> pure (Location x y z w)
+        [x,y,z,w,r,g] -> pure (Location x y z w) -- TODO: RG-colorspace
+        [x,y,z,w,r,g,b] -> pure (Location x y z w) -- TODO: RGB-colorspace
+        _ -> fail "wrong number of x, y and z arguments for location"
+
+----------------------------------------------------------------------------------------------------
+-- Normal ------------------------------------------------------------------------------------------
+
+normal :: Parser Normal
+normal = skipSpace *> string "vn " *> skipHSpace *> parseIJK <* eol
+  where
+    parseIJK = do
+      ijk <- float `sepBy1` skipHSpace
+      case ijk of
+        [i,j,k] -> pure (Normal i j k)
+        _ -> fail "wrong number of i, j and k arguments for normal"
+
+----------------------------------------------------------------------------------------------------
+-- Texture coordinates -----------------------------------------------------------------------------
+
+texCoord :: Parser TexCoord
+texCoord = skipSpace *> string "vt " *> skipHSpace *> parseUVW <* eol
+  where
+    parseUVW = do
+      uvw <- float `sepBy1` skipHSpace
+      case uvw of
+        [u,v] -> pure (TexCoord u v 0)
+        [u,v,w] -> pure (TexCoord u v w)
+        _ -> fail "wrong number of u, v and w arguments for texture coordinates"
+
+----------------------------------------------------------------------------------------------------
+-- Points ------------------------------------------------------------------------------------------
+
+points :: Parser [Point]
+points = skipSpace *> string "p " *> skipHSpace *> fmap Point decimal `sepBy1` skipHSpace <* eol
+
+----------------------------------------------------------------------------------------------------
+-- Lines -------------------------------------------------------------------------------------------
+lines :: Parser [Line]
+lines = do
+    skipSpace
+    _ <- string "l "
+    skipHSpace
+    pointIndices <- parsePointIndices
+    pts <- case pointIndices of
+      _:_:_ -> pure $ zipWith Line pointIndices (tail pointIndices)
+      _ -> fail "line doesn't have at least two points"
+    eol
+    pure pts
+  where
+    parsePointIndices = fmap (\(i,j) -> LineIndex i j) parseLinePair `sepBy1` skipHSpace
+    parseLinePair = do
+      v <- decimal
+      slashThenElse (fmap (\vt -> (v, Just vt)) decimal) (pure (v,Nothing))
+
+----------------------------------------------------------------------------------------------------
+-- Faces -------------------------------------------------------------------------------------------
+face :: Parser Face
+face = do
+    skipSpace
+    _ <- string "f "
+    skipHSpace
+    faceIndices <- parseFaceIndices
+    f <- case faceIndices of
+      a:b:c:s -> pure (Face a b c s)
+      _ -> fail "face doesn't have at least three points"
+    eol
+    pure f
+  where
+    parseFaceIndices = fmap (\(i,k,j) -> FaceIndex i k j) parseFaceTriple `sepBy1` skipHSpace
+    parseFaceTriple = do
+      v <- decimal
+      slashThenElse (parseVT v) (pure (v,Nothing,Nothing))
+    parseVT v = slashThenElse (parseVN v Nothing) $ do
+      vt <- decimal
+      slashThenElse (parseVN v $ Just vt) (pure (v,Just vt,Nothing))
+    parseVN v vt = do
+      vn <- decimal
+      pure (v,vt,Just vn)
+
+----------------------------------------------------------------------------------------------------
+-- Groups ------------------------------------------------------------------------------------------
+
+groups :: Parser [Text]
+groups = skipSpace *> string "g " *> skipHSpace *> name `sepBy` skipHSpace <* eol
+
+----------------------------------------------------------------------------------------------------
+-- Objects -----------------------------------------------------------------------------------------
+
+object :: Parser Text
+object = skipSpace *> string "o " *> skipHSpace *> spacedName <* eol
+
+----------------------------------------------------------------------------------------------------
+-- Material libraries ------------------------------------------------------------------------------
+
+mtllib :: Parser [Text]
+mtllib = skipSpace *> string "mtllib " *> skipHSpace *> name `sepBy1` skipHSpace <* eol
+
+----------------------------------------------------------------------------------------------------
+-- Using materials ---------------------------------------------------------------------------------
+
+usemtl :: Parser Text
+usemtl = skipSpace *> string "usemtl " *> skipHSpace *> spacedName <* eol
+
+----------------------------------------------------------------------------------------------------
+-- Smoothing groups --------------------------------------------------------------------------------
+smoothingGroup :: Parser Natural
+smoothingGroup = skipSpace *> string "s " *> skipHSpace *> offOrIndex <* skipHSpace <* eol
+  where
+    offOrIndex = string "off" *> pure 0 <|> decimal
+
+----------------------------------------------------------------------------------------------------
+-- Comments ----------------------------------------------------------------------------------------
+comment :: Parser ()
+comment = skipSpace *> string "#" *> (() <$ manyTill anyChar eol)
+
+----------------------------------------------------------------------------------------------------
+-- Special parsers ---------------------------------------------------------------------------------
+
+-- Read a slash ('/') and run the @thenP@ parser on success. Otherwise, call the @elseP@ parser.
+slashThenElse :: Parser a -> Parser a -> Parser a
+slashThenElse thenP elseP = do
+  c <- peekChar
+  case c of
+    Just '/' -> AP.take 1 *> thenP
+    _ -> elseP
+
+-- End of line.
+eol :: Parser ()
+eol = skipMany (satisfy isHorizontalSpace) *> (endOfLine <|> endOfInput)
+
+-- Parse a name (any character but space).
+name :: Parser Text
+name = takeWhile1 $ not . isSpace
+
+spacedName :: Parser Text
+spacedName = strip <$> AP.takeWhile (flip notElem ("\n\r" :: String))
+
+skipHSpace :: Parser ()
+skipHSpace = () <$ AP.takeWhile isHorizontalSpace
+
+float :: Parser Float
+float = fmap realToFrac double
+
+-- Loop a parser and collect its values until we hit the end of the stream. Fails on the first
+-- failure.
+untilEnd :: Parser a -> Parser [a]
+untilEnd p = go
+  where
+    go = do
+      a <- p
+      end <- atEnd
+      if end then pure [a] else fmap (a:) go