diff --git a/examples/LoadObject.hs b/examples/LoadObject.hs
--- a/examples/LoadObject.hs
+++ b/examples/LoadObject.hs
@@ -28,6 +28,9 @@
 
 import Graphics.Formats
 import Graphics.Formats.Obj
+
+import Graphics.Rendering.OpenGL
+
 import Codec.Image.DevIL
 
 -- | Load an object at a specified scale and render it.
@@ -36,6 +39,7 @@
   do [file,scale] <- System.getArgs
      ilInit
      simpleInit ("ObjModel: " ++ file)
+     lightModelTwoSide $= Enabled
      dl <- objFromFile file [fst (splitFileName file)] >>= displayListR
      adapt . spinningR (read scale) . renderableG $ dl
 
diff --git a/obj.cabal b/obj.cabal
--- a/obj.cabal
+++ b/obj.cabal
@@ -1,6 +1,6 @@
 Name:                obj
 Cabal-Version:       >= 1.2
-Version:             0.1
+Version:             0.1.1
 Synopsis:            Reads and writes obj models.
 Description:         Reads and writes obj models.
 License:             BSD3
@@ -31,7 +31,8 @@
                         OpenGLCheck       >= 0.1,
                         bytestring        >= 0.9,
                         binary            >= 0.4.2,
-                        Codec-Image-DevIL >= 0.1
+                        Codec-Image-DevIL >= 0.1,
+                        InfixApplicative  >= 1.0
   Hs-Source-Dirs:       src
   Ghc-Options:          -O2
   Exposed-Modules:      Graphics.Formats.Obj
diff --git a/src/Graphics/Formats/Mtl/Contents.hs b/src/Graphics/Formats/Mtl/Contents.hs
--- a/src/Graphics/Formats/Mtl/Contents.hs
+++ b/src/Graphics/Formats/Mtl/Contents.hs
@@ -24,6 +24,7 @@
 import           Data.List
 
 import Graphics.Rendering.OpenGL
+import Control.Applicative
 import Control.Monad
 
 import Test.QuickCheck
@@ -32,10 +33,12 @@
 
 import Codec.Image.DevIL
 
-newtype MtlFile = MF (Map String Material)
+import qualified Data.ByteString.Char8 as CBS
+
+newtype MtlFile = MF (Map CBS.ByteString Material)
                   deriving Show
 
-data Material = Mat {name    :: String
+data Material = Mat {name    :: CBS.ByteString
                     ,matFile :: FilePath
                     ,ambientColour  :: Color4 GLfloat
                     ,diffuseColour  :: Color4 GLfloat
@@ -56,8 +59,8 @@
                                              arbitrary)
                                      arbitrary)
                              (anyList nonSpace))
-                     (anyList nonSpace)
-  coarbitrary m =   coarbitrary (name m)
+                     (CBS.pack <$> anyList nonSpace)
+  coarbitrary m =   coarbitrary (CBS.unpack $ name m)
                   . coarbitrary (matFile m)
                   . coarbitrary (ambientColour  m)
                   . coarbitrary (diffuseColour  m)
@@ -107,7 +110,7 @@
 loadTexture :: FilePath -> IO TextureObject
 loadTexture f = buildTexture =<< readImage f
 
-setName :: Material -> String -> Material
+setName :: Material -> CBS.ByteString -> Material
 setName m n = m {name = n}
 
 setMatFile :: Material -> FilePath -> Material
@@ -132,7 +135,7 @@
 setSpecularTexName m t = m {specularTex = Left t}
 
 emptyMat :: Material
-emptyMat = Mat {name           = ""
+emptyMat = Mat {name           = CBS.pack ""
                ,matFile        = ""
                ,ambientColour  = Color4 0.0 0.0 0.0 0.0
                ,diffuseColour  = Color4 0.0 0.0 0.0 0.0
@@ -142,7 +145,7 @@
                ,specularTex    = Left ""}
 
 whiteMat :: Material
-whiteMat = Mat {name           = "white"
+whiteMat = Mat {name           = CBS.pack "white"
                ,matFile        = ""
                ,ambientColour  = Color4 1   1   1   1
                ,diffuseColour  = Color4 0.5 0.5 0.5 1
diff --git a/src/Graphics/Formats/Mtl/Parse.hs b/src/Graphics/Formats/Mtl/Parse.hs
--- a/src/Graphics/Formats/Mtl/Parse.hs
+++ b/src/Graphics/Formats/Mtl/Parse.hs
@@ -42,7 +42,7 @@
                          put (show b) >> put ' ' >> put (show a)
   get = undefined
 
-buildMap :: [Material] -> M.Map String Material
+buildMap :: [Material] -> M.Map CBS.ByteString Material
 buildMap x = M.fromList $ zip (map name x) x
 
 chunk :: CBS.ByteString -> CBS.ByteString -> [CBS.ByteString]
@@ -58,16 +58,7 @@
   get = undefined
 
 decodeMtl :: CBS.ByteString -> Material
-decodeMtl =   foldr ($) (Mat {name = ""
-                             ,matFile = ""
-                             ,ambientColour  = Color4 0 0 0 1
-                             ,diffuseColour  = Color4 0 0 0 1
-                             ,specularColour = Color4 0 0 0 1
-                             ,ambientTex     = Left ""
-                             ,diffuseTex     = Left ""
-                             ,specularTex    = Left ""})
-            . map decodeLine
-            . CBS.lines
+decodeMtl =   foldr ($) emptyMat . map decodeLine . CBS.lines
 
 decodeLine :: CBS.ByteString -> Material -> Material
 decodeLine = decodeLine' . consumeWS . removeComments
@@ -93,10 +84,10 @@
   else id
 
 colour :: (a -> Color4 GLfloat -> c) -> CBS.ByteString -> a -> c
-colour f = (flip f) . makeColour . bSwords unsafeReadFloat
+colour f = (flip f) . makeColour . map unsafeReadFloat . bsWords
 
 applyTex :: (a -> String -> c) -> CBS.ByteString -> a -> c
-applyTex f = (flip f) . parseName
+applyTex f = (flip f) . CBS.unpack . parseName
 
 makeColour :: [Float] -> Color4 GLfloat
 makeColour [r,g,b]     = Color4 r g b 1
diff --git a/src/Graphics/Formats/Obj.hs b/src/Graphics/Formats/Obj.hs
--- a/src/Graphics/Formats/Obj.hs
+++ b/src/Graphics/Formats/Obj.hs
@@ -30,6 +30,8 @@
 import Graphics.Formats.Mtl.Contents
 import Graphics.Formats.Mtl.Parse    ()
 
+import qualified Data.ByteString.Char8 as CBS
+
 -- | Loads an Obj model from a file given a list of search paths to find
 --   materials and textures at.
 objFromFile :: FilePath -> [FilePath] -> IO ObjModel
@@ -37,7 +39,7 @@
   do -- Parse the obj
      cs <- decodeFile x
      -- Find the material files and parse them too
-     let mtlfs = mtllibs cs
+     let mtlfs = map CBS.unpack $ mtllibs cs
      files <- mapM (findFile sps) mtlfs
      mapM_ (putStrLn . ("Warning: File not found: " ++) . fst)
        . filter ((==Nothing) . snd)
diff --git a/src/Graphics/Formats/Obj/Contents.hs b/src/Graphics/Formats/Obj/Contents.hs
--- a/src/Graphics/Formats/Obj/Contents.hs
+++ b/src/Graphics/Formats/Obj/Contents.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE NoMonomorphismRestriction #-}
-{-# OPTIONS_GHC -Wall #-}
+{-# OPTIONS_GHC -Wall -funbox-strict-fields #-}
 ----------------------------------------------------------------------
 -- |
 -- Module      :  Graphics.Formats.Obj.Contents
@@ -12,7 +12,7 @@
 -- Describes the concrete syntax of an Obj file
 ----------------------------------------------------------------------
 module Graphics.Formats.Obj.Contents
-       (ObjFile(..),Statement(..),VTriple,VDouble
+       (ObjFile(..),Statement(..),VTriple(..),VDouble(..)
        ,isVertex,isNormal,isTexCoord
        ,isPoints,isLines,isFace,isObject
        ,isUseMtl,isSmoothG
@@ -23,8 +23,9 @@
 
 import Control.Monad
 import Control.Applicative
+import Control.Applicative.Infix
 
-import Data.Char
+import qualified Data.ByteString.Char8 as CBS
 
 newtype ObjFile = OF [Statement]
                   deriving (Show,Eq)
@@ -33,21 +34,23 @@
   arbitrary = liftM OF arbitrary
   coarbitrary (OF x) = coarbitrary x
 
-data Statement = V  Float Float Float Float
-               | VN Float Float Float
-               | VT Float Float Float
-               | P [Int]
-               | L [VDouble]
-               | F [VTriple]
-               | G [Group]
-               | SG (Maybe Int)
-               | MtlLib [String]
-               | UseMtl String
+data Statement = V  !Float !Float !Float !Float
+               | VN !Float !Float !Float
+               | VT !Float !Float !Float
+               | P ![Int]
+               | L ![VDouble]
+               | F ![VTriple]
+               | G ![Group]
+               | SG !Int
+               | MtlLib ![CBS.ByteString]
+               | UseMtl !CBS.ByteString
                  deriving (Show,Read,Eq)
 
-type VTriple = (Int, Maybe Int, Maybe Int)
-type VDouble = (Int, Maybe Int)
-type Group   = String
+data VTriple = VTr !Int !(Maybe Int) !(Maybe Int)
+               deriving (Eq,Ord,Show,Read)
+data VDouble = VD  !Int !(Maybe Int)
+               deriving (Eq,Ord,Show,Read)
+type Group   = CBS.ByteString
 
 instance Arbitrary Statement where
   arbitrary =
@@ -55,12 +58,10 @@
           ,VN <$> arbitrary <*> arbitrary <*> arbitrary
           ,VT <$> arbitrary <*> arbitrary <*> arbitrary
           ,P  <$> (nonEmpty nonZero_)
-          ,L  <$> (nonEmpty (nonZero_ >*< (maybeGen nonZero_)))
-          ,F  <$> (nonEmpty ((>**<) nonZero_
-                                    (maybeGen nonZero_)
-                                    (maybeGen nonZero_)))
-          ,G  <$> (nonEmpty (nonEmpty (notOneof " \t\n\r#")))
-          ,SG <$> (maybeGen positive)]
+          ,L  <$> (nonEmpty arbitrary)
+          ,F  <$> (nonEmpty arbitrary)
+          ,(G . map CBS.pack) <$> (nonEmpty (nonEmpty (notOneof " \t\n\r#")))
+          ,SG <$> positive]
   coarbitrary (V x y z w) =
     coarbitrary x . coarbitrary y . coarbitrary z . coarbitrary w
   coarbitrary (VN x y z)  =
@@ -70,11 +71,19 @@
   coarbitrary (P n)       = coarbitrary n
   coarbitrary (L n)       = coarbitrary n
   coarbitrary (F n)       = coarbitrary n
-  coarbitrary (G n)       = coarbitrary n
+  coarbitrary (G n)       = coarbitrary (map CBS.unpack n)
   coarbitrary (SG g)      = coarbitrary g
-  coarbitrary (UseMtl xs) = coarbitrary xs
-  coarbitrary (MtlLib x)  = coarbitrary x
+  coarbitrary (UseMtl xs) = coarbitrary (CBS.unpack xs)
+  coarbitrary (MtlLib x)  = coarbitrary (map CBS.unpack x)
   
+instance Arbitrary VTriple where
+  arbitrary = VTr <$> positive <*> maybeGen positive <*> maybeGen positive
+  coarbitrary (VTr v t n) = coarbitrary v . coarbitrary t . coarbitrary n
+
+instance Arbitrary VDouble where
+  arbitrary = VD <$> positive <*> maybeGen positive
+  coarbitrary (VD v t) = coarbitrary v . coarbitrary t
+
 isNormal :: Statement -> Bool
 isNormal (VN _ _ _) = True
 isNormal _ = False
@@ -100,7 +109,7 @@
 isFace _ = False
 
 isObject :: Statement -> Bool
-isObject = liftA2 (||) isFace (liftA2 (||) isLines isPoints)
+isObject = isFace <^(||)^> isLines <^(||)^> isPoints
 
 isUseMtl :: Statement -> Bool
 isUseMtl (UseMtl _) = True
diff --git a/src/Graphics/Formats/Obj/ObjModel.hs b/src/Graphics/Formats/Obj/ObjModel.hs
--- a/src/Graphics/Formats/Obj/ObjModel.hs
+++ b/src/Graphics/Formats/Obj/ObjModel.hs
@@ -1,5 +1,5 @@
-{-# LANGUAGE NoMonomorphismRestriction #-}
-{-# OPTIONS_GHC -Wall #-}
+{-# LANGUAGE NoMonomorphismRestriction, TypeSynonymInstances #-}
+{-# OPTIONS_GHC -Wall -funbox-strict-fields #-}
 ----------------------------------------------------------------------
 -- |
 -- Module      :  Graphics.Formats.Obj.ObjModel
@@ -15,11 +15,11 @@
        (geometryTests
        ,ObjModel()
        ,geometry,objFile
+       ,renderONormals
        ) where
 
 import Graphics.Formats
 import Graphics.Formats.Obj.Contents
-import Graphics.Formats.Obj.ParserBits (anyOf)
 import Graphics.Formats.Mtl.Contents
 
 import Graphics.Rendering.OpenGL
@@ -31,32 +31,37 @@
 import Data.List
 import Data.Array
 import Data.Function
-import           Data.Map    (Map)
-import qualified Data.Map as M
+import qualified Data.Map    as M
+import           Data.IntMap    (IntMap)
+import qualified Data.IntMap as IM
 
 import Control.Monad
 import Control.Applicative
 
-data ObjModel = OM BufferSet [Object]
+data ObjModel = OM BufferSet [FObject]
                    deriving (Show)
 
 type BufferSet = (VertexBuffer, TexCoordBuffer, NormalBuffer)
+data NVTriple = NVT !Int !(Maybe Int) !Int
+                deriving (Eq, Ord, Show)
 
 type VertexBuffer   = Array Int (Vertex4   GLfloat)
 type TexCoordBuffer = Array Int (TexCoord2 GLfloat)
 type NormalBuffer   = Array Int (Normal3   GLfloat)
 
-data Object = OFace     Material [VTriple]
-            | OQuad     Material [VTriple]
-            | OTriangle Material [VTriple]
-            | OLine              [VDouble]
-            | OPoint             [Int]
-              deriving (Show,Eq,Ord)
+data Object a = OFace     Material [a]
+              | OQuad     Material [a]
+              | OTriangle Material [a]
+              | OLine              [VDouble]
+              | OPoint             [Int]
+                  deriving (Show,Eq,Ord)
+type FObject = Object NVTriple
+type IObject = Object VTriple
 
 instance EqProp ObjModel where
   m =-= m' = property (normalForm m == normalForm m')
 
-normalForm :: ObjModel -> (BufferSet,[Object])
+normalForm :: ObjModel -> (BufferSet,[FObject])
 normalForm (OM (vb,tb,nb) os) =
   let lb = fst . bounds
       ub = snd . bounds
@@ -79,23 +84,13 @@
   coarbitrary (OM (v,t,n) os) =
     coarbitrary v . coarbitrary t . coarbitrary n . coarbitrary os
 
-instance Arbitrary Object where
-  arbitrary = oneof [OFace     <$> (return whiteMat)
-                               <*> (nonEmpty 
-                                     ((>**<) positive (maybeGen positive)
-                                                      (maybeGen positive)))
+instance Arbitrary (FObject) where
+  arbitrary = oneof [OFace     <$> (return whiteMat) <*> (nonEmpty arbitrary)
                     ,OTriangle <$> (return whiteMat)
-                               <*> (setLength 3
-                                              ((>**<) positive
-                                                      (maybeGen positive)
-                                                      (maybeGen positive)))
+                               <*> (setLength 3 arbitrary)
                     ,OQuad     <$> (return whiteMat)
-                               <*> (setLength 4
-                                              ((>**<) positive
-                                                      (maybeGen positive)
-                                                      (maybeGen positive)))
-                    ,OLine     <$> (nonEmpty
-                                     (positive >*< (maybeGen positive)))
+                               <*> (setLength 4 arbitrary)
+                    ,OLine     <$> (nonEmpty arbitrary)
                     ,OPoint    <$> (nonEmpty positive)]
   coarbitrary (OFace     _ n) = coarbitrary n
   coarbitrary (OTriangle _ n) = coarbitrary n
@@ -103,16 +98,20 @@
   coarbitrary (OLine       n) = coarbitrary n
   coarbitrary (OPoint      n) = coarbitrary n
 
+instance Arbitrary NVTriple where
+  arbitrary = NVT <$> positive <*> maybeGen positive <*> positive
+  coarbitrary (NVT v t n) = coarbitrary v . coarbitrary t . coarbitrary n
+
 instance Renderable ObjModel where
   render (OM bs os) = 
     let (textured,unTextured) = partition isTextured os
         texturedGroups =   groupBy ((==)    `on` texID)
                          . sortBy  (compare `on` texID)
                          $ textured
-    in do colorMaterial $= Just (FrontAndBack, AmbientAndDiffuse)
+    in do colorMaterial $= Just (Front, AmbientAndDiffuse)
           mapM_ (renderOs bs) (unTextured:texturedGroups)
 
-renderOs :: BufferSet -> [Object] -> IO ()
+renderOs :: BufferSet -> [FObject] -> IO ()
 renderOs bs os =
   case os of
     []    -> return ()
@@ -120,23 +119,27 @@
                 renderList bs (filter isTriangle os) Triangles
                 renderList bs (filter isQuad     os) Quads
                 mapM_ (renderObject bs) (filter isPolygon os)
+{-                setColour (Color4 (0.0 :: GLfloat) 1.0 0.0 1.0)
+                          (Color4 (0.0 :: GLfloat) 1.0 0.0 1.0)
+                          (Color4 (0.0 :: GLfloat) 1.0 0.0 1.0)
+                mapM_ (renderONormals bs) os-}
 
-material :: Object -> Maybe Material
+material :: Object a -> Maybe Material
 material (OFace     m _) = Just m
 material (OTriangle m _) = Just m
 material (OQuad     m _) = Just m
 material _               = Nothing
 
-points :: Object -> Maybe [VTriple]
+points :: Object a -> Maybe [a]
 points (OFace     _ ps) = Just ps
 points (OTriangle _ ps) = Just ps
 points (OQuad     _ ps) = Just ps
 points _                = Nothing
 
-faceTexture :: Object -> Either String TextureObject
+faceTexture :: Object a -> Either String TextureObject
 faceTexture = maybe (Left "") diffuseTex . material
 
-faceColour :: Object -> IO ()
+faceColour :: Object a -> IO ()
 faceColour f = 
   either (const (setColour (ambientColour  m)
                            (diffuseColour  m)
@@ -148,31 +151,31 @@
   where
     m = maybe (error "Face has no material") id $ material f
 
-texID :: Object -> GLuint
+texID :: Object a -> GLuint
 texID = either (const 0) unTexObj . faceTexture
         where
           unTexObj (TextureObject x) = x
 
-setTexturing :: Object -> IO ()
+setTexturing :: Object a -> IO ()
 setTexturing o =
   case faceTexture o of
     Left _  ->    texture        Texture2D $= Disabled
     Right t -> do texture        Texture2D $= Enabled
                   textureBinding Texture2D $= Just t
 
-isTextured :: Object -> Bool
+isTextured :: Object a -> Bool
 isTextured = either (const False) (const True) . faceTexture
 
-renderList :: BufferSet -> [Object] -> PrimitiveMode -> IO ()
+renderList :: BufferSet -> [FObject] -> PrimitiveMode -> IO ()
 renderList  bs x f =
   do renderPrimitive f $ forM_ x (renderCalls bs)
 
-renderCalls :: BufferSet -> Object -> IO ()
+renderCalls :: BufferSet -> FObject -> IO ()
 renderCalls bs f =
   do faceColour f
      maybe (return ()) (mapM_ (renderOperation3 bs)) $ points f
 
-renderObject :: BufferSet -> Object -> IO ()
+renderObject :: BufferSet -> FObject -> IO ()
 renderObject bs (OFace     _ ps) = 
   renderPrimitive Polygon   $ forM_ ps (renderOperation3 bs)
 renderObject bs (OTriangle _ ps) =
@@ -184,46 +187,57 @@
 renderObject bs (OPoint      ps) =
   renderPrimitive Points    $ forM_ ps (renderOperation1 bs)
 
-renderOperation3 :: BufferSet -> VTriple -> IO ()
-renderOperation3 (vs,ts,ns) (v,t,n) =
-  let nop = maybe top ((>> top) . normal   . (ns !)) n
+renderOperation3 :: BufferSet -> NVTriple -> IO ()
+renderOperation3 (vs,ts,ns) (NVT v t n) =
+  let nop = normal (ns ! n) >> top
+            {-color ((\(Normal3 x y z) -> Color4 (clip x) (clip y) (clip z) 1.0) (ns ! n)) >> top -}
       top = maybe vop ((>> vop) . texCoord . (ts !)) t
       vop = vertex (vs ! v)
   in nop
 
+{-clip :: GLfloat -> GLfloat
+clip x = let v = (x + 1.0 / 2)
+         in (if v < 0 then 0 else if v > 1 then 1 else v)-}
+
 renderOperation2 :: BufferSet -> VDouble -> IO ()
-renderOperation2 bs (v,t) = renderOperation3 bs (v,Nothing,t)
+renderOperation2 (vs,ts,_) (VD v t) =
+  let top = maybe vop ((>> vop) . texCoord . (ts !)) t
+      vop = vertex (vs ! v)
+  in top
 
 renderOperation1 :: BufferSet -> Int -> IO ()
-renderOperation1 bs v = renderOperation3 bs (v,Nothing,Nothing)
-     
-isTriangle :: Object -> Bool
+renderOperation1 bs v = renderOperation2 bs (VD v Nothing)
+
+isTriangle :: Object a -> Bool
 isTriangle (OTriangle _ _) = True
 isTriangle _               = False
 
-isQuad :: Object -> Bool
+isQuad :: Object a -> Bool
 isQuad (OQuad _ _ ) = True
 isQuad _            = False
 
-isPolygon :: Object -> Bool
+isPolygon :: Object a -> Bool
 isPolygon (OFace _ _) = True
 isPolygon _           = False
 
 setColour :: (ColorComponent a, ColorComponent b, ColorComponent c) =>
              Color4 a -> Color4 b -> Color4 c -> IO ()
 setColour _ d _ = color d
-{-  do materialAmbient  FrontAndBack $= a
-       materialDiffuse  FrontAndBack $= d
-       materialSpecular FrontAndBack $= s -}
+{-  do materialAmbient  Front $= a
+       materialDiffuse  Front $= d
+       materialSpecular Front $= s -}
 
-{-renderNormals :: BufferSet -> VTriple -> IO ()
-renderNormals (vs,_,ns) (v,_,n) =
-  case n of
-    Just n' -> vertex (vs ! v) >> vertex ((vs ! v) ..+^^ (ns ! n'))
-    Nothing -> return ()
+renderONormals :: BufferSet -> FObject -> IO ()
+renderONormals bs o =
+  maybe (return ())
+        (renderPrimitive Lines . mapM_ (renderNormals bs)) $ points o
 
+renderNormals :: BufferSet -> NVTriple -> IO ()
+renderNormals (vs,_,ns) (NVT v _ n) =
+  vertex (vs ! v) >> vertex ((vs ! v) ..+^^ (ns ! n))
+
 (..+^^) :: Vertex4 GLfloat -> Normal3 GLfloat -> Vertex4 GLfloat
-(..+^^) (Vertex4 x y z w) (Normal3 i j k) = Vertex4 (x+i) (y+j) (z+k) w-}
+(..+^^) (Vertex4 x y z w) (Normal3 i j k) = Vertex4 (x+i) (y+j) (z+k) w
 
 geometry :: ObjFile -> MtlFile -> ObjModel
 geometry (OF f) mtls =
@@ -234,43 +248,47 @@
     texCoordBuffer = listArray (1,length texCoordList  ) texCoordList
     vertexList     = map vToVertex    . filter isVertex   $ f
     normalList     = map vnToNormal   . filter isNormal   $ f
-    fullNormalList = normalList ++ concat newNormals
+    fullNormalList = sNormalList ++ unsmoothedNormals
+    sNormalList    = normalList ++ smoothedNormals
     texCoordList   = map vtToTexCoord . filter isTexCoord $ f
     bs             = (vertexBuffer,texCoordBuffer,normalBuffer)
-    unsmoothedObjects = maybe [] id (M.lookup Nothing objects)
-    (smoothedObjects,newNormals,_) =
-      foldr (smoothGroup vertexBuffer)
-            ([],[],length normalList + 1)
-            smoothingGroups
-    smoothingGroups = M.elems . M.filterWithKey (\k _ -> k /= Nothing)
-                              $ objects
-    objects = fst6 $ foldl (addObj mtls)
-                           (M.empty,whiteMat,Nothing,1,1,1)
-                           (filter (anyOf [isNormal,isTexCoord,isVertex
-                                          ,isObject,isUseMtl,isSmoothG]) f)
 
+    unsmoothedGroup = maybe [] id (IM.lookup 0 objects)
+    (unsmoothedObjects,unsmoothedNormals,numNormals) =
+      foldl' (objectNormals (length sNormalList + numNormals + 1) vertexBuffer)
+             ([],[],0)
+             unsmoothedGroup
+
+    smoothingGroups = IM.elems . IM.filterWithKey (\k _ -> k /= 0) $ objects
+    (smoothedObjects,smoothedNormals,numsNormals) =
+      foldl' (smoothGroup (length normalList + numsNormals + 1) vertexBuffer)
+             ([],[],0)
+             smoothingGroups
+
+    objects = fst6 $ foldl' (addObj mtls) (IM.empty,whiteMat,0,1,1,1) f
+
 fst6 :: (a,b,c,d,e,f) -> a
 fst6 (x,_,_,_,_,_) = x
 
 addObj :: MtlFile
-       -> (Map (Maybe Int) [Object],Material,Maybe Int,Int,Int,Int)
+       -> (IntMap [IObject],Material,Int,Int,Int,Int)
        -> Statement
-       -> (Map (Maybe Int) [Object],Material,Maybe Int,Int,Int,Int)
+       -> (IntMap [IObject],Material,Int,Int,Int,Int)
 addObj (MF mtls) (os,_,sg,vc,nc,tc) (UseMtl m) =
   maybe (error ("Material not found: " ++ show m))
         (\mtl' -> (os,mtl',sg,vc,nc,tc))
         (M.lookup m mtls)
 addObj _   (os,cm,sg,vc,nc,tc) (P ps) =
-  (M.insertWith (++) sg [OPoint (map (mkAbs vc) ps)] os, cm,sg,vc,nc,tc)
+  (IM.insertWith (++) sg [OPoint (map (mkAbs vc) ps)] os, cm,sg,vc,nc,tc)
 addObj _   (os,cm,sg,vc,nc,tc) (L ps) =
-  (M.insertWith (++) sg [OLine (absoluteRefs2 vc tc ps)] os, cm,sg,vc,nc,tc)
+  (IM.insertWith (++) sg [OLine (absoluteRefs2 vc tc ps)] os, cm,sg,vc,nc,tc)
 addObj _   (os,cm,sg,vc,nc,tc) (F ps) =
   case length ps of
-    3 -> (M.insertWith (++) sg [OTriangle cm (absoluteRefs3 vc nc tc ps)] os
+    3 -> (IM.insertWith (++) sg [OTriangle cm (absoluteRefs3 vc nc tc ps)] os
          ,cm,sg,vc,nc,tc)
-    4 -> (M.insertWith (++) sg [OQuad     cm (absoluteRefs3 vc nc tc ps)] os
+    4 -> (IM.insertWith (++) sg [OQuad     cm (absoluteRefs3 vc nc tc ps)] os
          ,cm,sg,vc,nc,tc)
-    _ -> (M.insertWith (++) sg [OFace     cm (absoluteRefs3 vc nc tc ps)] os
+    _ -> (IM.insertWith (++) sg [OFace     cm (absoluteRefs3 vc nc tc ps)] os
          ,cm,sg,vc,nc,tc)
 addObj _   (os,cm,sg,vc,nc,tc) (V _ _ _ _) = (os,cm,sg,vc+1,nc  ,tc  )
 addObj _   (os,cm,sg,vc,nc,tc) (VN _ _ _)  = (os,cm,sg,vc  ,nc+1,tc  )
@@ -278,40 +296,64 @@
 addObj _   (os,cm,_ ,vc,nc,tc) (SG s)      = (os,cm,s ,vc  ,nc  ,tc  )
 addObj _   (os,cm,sg,vc,nc,tc) _           = (os,cm,sg,vc  ,nc  ,tc  )
 
-smoothGroup :: VertexBuffer -> [Object]
-                            -> ([Object],[[Normal3 GLfloat]],Int)
-                            -> ([Object],[[Normal3 GLfloat]],Int)
-smoothGroup vb g (os,ns,nns) =
-  (gos ++ os,gns : ns, nns + (length gns))
+objectNormals :: Int -> VertexBuffer -> ([FObject],[Normal3 GLfloat],Int)
+                                     -> IObject
+                                     -> ([FObject],[Normal3 GLfloat],Int)
+objectNormals loff vb (os,ns,nns) o =
+  (go : os,  gns ++ ns, nns + vl)
   where
+    go = applyNormals normalMap o
+    normalMap = IM.fromList $ zip vs [(loff - nns - vl)..]
+    gns =   map (normalise . uncurry (flip crossProduct) . createVectors)
+          . take vl
+          . makeTripples
+          . map (vb !)
+          . drop (vl - 1)
+          . cycle
+          $ vs
+    vl = length vs
+    vs = objVerticies o
+    makeTripples (x:y:z:xs) = (x,y,z) : makeTripples (y:z:xs)
+    makeTripples _ = error "not enough elements in list for makeTriples."
+
+smoothGroup :: Int -> VertexBuffer -> ([FObject],[Normal3 GLfloat],Int)
+                                   -> [IObject]
+                                   -> ([FObject],[Normal3 GLfloat],Int)
+smoothGroup loff vb (os,ns,nns) g =
+  (gos ++ os,gns ++ ns, nns + lgn)
+  where
     gos = map (applyNormals normalMap) g
-    normalMap = M.fromList $ zip vs [nns..]
+    normalMap = IM.fromList $ zip vs [(loff - nns - lgn)..]
     gns = map (makeNormal vb g) vs
+    lgn = length gns
     vs = concatMap objVerticies g
 
-applyNormals :: Map Int Int -> Object -> Object
+applyNormals :: IntMap Int -> IObject -> FObject
 applyNormals m (OFace     mat vs) = OFace     mat (appNorms m vs)
 applyNormals m (OTriangle mat vs) = OTriangle mat (appNorms m vs)
 applyNormals m (OQuad     mat vs) = OQuad     mat (appNorms m vs)
-applyNormals _ x                  = x
+applyNormals _ (OLine         vs) = OLine  vs
+applyNormals _ (OPoint        vs) = OPoint vs
 
-appNorms :: Map Int Int -> [VTriple] -> [VTriple]
-appNorms m vs = map (\(v,t,n) -> case n of
-                                   Just _  -> (v,t,n           )
-                                   Nothing -> (v,t,M.lookup v m))
-                    vs
+appNorms :: IntMap Int -> [VTriple] -> [NVTriple]
+appNorms m vs =
+  map (\(VTr v t n) -> case n of
+                         Just n' -> NVT v t n'
+                         Nothing -> case v `IM.lookup` m of
+                                      Just n' -> NVT v t n'
+                                      Nothing -> error "Didn't gen normal")
+      vs
 
-makeNormal :: VertexBuffer -> [Object] -> Int -> Normal3 GLfloat
+makeNormal :: VertexBuffer -> [IObject] -> Int -> Normal3 GLfloat
 makeNormal vb os =
- uncurry3 Normal3 . averageVec
-                   . map (uncurry crossProduct . createVectors
-                                               . lookupVerticies vb)
-                   . (findVertexNeighbors os)
+  averageVec . map (uncurry (flip crossProduct) . createVectors
+                                                . lookupVerticies vb)
+             . (findVertexNeighbors os)
   where
-    findVertexNeighbors :: [Object] -> Int -> [(Int,Int,Int)]
+    findVertexNeighbors :: [IObject] -> Int -> [(Int,Int,Int)]
     findVertexNeighbors objs v = foldr (findVertexPair v) [] objs
     
-    findVertexPair :: Int -> Object -> [(Int,Int,Int)] -> [(Int,Int,Int)]
+    findVertexPair :: Int -> IObject -> [(Int,Int,Int)] -> [(Int,Int,Int)]
     findVertexPair v (OFace     _ vtripples) x = findVP v vtripples x
     findVertexPair v (OTriangle _ vtripples) x = findVP v vtripples x
     findVertexPair v (OQuad     _ vtripples) x = findVP v vtripples x
@@ -335,33 +377,41 @@
                     -> (Vertex4 GLfloat,Vertex4 GLfloat,Vertex4 GLfloat)
     lookupVerticies buff (a,b,c) = (buff ! a, buff ! b, buff ! c)
     
-    createVectors :: (Vertex4 GLfloat,Vertex4 GLfloat,Vertex4 GLfloat)
-                  -> ((GLfloat,GLfloat,GLfloat),(GLfloat,GLfloat,GLfloat))
-    createVectors (a,b,c) = (a .-. b,c .-. b)
-    
-    crossProduct :: Num a => (a,a,a) -> (a,a,a) -> (a,a,a)
-    crossProduct (x,y,z) (x',y',z') =
-      (y * z' - z * y', z * x' - x * z', x * y' - y * x')
-    
-    averageVec :: Floating a => [(a,a,a)] -> (a,a,a)
-    averageVec [] = error "Average vectors: no vectors to average."
-    averageVec xs = normalise ((sumVec (map normalise xs)) ^/ (fromIntegral $ length xs))
-    
-    normalise :: Floating a => (a,a,a) -> (a,a,a)
-    normalise x = x ^/ (mag x)
-    
-    sumVec = foldr1 (^+^)
-    
-    mag (x,y,z) = sqrt (x * x + y * y + z * z)
-    
-    (^+^) (x,y,z) (x',y',z') = (x + x', y + y', z + z')
-    (.-.) (Vertex4 x y z w) (Vertex4 x' y' z' w') = 
-      (x * w - x' * w', y * w - y' * w', z * w - z' * w')
-    
-    v ^/ s = v ^* (1 / s)
-    (x,y,z) ^* s = (x * s, y * s, z * s)
+createVectors :: (Vertex4 GLfloat,Vertex4 GLfloat,Vertex4 GLfloat)
+              -> (Normal3 GLfloat,Normal3 GLfloat)
+createVectors (a,b,c) = (a .-. b,c .-. b)
 
-objVerticies :: Object -> [Int]
+crossProduct :: Num a => Normal3 a -> Normal3 a -> Normal3 a
+crossProduct (Normal3 x y z) (Normal3 x' y' z') =
+  Normal3 (y * z' - z * y') (z * x' - x * z') (x * y' - y * x')
+
+averageVec :: Floating a => [Normal3 a] -> Normal3 a
+averageVec [] = error "Average vectors: no vectors to average."
+averageVec xs = normalise (   (sumVec (map normalise xs))
+                           ^/ (fromIntegral $ length xs))
+
+normalise :: Floating a => Normal3 a -> Normal3 a
+normalise x = x ^/ (mag x)
+
+sumVec :: Num a => [Normal3 a] -> Normal3 a
+sumVec = foldr1 (^+^)
+
+mag :: Floating a => Normal3 a -> a
+mag (Normal3 x y z) = sqrt (x * x + y * y + z * z)
+
+(^+^) :: Num a => Normal3 a -> Normal3 a -> Normal3 a
+(^+^) (Normal3 x y z) (Normal3 x' y' z') =
+  Normal3 (x + x') (y + y') (z + z')
+(.-.) :: Num a => Vertex4 a -> Vertex4 a -> Normal3 a
+(.-.) (Vertex4 x y z w) (Vertex4 x' y' z' w') =
+  Normal3 (x * w - x' * w') (y * w - y' * w') (z * w - z' * w')
+
+(^/) :: Floating a => Normal3 a -> a -> Normal3 a
+v ^/ s = v ^* (1 / s)
+(^*) :: Num a => Normal3 a -> a -> Normal3 a
+(Normal3 x y z) ^* s = Normal3 (x * s) (y * s) (z * s)
+
+objVerticies :: IObject -> [Int]
 objVerticies (OFace     _ vs) = map trippleVertex vs
 objVerticies (OTriangle _ vs) = map trippleVertex vs
 objVerticies (OQuad     _ vs) = map trippleVertex vs
@@ -370,42 +420,35 @@
 mkAbs :: Int -> Int -> Int
 mkAbs c x = if x < 0 then c+x else x
 
-absoluteRefs2 :: Int -> Int -> [(Int,Maybe Int)] -> [(Int,Maybe Int)]
+absoluteRefs2 :: Int -> Int -> [VDouble] -> [VDouble]
 absoluteRefs2 c c' =
-  uncurry zip . (\(x,y) -> (map (mkAbs c) x
-                           ,map (liftM (mkAbs c')) y)) . unzip
+  map (\(VD x y) -> VD (mkAbs c x) (mkAbs c' <$> y))
 
-absoluteRefs3 :: Int -> Int -> Int -> [(Int,Maybe Int,Maybe Int)]
-                                   -> [(Int,Maybe Int,Maybe Int)]
+absoluteRefs3 :: Int -> Int -> Int -> [VTriple] -> [VTriple]
 absoluteRefs3 c c' c'' =
-  uncurry3 zip3 . (\(x,y,z) -> (map (mkAbs c) x
-                               ,map (liftM (mkAbs c')) y
-                               ,map (liftM (mkAbs c'')) z)) . unzip3
-
-uncurry3 :: (a -> b -> c -> d) -> (a,b,c) -> d
-uncurry3 f (x,y,z) = f x y z
+  map (\(VTr x y z) -> VTr (mkAbs c x) (mkAbs c' <$> y) (mkAbs c'' <$> z))
 
-trippleVertex :: (Int,Maybe Int,Maybe Int) -> Int
-trippleVertex (v,_,_) = v
+trippleVertex :: VTriple -> Int
+trippleVertex (VTr v _ _) = v
 
-offsetObjects :: Int -> Int -> Int -> [Object] -> [Object]
+offsetObjects :: Int -> Int -> Int -> [FObject] -> [FObject]
 offsetObjects vo no to = map (offsetObj vo no to)
-offsetObj :: Int -> Int -> Int -> Object -> Object
-offsetObj vo no to (OFace    m ts) =
-  OFace m     $ map (\(x,y,z) -> (x-vo
-                                 ,y >>= return . ((flip (-)) no)
-                                 ,z >>= return . ((flip (-)) to))) ts
+offsetObj :: Int -> Int -> Int -> FObject -> FObject
+offsetObj vo to no (OFace    m ts) =
+  OFace m     $ map (\(NVT v t n) -> NVT (v-vo)
+                                         (t >>= return . ((flip (-)) to))
+                                         (n-no)) ts
 offsetObj vo no to (OTriangle m ts) =
-  OTriangle m $ map (\(x,y,z) -> (x-vo
-                                 ,y >>= return . ((flip (-)) no)
-                                 ,z >>= return . ((flip (-)) to))) ts
+  OTriangle m $ map (\(NVT v t n) -> NVT (v-vo)
+                                         (t >>= return . ((flip (-)) to))
+                                         (n-no)) ts
 offsetObj vo no to (OQuad     m ts) =
-  OQuad m     $ map (\(x,y,z) -> (x-vo
-                                 ,y >>= return . ((flip (-)) no)
-                                 ,z >>= return . ((flip (-)) to))) ts
+  OQuad m     $ map (\(NVT v t n) -> NVT (v-vo)
+                                         (t >>= return . ((flip (-)) to))
+                                         (n-no)) ts
 offsetObj vo _  to (OLine       ts) =
-  OLine $ map (\(x,z) -> (x-vo
-                         ,z >>= return . ((flip (-)) to))) ts
+  OLine $ map (\(VD v t) -> VD (v-vo)
+                               (t >>= return . ((flip (-)) to))) ts
 offsetObj vo _  _  (OPoint      ts) =
   OPoint $ map ((flip (-)) vo) ts
 
@@ -419,12 +462,14 @@
     writeBuffer :: (a -> Statement) -> Array Int a -> [Statement]
     writeBuffer f b =
       map f $ elems b
-    writeObject :: Object -> Statement
-    writeObject (OFace     _ fs) = F fs
-    writeObject (OTriangle _ fs) = F fs
-    writeObject (OQuad     _ fs) = F fs
+    writeObject :: FObject -> Statement
+    writeObject (OFace     _ fs) = F (map nvToVTriple fs)
+    writeObject (OTriangle _ fs) = F (map nvToVTriple fs)
+    writeObject (OQuad     _ fs) = F (map nvToVTriple fs)
     writeObject (OLine ls)       = L ls
     writeObject (OPoint ps)      = P ps
+    
+    nvToVTriple (NVT v t n) = VTr v t (Just n)
 
 vnToNormal :: Statement -> Normal3 GLfloat
 vnToNormal (VN i j k)   = Normal3 i j k
diff --git a/src/Graphics/Formats/Obj/Parse.hs b/src/Graphics/Formats/Obj/Parse.hs
--- a/src/Graphics/Formats/Obj/Parse.hs
+++ b/src/Graphics/Formats/Obj/Parse.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}
+{-# OPTIONS_GHC -Wall -fno-warn-orphans -funbox-strict-fields #-}
 ----------------------------------------------------------------------
 -- |
 -- Module      :  Graphics.Formats.Obj.Parse
@@ -60,15 +60,13 @@
        putShow y >> put ' '
        putShow z >> put ' '
        put '\n'
-  put (P is) = put 'p'  >> putList putShow   is >> put '\n'
-  put (L is) = put 'l'  >> putList putDouble is >> put '\n'
-  put (F is) = put 'f'  >> putList putTriple is >> put '\n'
-  put (G gs) = put 'g'  >> putList putString gs >> put '\n'
-  put (SG g) = putString "s " >> case g of
-                                   Nothing -> putString "0\n"
-                                   Just x  -> putShow x >> put '\n'
-  put (MtlLib m) = put "mtllib"  >> putList putString m >> put '\n'
-  put (UseMtl m) = put "usemtl " >> putString m         >> put '\n'
+  put (P is) = put 'p'  >> putList putShow   is     >> put '\n'
+  put (L is) = put 'l'  >> putList putDouble is     >> put '\n'
+  put (F is) = put 'f'  >> putList putTriple is     >> put '\n'
+  put (G gs) = put 'g'  >> putList putByteString gs >> put '\n'
+  put (SG g) = putString "s " >> putShow g          >> put '\n'
+  put (MtlLib m) = put "mtllib"  >> putList putByteString m >> put '\n'
+  put (UseMtl m) = put "usemtl " >> putByteString m         >> put '\n'
   get = undefined
 
 
@@ -78,15 +76,15 @@
 putShow :: Show a => a -> Put
 putShow = putString . show
 
-putList :: Binary a => (a -> Put) -> [a] -> Put
+putList :: (a -> Put) -> [a] -> Put
 putList f x = forM_ x (\i -> put ' ' >> f i)
 
 putDouble :: VDouble -> Put
-putDouble (x,Just y ) = putShow x >> put '/' >> putShow y
-putDouble (x,Nothing) = putShow x
+putDouble (VD x (Just y)) = putShow x >> put '/' >> putShow y
+putDouble (VD x Nothing ) = putShow x
 
 putTriple :: VTriple -> Put
-putTriple (v,t,n) =
+putTriple (VTr v t n) =
   putShow v >>
     case (t,n) of
       (Nothing,Just n') -> putString "//" >> putShow n'
@@ -103,22 +101,21 @@
 decodeStmt' s =
   if CBS.length s > 0 then
     case CBS.head s of
-      'p' -> Just . P  $ runParse parsePoints      s
-      'l' -> Just . L  $ runParse parseLines       s
-      'f' -> Just . F  $ runParse parseFace        s
-      'g' -> Just . G  $ runParse parseGroups      s
-      's' -> Just . SG $ runParse parseSmoothGroup s
-      _   -> if      (CBS.pack "mtllib") `CBS.isPrefixOf` s
-               then Just . MtlLib $ runParse parseMtlLib (CBS.drop 5 s)
-             else if (CBS.pack "usemtl") `CBS.isPrefixOf` s
-               then Just . UseMtl $ runParse parseUseMtl (CBS.drop 5 s)
-             else if (CBS.pack "vn")     `CBS.isPrefixOf` s
-               then Just . (uncurry3 VN) $ runParse parseNormal (CBS.tail s)
-             else if (CBS.pack "vt")     `CBS.isPrefixOf` s
-               then Just . (uncurry3 VT) $ runParse parseTexCoord (CBS.tail s)
-             else if 'v' == CBS.head s
-               then Just . (uncurry4 V) $ runParse parseVertex s
-             else Nothing
+      'p' -> Just . P      . runParse parsePoints                   $ s
+      'l' -> Just . L      . runParse parseLines                    $ s
+      'f' -> Just . F      . runParse parseFace                     $ s
+      'g' -> Just . G      . runParse parseGroups                   $ s
+      's' -> Just . SG     . runParse parseSmoothGroup              $ s
+      _ | (CBS.pack "vn")     `CBS.isPrefixOf` s
+          -> Just          . runParse parseNormal      . CBS.tail   $ s
+      _ | (CBS.pack "vt")     `CBS.isPrefixOf` s
+          -> Just          . runParse parseTexCoord    . CBS.tail   $ s
+      'v' -> Just          . runParse parseVertex                   $ s
+      _ | (CBS.pack "mtllib") `CBS.isPrefixOf` s
+          -> Just . MtlLib . runParse parseMtlLib      . CBS.drop 5 $ s
+      _ | (CBS.pack "usemtl") `CBS.isPrefixOf` s
+          -> Just . UseMtl . runParse parseUseMtl      . CBS.drop 5 $ s
+      _   -> Nothing
     else Nothing
 
 runParse :: (CBS.ByteString -> a) -> CBS.ByteString -> a
@@ -130,30 +127,43 @@
 parsePoints :: CBS.ByteString -> [Int]
 parseLines  :: CBS.ByteString -> [VDouble]
 parseFace   :: CBS.ByteString -> [VTriple]
-parsePoints = bSwords unsafeReadInt
-parseLines  = bSwords readDouble
-parseFace   = bSwords readTriple
+parsePoints = map unsafeReadInt . bsWords
+parseLines  = map readDouble    . bsWords
+parseFace   = map readTriple    . bsWords
 
-parseGroups      :: CBS.ByteString -> [String]
-parseSmoothGroup :: CBS.ByteString -> Maybe Int
-parseGroups      = bSwords (CBS.unpack)
-parseSmoothGroup g =
-  if g == (CBS.pack "off")
-    then Nothing
-    else (if' <$> (== 0) <*> (const Nothing) <*> Just) . unsafeReadInt $ g
+parseGroups      :: CBS.ByteString -> [CBS.ByteString]
+parseSmoothGroup :: CBS.ByteString -> Int
+parseGroups      = map parseName . bsWords
+parseSmoothGroup = if' <$> (== CBS.pack "off") <*> (const 0) <*> unsafeReadInt
 
-parseMtlLib :: CBS.ByteString -> [String]
-parseUseMtl :: CBS.ByteString -> String
-parseMtlLib = bSwords parseName
-parseUseMtl = head . bSwords parseName
+parseMtlLib :: CBS.ByteString -> [CBS.ByteString]
+parseUseMtl :: CBS.ByteString -> CBS.ByteString
+parseMtlLib = map parseName    . bsWords
+parseUseMtl = parseName . head . bsWords
 
-parseNormal   :: CBS.ByteString -> (Float,Float,Float)
-parseTexCoord :: CBS.ByteString -> (Float,Float,Float)
-parseVertex   :: CBS.ByteString -> (Float,Float,Float,Float)
-parseNormal   = normalTuple
-parseTexCoord = texCoordTuple
-parseVertex   = vertexTuple
+parseNormal   :: CBS.ByteString -> Statement
+parseTexCoord :: CBS.ByteString -> Statement
+parseVertex   :: CBS.ByteString -> Statement
+parseNormal   s = let Just (x,s' ) = unsafeRFloat s
+                      Just (y,s'') = unsafeRFloat s'
+                      Just (z,_  ) = unsafeRFloat s''
+                  in VN x y z
+parseTexCoord s = let Just (x,s') = unsafeRFloat s
+                      y           = unsafeRFloat s'
+                  in case y of
+                       Just (y',r) -> case unsafeRFloat r of
+                                        Just (z,_) -> VT x y' z
+                                        Nothing    -> VT x y' 0
+                       Nothing     -> VT x 0 0
+parseVertex   s = let Just (x,s'  ) = unsafeRFloat s
+                      Just (y,s'' ) = unsafeRFloat s'
+                      Just (z,s''') = unsafeRFloat s''
+                      w             = unsafeRFloat s'''
+                  in case w of
+                       Just (w',_) -> V x y z w'
+                       Nothing     -> V x y z 1
 
+
 unsafeReadInt :: CBS.ByteString -> Int
 unsafeReadInt x = case CBS.readInt x of
                     Just (i,_) -> i
@@ -162,8 +172,8 @@
 readDouble :: CBS.ByteString -> VDouble
 readDouble x =
   if CBS.length b > 1
-    then (unsafeReadInt a, Just . unsafeReadInt $ CBS.tail b)
-    else (unsafeReadInt a, Nothing)
+    then VD (unsafeReadInt a) (Just . unsafeReadInt $ CBS.tail b)
+    else VD (unsafeReadInt a) Nothing
   where
     (a,b) = CBS.break (=='/') x
 
@@ -172,7 +182,7 @@
 --   v, v/t, v//n, v/t/n
 readTriple :: CBS.ByteString -> VTriple
 readTriple vtns = 
-  (v,t,n)
+  VTr v t n
   where
     (vs,tnr) = CBS.break (=='/') vtns
     (ts,nr ) = if CBS.length tnr > 0
@@ -190,43 +200,10 @@
                       then Just $ unsafeReadInt x
                       else Nothing
 
-normalTuple :: CBS.ByteString -> (Float,Float,Float)
-normalTuple s =
-  let Just (x,s' ) = unsafeRFloat s
-      Just (y,s'') = unsafeRFloat s'
-      Just (z,_  ) = unsafeRFloat s''
-  in (x,y,z)
-
-vertexTuple :: CBS.ByteString -> (Float,Float,Float,Float)
-vertexTuple s =
-  let Just (x,s'  ) = unsafeRFloat s
-      Just (y,s'' ) = unsafeRFloat s'
-      Just (z,s''') = unsafeRFloat s''
-      w             = unsafeRFloat s'''
-  in case w of
-       Just (w',_) -> (x,y,z,w')
-       Nothing     -> (x,y,z,1 )
-
-texCoordTuple :: CBS.ByteString -> (Float,Float,Float)
-texCoordTuple s =
-  let Just (x,s') = unsafeRFloat s
-      y           = unsafeRFloat s'
-  in case y of
-       Just (y',r) -> case unsafeRFloat r of
-                        Just (z,_) -> (x,y',z)
-                        Nothing    -> (x,y',0)
-       Nothing     -> (x,0,0)
-
-uncurry3 :: (a -> b -> c -> d) -> (a,b,c) -> d
-uncurry3 f (x,y,z) = f x y z
-
-uncurry4 :: (a -> b -> c -> d -> e) -> (a,b,c,d) -> e
-uncurry4 f (x,y,z,w) = f x y z w
-
-mtllibs :: ObjFile -> [String]
+mtllibs :: ObjFile -> [CBS.ByteString]
 mtllibs (OF f) = concatMap stmtMtlLibs f
 
-stmtMtlLibs :: Statement -> [String]
+stmtMtlLibs :: Statement -> [CBS.ByteString]
 stmtMtlLibs (MtlLib xs) = xs
 stmtMtlLibs _ = []
 
diff --git a/src/Graphics/Formats/Obj/ParserBits.hs b/src/Graphics/Formats/Obj/ParserBits.hs
--- a/src/Graphics/Formats/Obj/ParserBits.hs
+++ b/src/Graphics/Formats/Obj/ParserBits.hs
@@ -14,7 +14,7 @@
 module Graphics.Formats.Obj.ParserBits
        (unsafeReadFloat,unsafeRFloat
        ,anyOf
-       ,consumeWS,firstWord, bSwords,removeComments,parseName) where
+       ,consumeWS,firstWord, bsWords,removeComments,parseName) where
 
 import Foreign
 import Foreign.C.String
@@ -26,6 +26,7 @@
 import Data.Maybe
 
 import Control.Applicative hiding ((<|>))
+import Control.Applicative.Infix
 
 unsafeReadFloat :: CBS.ByteString -> Float
 unsafeReadFloat =
@@ -59,9 +60,9 @@
 anyOf :: [a -> Bool] -> a -> Bool
 anyOf = foldr (liftA2 (||)) (const False)
 
-bSwords :: (CBS.ByteString -> a) -> CBS.ByteString -> [a]
-bSwords f = map f . filter ((>0) . CBS.length)
-                  . CBS.splitWith (liftA2 (||) (==' ') (=='\t'))
+bsWords :: CBS.ByteString -> [CBS.ByteString]
+bsWords =
+  filter ((>0) . CBS.length) . CBS.splitWith ((==' ') <^(||)^> (=='\t'))
 
 removeComments :: CBS.ByteString -> CBS.ByteString
 removeComments bs = case CBS.split '#' bs of
@@ -69,11 +70,11 @@
                       (x:_) -> x
 
 consumeWS :: CBS.ByteString -> CBS.ByteString
-consumeWS = CBS.dropWhile (liftA2 (||) (==' ') (=='\t'))
+consumeWS = CBS.dropWhile ((==' ') <^(||)^> (=='\t'))
 
 firstWord :: CBS.ByteString -> CBS.ByteString
 firstWord = CBS.takeWhile (  not
                            . anyOf [(==' '), (=='\t'), (=='\n'), (=='\r')])
 
-parseName :: CBS.ByteString -> String
-parseName = CBS.unpack . firstWord . consumeWS
+parseName :: CBS.ByteString -> CBS.ByteString
+parseName = firstWord . consumeWS