From 15d46d75c67faa64425e1013957617239a9f4790 Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Fri, 14 Jun 2019 03:13:25 -0400 Subject: nullBuilder accepts custom default action. --- src/Wavefront.hs | 184 +++++++++++++++++++++++++++---------------------------- test/bench.hs | 2 +- 2 files changed, 92 insertions(+), 94 deletions(-) diff --git a/src/Wavefront.hs b/src/Wavefront.hs index 6200bf2..c5c8d1b 100644 --- a/src/Wavefront.hs +++ b/src/Wavefront.hs @@ -58,52 +58,52 @@ data ObjBuilder m = ObjBuilder , badToken :: L.ByteString -> m () } -nullBuilder :: Applicative m => ObjBuilder m -nullBuilder = ObjBuilder - { vertex = \vs -> pure () - , vertexT = \vs -> pure () - , vertexN = \vs -> pure () - , vertexP = \vs -> pure () - , face = \is -> pure () - , cstype = \isRat typ -> pure () - , curv2 = \is -> pure () - , curv = \u0 v0 is -> pure () - , parm = \uv is -> pure () - , specialPoints = \is -> pure () - , endFreeForm = pure () - , ctech = \approx -> pure () - , stech = \approx -> pure () - , deg = \is -> pure () - , surf = \u0 u1 v0 v1 ts -> pure () - , trim = \ss -> pure () - , hole = \ss -> pure () - , specialCurves = \ss -> pure () - , equivalentCurves = \ccs -> pure () - , groups = \gs -> pure () - , smoothingGroup = \sg -> pure () - , mergingGroup = \mg δ -> pure () - , usemtl = \mtl -> pure () - , deprecated_cdc = \is -> pure () - , deprecated_cdp = \is -> pure () - , deprecated_bzp = \is -> pure () - , deprecated_bsp = \is -> pure () - , mtllib = \fns -> pure () - , objectName = \obn -> pure () - , bmat = \uv fs -> pure () - , step = \is -> pure () - , points = \is -> pure () - , usemap = \map -> pure () - , maplib = \fns -> pure () - , c_interp = \b -> pure () - , d_interp = \b -> pure () - , trace_obj = \obj -> pure () - , shadow_obj = \obj -> pure () - , deprecated_res = \is -> pure () - , bevel = \b -> pure () - , lod = \lvl -> pure () - , call = \obj args -> pure () - , command = \b cmd -> pure L.empty - , badToken = \bs -> pure () +nullBuilder :: Applicative m => m () -> ObjBuilder m +nullBuilder def = ObjBuilder + { vertex = \vs -> def + , vertexT = \vs -> def + , vertexN = \vs -> def + , vertexP = \vs -> def + , face = \is -> def + , cstype = \isRat typ -> def + , curv2 = \is -> def + , curv = \u0 v0 is -> def + , parm = \uv is -> def + , specialPoints = \is -> def + , endFreeForm = def + , ctech = \approx -> def + , stech = \approx -> def + , deg = \is -> def + , surf = \u0 u1 v0 v1 ts -> def + , trim = \ss -> def + , hole = \ss -> def + , specialCurves = \ss -> def + , equivalentCurves = \ccs -> def + , groups = \gs -> def + , smoothingGroup = \sg -> def + , mergingGroup = \mg δ -> def + , usemtl = \mtl -> def + , deprecated_cdc = \is -> def + , deprecated_cdp = \is -> def + , deprecated_bzp = \is -> def + , deprecated_bsp = \is -> def + , mtllib = \fns -> def + , objectName = \obn -> def + , bmat = \uv fs -> def + , step = \is -> def + , points = \is -> def + , usemap = \map -> def + , maplib = \fns -> def + , c_interp = \b -> def + , d_interp = \b -> def + , trace_obj = \obj -> def + , shadow_obj = \obj -> def + , deprecated_res = \is -> def + , bevel = \b -> def + , lod = \lvl -> def + , call = \obj args -> def + , command = \b cmd -> def *> pure L.empty + , badToken = \bs -> def } @@ -188,53 +188,51 @@ findNewLine ps o@(ObjConfig args) bs = case L.break (\c -> c=='\n' || c=='\\' || else ds Nothing -> (L.concat $ reverse $ ts : ps,L.empty) -{- - - 1 bevel - 2 bmat - 3 bsp - 4 bzp - 5 call - 6 cdc - 7 cdp - 8 c_interp - 9 con - 10 csh -- for all except these, - 11 cstype -- Two chars suffice to distinguish - 12 ctech - 13 curv2 -- for all except these, - 14 curv -- Two chars suffice to distinguish - 15 deg - 16 d_interp - 17 end - 18 f - 19 g - 20 hole - 21 lod - 22 maplib - 23 mg - 24 mtllib - 25 o - 26 p - 27 parm - 28 res - 29 s - 30 scrv - 31 shadow_obj - 32 sp - 33 stech -- for all except these, - 34 step -- Two chars suffice to distinguish - 35 surf - 36 trace_obj -- for all except these, - 37 trim -- Two chars suffice to distinguish - 38 usemap -- for all except these, - 39 usemtl -- Two chars suffice to distinguish - 40 v - 41 vn - 42 vp - 43 vt - --} +-- The 43 keywords of the OBJ file format: +-- +-- 1 bevel +-- 2 bmat +-- 3 bsp +-- 4 bzp +-- 5 call +-- 6 cdc +-- 7 cdp +-- 8 c_interp +-- 9 con +-- 10 csh +-- 11 cstype +-- 12 ctech +-- 13 curv2 +-- 14 curv +-- 15 deg +-- 16 d_interp +-- 17 end +-- 18 f +-- 19 g +-- 20 hole +-- 21 lod +-- 22 maplib +-- 23 mg +-- 24 mtllib +-- 25 o +-- 26 p +-- 27 parm +-- 28 res +-- 29 s +-- 30 scrv +-- 31 shadow_obj +-- 32 sp +-- 33 stech +-- 34 step +-- 35 surf +-- 36 trace_obj +-- 37 trim +-- 38 usemap +-- 39 usemtl +-- 40 v +-- 41 vn +-- 42 vp +-- 43 vt nextToken :: (L.ByteString -> L.ByteString) -> L.ByteString -> L.ByteString nextToken tok bs = tok $ L.dropWhile (not . isSpace) bs diff --git a/test/bench.hs b/test/bench.hs index 3125ed9..bf60303 100644 --- a/test/bench.hs +++ b/test/bench.hs @@ -59,7 +59,7 @@ countVerticesSundqvist ts = List.length vs countVerticesCrayne :: L.ByteString -> Int countVerticesCrayne bs = execState (parseOBJ builder (ObjConfig IntMap.empty) bs) 0 where - builder = nullBuilder + builder = (nullBuilder $ return ()) { vertex = \_ -> modify succ } -- cgit v1.2.3