From eb13dbaed4a2e6483870f09dfc4e5a7f743e664f Mon Sep 17 00:00:00 2001
From: Joe Crayne <joe@jerkface.net>
Date: Mon, 17 Jun 2019 19:41:06 -0400
Subject: Ord instances + more exports.

---
 src/Wavefront.hs       | 49 +++++++++++++++++++++++++++++++++----------------
 src/Wavefront/Types.hs | 18 +++++++++---------
 2 files changed, 42 insertions(+), 25 deletions(-)

diff --git a/src/Wavefront.hs b/src/Wavefront.hs
index 51a0e6b..2131d96 100644
--- a/src/Wavefront.hs
+++ b/src/Wavefront.hs
@@ -48,12 +48,15 @@ objBookKeeping builder = (lift Rank2.<$> builder)
     , points = \xs -> do
         n <- gets objLocations
         lift $ points builder $ fixupRef n <$> xs
+        incrementCount objPoints $ \x o -> o { objPoints = x }
     , line = \ts -> do
         o <- get
         lift $ line builder $ fixupTriple o <$> ts
+        incrementCount objLines $ \x o -> o { objLines = x }
     , face = \ts -> do
         o <- get
         lift $ face builder $ fixupTriple o <$> ts
+        incrementCount objFaces $ \x o -> o { objFaces = x }
     }
 
 mkv :: [Double] -> Location
@@ -115,26 +118,40 @@ buildOBJ = nullBuilder
         modify $ second $ \e -> e { elSmoothingGroup = fromIntegral x }
     }
 
-parse :: L.ByteString -> OBJ Vector
-parse bs = Rank2.fmap (Vector.fromList . DList.toList) obj
- where
-    b = objBookKeeping buildOBJ
-    ls = OBJ
-            { objLocations = DList.empty
-            , objTexCoords = DList.empty
-            , objNormals   = DList.empty
-            , objPoints    = DList.empty
-            , objLines     = DList.empty
-            , objFaces     = DList.empty
-            , objMtlLibs   = DList.empty
-            }
-    c = Rank2.fmap (const $ Count 0) ls :: OBJ Count
-    el = Element
+blankElement :: Element ()
+blankElement = Element
             { elObject         = Nothing
             , elGroups         = []
             , elMtl            = Nothing
             , elSmoothingGroup = 0
             , elValue          = ()
             }
+
+emptyCounts :: OBJ Count
+emptyCounts = OBJ
+            { objLocations = Count 0
+            , objTexCoords = Count 0
+            , objNormals   = Count 0
+            , objPoints    = Count 0
+            , objLines     = Count 0
+            , objFaces     = Count 0
+            , objMtlLibs   = Count 0
+            }
+
+mzeroOBJ :: MonadPlus m => OBJ m
+mzeroOBJ = OBJ
+            { objLocations = mzero
+            , objTexCoords = mzero
+            , objNormals   = mzero
+            , objPoints    = mzero
+            , objLines     = mzero
+            , objFaces     = mzero
+            , objMtlLibs   = mzero
+            }
+
+parse :: L.ByteString -> OBJ Vector
+parse bs = Rank2.fmap (Vector.fromList . DList.toList) obj
+ where
+    b = objBookKeeping buildOBJ
     substvars = ObjConfig IntMap.empty
-    (obj,_) = execState (runStateT (parseOBJ b substvars bs) c) (ls,el)
+    (obj,_) = execState (runStateT (parseOBJ b substvars bs) emptyCounts) (mzeroOBJ,blankElement)
diff --git a/src/Wavefront/Types.hs b/src/Wavefront/Types.hs
index 564f5d5..2e49ba9 100644
--- a/src/Wavefront/Types.hs
+++ b/src/Wavefront/Types.hs
@@ -84,7 +84,7 @@ data Location = Location {
   , locY :: {-# UNPACK #-} !Float
   , locZ :: {-# UNPACK #-} !Float
   , locW :: {-# UNPACK #-} !Float
-  } deriving (Eq,Show)
+  } deriving (Eq,Ord,Show)
 
 -- | A texture coordinate is a 3D-floating vector. You can access to its
 -- components by pattern matching on them:
@@ -96,7 +96,7 @@ data TexCoord = TexCoord {
     texcoordR :: {-# UNPACK #-} !Float
   , texcoordS :: {-# UNPACK #-} !Float
   , texcoordT :: {-# UNPACK #-} !Float
-  } deriving (Eq,Show)
+  } deriving (Eq,Ord,Show)
 
 
 -- | A normal is a 3-floating vector. You can access to its components by
@@ -109,13 +109,13 @@ data Normal = Normal {
     norX :: {-# UNPACK #-} !Float
   , norY :: {-# UNPACK #-} !Float
   , norZ :: {-# UNPACK #-} !Float
-  } deriving (Eq,Show)
+  } deriving (Eq,Ord,Show)
 
 -- | 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)
+  } deriving (Eq,Ord,Show)
 
 -- | A line index is a pair of indices. @'LineIndex' vi vti@. @vi@ references
 -- the locations and @vti@ indexes the texture coordinates. If @vti ==
@@ -124,14 +124,14 @@ data Point = Point {
 data LineIndex = LineIndex {
     lineLocIndex      :: {-# UNPACK #-} !Int
   , lineTexCoordIndex :: !(Maybe Int)
-  } deriving (Eq,Show)
+  } deriving (Eq,Ord,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)
+  } deriving (Eq,Ord,Show)
 
 -- | 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
@@ -142,11 +142,11 @@ data FaceIndex = FaceIndex {
     faceLocIndex      :: {-# UNPACK #-} !Int
   , faceTexCoordIndex :: !(Maybe Int)
   , faceNorIndex      :: !(Maybe Int)
-  } deriving (Eq,Show)
+  } deriving (Eq,Ord,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)
+data Face = Face FaceIndex FaceIndex FaceIndex [FaceIndex] deriving (Eq,Ord,Show)
 
 pattern Triangle :: FaceIndex -> FaceIndex -> FaceIndex -> Face
 pattern Triangle a b c = Face a b c []
@@ -164,4 +164,4 @@ data Element a = Element {
   , elMtl            :: Maybe Text
   , elSmoothingGroup :: Natural
   , elValue          :: a
-  } deriving (Eq,Show,Functor)
+  } deriving (Eq,Ord,Show,Functor)
-- 
cgit v1.2.3