crayne parser: l command and Rank2.Functor instance.

2 files changed, 80 insertions, 24 deletions

diff --git a/src/Wavefront/Lex.hs b/src/Wavefront/Lex.hs
index 501549f..7123184 100644
--- a/src/Wavefront/Lex.hs
+++ b/src/Wavefront/Lex.hs
@@ -10,6 +10,7 @@ import Data.IntMap (IntMap)
 import qualified Data.IntMap as IntMap
 import Data.ByteString.Lex.Fractional as F
 import Data.ByteString.Lex.Integral as I
+import qualified Rank2
 
 data ObjBuilder m = ObjBuilder
     { vertex           :: [Double] -> m ()
@@ -17,6 +18,7 @@ data ObjBuilder m = ObjBuilder
     , vertexN          :: [Double] -> m ()
     , vertexP          :: [Double] -> m ()
     , face             :: [RefTriple] -> m ()
+    , line            :: [RefTriple] -> m ()
     , cstype           :: Bool -> CSType -> m ()
     , curv2            :: [Int] -> m ()
     , curv             :: Double -> Double -> [Int] -> m ()
@@ -58,6 +60,56 @@ data ObjBuilder m = ObjBuilder
     , badToken         :: L.ByteString -> m ()
     }
 
+instance Rank2.Functor ObjBuilder where
+    f <$> b = b
+        { vertex           = \vs             -> f $ vertex b vs
+        , vertexT          = \vs             -> f $ vertexT b vs
+        , vertexN          = \vs             -> f $ vertexN b vs
+        , vertexP          = \vs             -> f $ vertexP b vs
+        , face             = \is             -> f $ face b is
+        , line            = \is             -> f $ line b is
+        , cstype           = \isRat typ      -> f $ cstype b isRat typ
+        , curv2            = \is             -> f $ curv2 b is
+        , curv             = \u0 v0 is       -> f $ curv b u0 v0 is
+        , parm             = \uv is          -> f $ parm b uv is
+        , specialPoints    = \is             -> f $ specialPoints b is
+        , endFreeForm      =                    f $ endFreeForm b
+        , ctech            = \approx         -> f $ ctech b approx
+        , stech            = \approx         -> f $ stech b approx
+        , deg              = \is             -> f $ deg b is
+        , surf             = \u0 u1 v0 v1 ts -> f $ surf b u0 u1 v0 v1 ts
+        , trim             = \ss             -> f $ trim b ss
+        , hole             = \ss             -> f $ hole b ss
+        , specialCurves    = \ss             -> f $ specialCurves b ss
+        , equivalentCurves = \ccs            -> f $ equivalentCurves b ccs
+        , groups           = \gs             -> f $ groups b gs
+        , smoothingGroup   = \sg             -> f $ smoothingGroup b sg
+        , mergingGroup     = \mg δ           -> f $ mergingGroup b mg δ
+        , usemtl           = \mtl            -> f $ usemtl b mtl
+        , deprecated_cdc   = \is             -> f $ deprecated_cdc b is
+        , deprecated_cdp   = \is             -> f $ deprecated_cdp b is
+        , deprecated_bzp   = \is             -> f $ deprecated_bzp b is
+        , deprecated_bsp   = \is             -> f $ deprecated_bsp b is
+        , mtllib           = \fns            -> f $ mtllib b fns
+        , objectName       = \obn            -> f $ objectName b obn
+        , bmat             = \uv fs          -> f $ bmat b uv fs
+        , step             = \is             -> f $ step b is
+        , points           = \is             -> f $ points b is
+        , usemap           = \map            -> f $ usemap b map
+        , maplib           = \fns            -> f $ maplib b fns
+        , c_interp         = \x              -> f $ c_interp b x
+        , d_interp         = \x              -> f $ d_interp b x
+        , trace_obj        = \obj            -> f $ trace_obj b obj
+        , shadow_obj       = \obj            -> f $ shadow_obj b obj
+        , deprecated_res   = \is             -> f $ deprecated_res b is
+        , bevel            = \x              -> f $ bevel b x
+        , lod              = \lvl            -> f $ lod b lvl
+        , call             = \obj args       -> f $ call b obj args
+        , command          = \x cmd          -> f $ command b x cmd
+        , badToken         = \bs             -> f $ badToken b bs
+        }
+
+
 nullBuilder :: Applicative m => m () -> ObjBuilder m
 nullBuilder def = ObjBuilder
     { vertex           = \vs             -> def
@@ -65,6 +117,7 @@ nullBuilder def = ObjBuilder
     , vertexN          = \vs             -> def
     , vertexP          = \vs             -> def
     , face             = \is             -> def
+    , line             = \is             -> def
     , cstype           = \isRat typ      -> def
     , curv2            = \is             -> def
     , curv             = \u0 v0 is       -> def
@@ -188,7 +241,7 @@ findNewLine ps o@(ObjConfig args) bs = case L.break (\c -> c=='\n' || c=='\\' ||
                                                                          else ds
     Nothing            -> (L.concat $ reverse $ ts : ps,L.empty)
 
--- The 43 keywords of the OBJ file format:
+-- The 44 keywords of the OBJ file format:
 --
 --      1      bevel
 --      2      bmat
@@ -210,29 +263,30 @@ findNewLine ps o@(ObjConfig args) bs = case L.break (\c -> c=='\n' || c=='\\' ||
 --     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
+--     21      l
+--     22      lod
+--     23      maplib
+--     24      mg
+--     25      mtllib
+--     26      o
+--     27      p
+--     28      parm
+--     29      res
+--     30      s
+--     31      scrv
+--     32      shadow_obj
+--     33      sp
+--     34      stech
+--     35      step
+--     36      surf
+--     37      trace_obj
+--     38      trim
+--     39      usemap
+--     40      usemtl
+--     41      v
+--     42      vn
+--     43      vp
+--     44      vt
 
 nextToken :: (L.ByteString -> L.ByteString) -> L.ByteString -> L.ByteString
 nextToken tok bs = tok $ L.dropWhile (not . isSpace) bs
@@ -368,6 +422,7 @@ parseOBJ builder args bs0
                 (gn,bs') -> do
                     groups builder (map L.toStrict $ L.words gn)
                     parseOBJ builder args bs'
+        'l' -> parseT line 2
         's' -> case next 1 bs of
                 tok -> parseOffOrNumber tok $ \sg bs' -> do
                             smoothingGroup builder sg
diff --git a/wavefront-obj.cabal b/wavefront-obj.cabal
index b5cd8df..1ccbc91 100644
--- a/wavefront-obj.cabal
+++ b/wavefront-obj.cabal
@@ -89,6 +89,7 @@ library
                     , bytestring
                     , bytestring-lexing
                     , pretty-show
+                    , rank2classes
 
   hs-source-dirs:      src
   default-language:    Haskell2010