1 files changed, 82 insertions, 0 deletions

diff --git a/test/bench.hs b/test/bench.hs
new file mode 100644
index 0000000..9952ec2
--- /dev/null
+++ b/test/bench.hs
@@ -0,0 +1,82 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+import qualified Data.Attoparsec.Text       as Atto
+import qualified Data.ByteString.Char8      as S
+import qualified Data.ByteString.Lazy.Char8 as L
+import Data.List as List
+import Data.Either
+import Data.ByteString.Unsafe
+import Data.Text
+import Data.Text.Encoding
+import Data.Word
+import Foreign.Ptr
+import System.IO.Unsafe
+import qualified Data.Vector as V
+import Control.Monad.State ( State, execState, gets, modify )
+import qualified Data.IntMap as IntMap
+
+import Codec.Wavefront.Lexer ( lexer )
+import Codec.Wavefront.Object ( WavefrontOBJ, ctxtToWavefrontOBJ, objLocations )
+import Codec.Wavefront.Token ( tokenize )
+
+import qualified Graphics.WaveFront.Parse as Parse
+import qualified Graphics.WaveFront.Parse.Common as Parse
+
+import Wavefront
+
+import Criterion.Main
+import Weigh -- WARNING: weigh is incompatible with profiling. It reports much more allocations with profiling turned on.
+
+foreign import ccall "&cube_obj" cube_ptr :: Ptr Word8
+cube_obj_len :: Int
+cube_obj_len = 840
+
+cube_obj :: L.ByteString
+cube_obj = L.fromChunks . pure . unsafePerformIO $ do
+    unsafePackCStringFinalizer cube_ptr cube_obj_len (return ())
+{-# NOINLINE cube_obj #-}
+
+cube_objT :: Text
+cube_objT = decodeASCII $ L.toStrict cube_obj
+{-# NOINLINE cube_objT #-}
+
+countVerticesSabadie :: Text -> Int
+countVerticesSabadie ts = V.length vs
+ where
+    obj = sabadie ts
+    vs = either (const V.empty) objLocations obj
+
+countVerticesSundqvist :: Text -> Int
+countVerticesSundqvist ts = List.length vs
+ where
+    obj = sundqvist ts
+    vs = either (const []) (List.filter isOBJVertex) obj
+    isOBJVertex (Parse.OBJVertex {}) = True
+    isOBJVertex _                    = False
+
+countVerticesCrayne :: L.ByteString -> Int
+countVerticesCrayne bs = execState (parseOBJ builder (ObjConfig IntMap.empty) bs) 0
+ where
+    builder = nullBuilder
+        { vertex = \_ -> modify succ
+        }
+
+sabadie :: Text -> Either String WavefrontOBJ
+sabadie = fmap (ctxtToWavefrontOBJ . lexer) . tokenize
+
+sundqvist :: Text -> Either String (Parse.OBJ Double Text Integer [])
+sundqvist = Atto.parseOnly (Parse.wholeFile Parse.obj)
+
+main :: IO ()
+main = do
+    print $ countVerticesSabadie cube_objT
+    print $ countVerticesSundqvist cube_objT
+    print $ countVerticesCrayne cube_obj
+    putStrLn $ "---- Benchmarking"
+    defaultMain [
+          bgroup "count vertices"
+                [ bench "crayne" $ whnf countVerticesCrayne cube_obj
+                , bench "sabadie"   $ whnf countVerticesSabadie   cube_objT
+                , bench "sundqvist" $ whnf countVerticesSundqvist cube_objT
+                ]
+          ]
+    return ()