packages feed

STL 0.2.0.2 → 0.3

raw patch · 7 files changed

+89/−78 lines, 7 filesdep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: bytestring

API changes (from Hackage documentation)

- Graphics.Formats.STL.Binary: instance Serialize STL
- Graphics.Formats.STL.Binary: instance Serialize Triangle
+ Graphics.Formats.STL.Types: instance Serialize STL
+ Graphics.Formats.STL.Types: instance Serialize Triangle
- Graphics.Formats.STL.Parser: loop :: Parser Text (Vector, Vector, Vector)
+ Graphics.Formats.STL.Parser: loop :: Parser (Vector, Vector, Vector)
- Graphics.Formats.STL.Parser: triangle :: Parser Text Triangle
+ Graphics.Formats.STL.Parser: triangle :: Parser Triangle

Files

CHANGES.md view
@@ -1,3 +1,9 @@+0.3+---++- Move `Serialize` instances to avoid orphans+- Fix broken text output format+ 0.2.0.2 ------- 
STL.cabal view
@@ -1,5 +1,5 @@ name:                STL-version:             0.2.0.2+version:             0.3 synopsis:            STL 3D geometry format parsing and pretty-printing description:         STL is a simple file format for representing 3D                      objects as the triangles which form their@@ -12,10 +12,10 @@ license-file:        LICENSE author:              Daniel Bergey maintainer:          bergey@alum.mit.edu--- copyright:           +-- copyright: category:            Graphics build-type:          Simple--- extra-source-files:  +-- extra-source-files: cabal-version:       >=1.10 Extra-source-files:  CHANGES.md, README.md bug-reports:         http://github.com/bergey/STL/issues@@ -29,14 +29,13 @@   exposed-modules:  Graphics.Formats.STL,                     Graphics.Formats.STL.Types,                     Graphics.Formats.STL.Parser,-                    Graphics.Formats.STL.Printer,-                    Graphics.Formats.STL.Binary-  -- other-modules:       -  -- other-extensions:    +                    Graphics.Formats.STL.Printer+  -- other-modules:+  -- other-extensions:   build-depends:    base >=4.6 && <4.8,                     attoparsec >= 0.11 && < 0.13,                     text >= 0.11.1.5 && < 1.3,                     cereal >= 0.4 && < 0.5,-                    bytestring >= 0.10 && < 0.11-  hs-source-dirs:   src     +                    bytestring >= 0.10.2 && < 0.11+  hs-source-dirs:   src   default-language: Haskell2010
src/Graphics/Formats/STL.hs view
@@ -1,11 +1,10 @@ module Graphics.Formats.STL (       textSTL     , stlParser-    , STL(..), Triangle(..), Vector(..)+    , STL(..), Triangle(..), Vector     )     where -import Graphics.Formats.STL.Binary import Graphics.Formats.STL.Printer (textSTL) import Graphics.Formats.STL.Parser (stlParser) import Graphics.Formats.STL.Types
− src/Graphics/Formats/STL/Binary.hs
@@ -1,62 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Graphics.Formats.STL.Binary () -- export only instances-       where--import           Graphics.Formats.STL.Types-import           Data.Word-import           Control.Applicative-import           Control.Monad-import           Data.Serialize-import qualified Data.Text as T-import qualified Data.ByteString as BS-import           Data.Text.Encoding--instance Serialize Triangle where-    get = Triangle <$> getNormal <*> t <* skip 2 where-      t = (,,) <$> getVector <*> getVector <*> getVector-    put (Triangle n (a, b, c)) = maybeNormal n *> v3 a *> v3 b *> v3 c *> put (0x00 :: Word16)--instance Serialize STL where-    get = do-        _  <- getHeader-        ct <- getWord32le-        STL "" <$> replicateM (fromIntegral ct) get-    put (STL n tris) = put (header n) *> putWord32le ct *> mapM_ put tris where-      ct :: Word32-      ct = fromIntegral . length $ tris  -- here's the space leak---- | header is always exactly 80 characters long-header :: T.Text -> BS.ByteString-header n = BS.concat [lib, truncatedName, padding] where-  lib = encodeUtf8 "http://hackage.haskell.org/package/STL "-  truncatedName = BS.take (72 - BS.length lib) . encodeUtf8 $ n-  padding = BS.replicate (72 - BS.length truncatedName - BS.length lib) 0x20--- header _ = BS.replicate 72 0x20 -- cereal adds 8 bytes giving the length of the BS--putFloat :: Float -> Put-putFloat = putFloat32le--v3 :: Vector -> PutM ()-v3 (x,y,z) = putFloat x *> putFloat y *> putFloat z--maybeNormal :: Maybe Vector -> PutM ()-maybeNormal n = case n of-    Nothing -> v3 (0,0,0)-    Just n' -> v3 n'--getHeader :: Get ()-getHeader = skip 80--getFloat :: Get Float-getFloat = getFloat32le--getVector :: Get Vector-getVector = (,,) <$> getFloat <*> getFloat <*> getFloat--getNormal :: Get (Maybe Vector)-getNormal = do-    v <- getVector-    return $ case v of-        (0,0,0) -> Nothing-        n'      -> Just n'
src/Graphics/Formats/STL/Parser.hs view
@@ -19,8 +19,10 @@ nameParser :: Parser Text nameParser = text "solid" *> takeWhile (inClass " -~") <* skipSpace +triangle :: Parser Triangle triangle = Triangle <$> ss normalParser <*> loop <* text "endfacet" +loop :: Parser (Vector, Vector, Vector) loop = triple <$> (text "outer loop" *> ss vertex) <*> ss vertex <*> ss vertex <* text "endloop"  normalParser :: Parser (Maybe Vector)
src/Graphics/Formats/STL/Printer.hs view
@@ -4,7 +4,6 @@  import qualified Data.ByteString as BS import           Data.ByteString.Lazy.Builder-import           Data.ByteString.Lazy.Builder.ASCII import           Data.List (intersperse) import           Data.Monoid import           Data.Text.Encoding (encodeUtf8)@@ -39,9 +38,9 @@ vertex v = stringUtf8 "vertex " <> v3 v  v3 :: Vector -> Builder-v3 (x, y, z) = mconcat $ intersperse comma [floatDec x, floatDec y, floatDec z]+v3 (x, y, z) = mconcat $ intersperse space [floatDec x, floatDec y, floatDec z]   where-    comma = stringUtf8 ", "+    space = charUtf8 ' '  indent :: Int -> Builder -> Builder indent i bs = spaces <> bs where
src/Graphics/Formats/STL/Types.hs view
@@ -1,7 +1,22 @@-module Graphics.Formats.STL.Types where+{-# LANGUAGE OverloadedStrings #-} -import Data.Text (Text)+module Graphics.Formats.STL.Types+       (+           STL(..),+           Triangle(..),+           Vector,+           triple,+       ) where +import           Control.Applicative+import           Control.Monad+import qualified Data.ByteString as BS+import           Data.Serialize+import           Data.Text (Text)+import qualified Data.Text as T+import           Data.Text.Encoding+import           Data.Word+ -- | A representation of an STL file, consisting of a (possibly empty) -- object name, and a list of triangles. data STL = STL { name :: Text@@ -18,3 +33,56 @@  triple :: a -> a -> a -> (a, a, a) triple a b c = (a, b, c)++--------------------------------------------------------------------------------+-- Binary Output+--------------------------------------------------------------------------------++instance Serialize Triangle where+    get = Triangle <$> getNormal <*> t <* skip 2 where+      t = (,,) <$> getVector <*> getVector <*> getVector+    put (Triangle n (a, b, c)) = maybeNormal n *> v3 a *> v3 b *> v3 c *> put (0x00 :: Word16)++instance Serialize STL where+    get = do+        _  <- getHeader+        ct <- getWord32le+        STL "" <$> replicateM (fromIntegral ct) get+    put (STL n tris) = put (header n) *> putWord32le ct *> mapM_ put tris where+      ct :: Word32+      ct = fromIntegral . length $ tris  -- here's the space leak++-- | header is always exactly 80 characters long+header :: T.Text -> BS.ByteString+header n = BS.concat [lib, truncatedName, padding] where+  lib = encodeUtf8 "http://hackage.haskell.org/package/STL "+  truncatedName = BS.take (72 - BS.length lib) . encodeUtf8 $ n+  padding = BS.replicate (72 - BS.length truncatedName - BS.length lib) 0x20+-- header _ = BS.replicate 72 0x20 -- cereal adds 8 bytes giving the length of the BS++putFloat :: Float -> Put+putFloat = putFloat32le++v3 :: Vector -> PutM ()+v3 (x,y,z) = putFloat x *> putFloat y *> putFloat z++maybeNormal :: Maybe Vector -> PutM ()+maybeNormal n = case n of+    Nothing -> v3 (0,0,0)+    Just n' -> v3 n'++getHeader :: Get ()+getHeader = skip 80++getFloat :: Get Float+getFloat = getFloat32le++getVector :: Get Vector+getVector = (,,) <$> getFloat <*> getFloat <*> getFloat++getNormal :: Get (Maybe Vector)+getNormal = do+    v <- getVector+    return $ case v of+        (0,0,0) -> Nothing+        n'      -> Just n'