From 6c1e0565bcbc4399335517db7e3b46e2150e5896 Mon Sep 17 00:00:00 2001 From: Julia Longtin Date: Tue, 31 Dec 2019 17:18:25 +0000 Subject: [PATCH] more applicative coding style. --- Examples/example17.hs | 10 +++++----- Graphics/Implicit/Export/PolylineFormats.hs | 2 +- Graphics/Implicit/Export/Render.hs | 8 ++++---- Graphics/Implicit/Export/SymbolicFormats.hs | 4 ++-- Graphics/Implicit/Export/SymbolicObj2.hs | 12 ++++++------ .../Implicit/Export/TriangleMeshFormats.hs | 4 ++-- Graphics/Implicit/ExtOpenScad/Definitions.hs | 4 ++-- Graphics/Implicit/ExtOpenScad/Eval/Expr.hs | 2 +- .../Implicit/ExtOpenScad/Eval/Statement.hs | 10 +++++----- .../Implicit/ExtOpenScad/Util/ArgParser.hs | 6 +++--- Graphics/Implicit/ObjectUtil/GetImplicit3.hs | 18 +++++++----------- programs/Benchmark.hs | 9 +++++---- programs/extopenscad.hs | 4 ++-- tests/MessageSpec/Util.hs | 2 +- 14 files changed, 46 insertions(+), 49 deletions(-) diff --git a/Examples/example17.hs b/Examples/example17.hs index 49a53f5..74e552e 100644 --- a/Examples/example17.hs +++ b/Examples/example17.hs @@ -12,11 +12,11 @@ object2 = squarePipe (10,10,10) 1 100 squarePipe :: ℝ3 -> ℝ -> ℝ -> SymbolicObj3 squarePipe (x,y,z) diameter precision = union - $ ((\start-> translate start - $ rect3R 0 (0,0,0) (diameter,diameter,diameter) - ) - <$> - zip3 (fmap (\n->(fromIntegral n/precision)*x) [0..100]) + ((\start-> translate start + $ rect3R 0 (0,0,0) (diameter,diameter,diameter) + ) + <$> + zip3 (fmap (\n->(fromIntegral n/precision)*x) [0..100]) (fmap (\n->(fromIntegral n/precision)*y) [0..100]) (fmap (\n->(fromIntegral n/precision)*z) [0..100])) diff --git a/Graphics/Implicit/Export/PolylineFormats.hs b/Graphics/Implicit/Export/PolylineFormats.hs index fdf572e..ad0475b 100644 --- a/Graphics/Implicit/Export/PolylineFormats.hs +++ b/Graphics/Implicit/Export/PolylineFormats.hs @@ -96,7 +96,7 @@ dxf2 plines = toLazyText $ dxf2Header <> dxf2Tables <> dxf2Blocks <> dxf2Entitie " 8\n" <> "0\n" <> " 6\n" <> "CONTINUOUS\n" <> " 66\n" <> "1\n" <> - " 62\n" <> (buildInt $ length singlePolyline) <> "\n" <> + " 62\n" <> buildInt (length singlePolyline) <> "\n" <> " 10\n" <> "0.0\n" <> " 20\n" <> "0.0\n" <> " 30\n" <> "0.0000\n" <> diff --git a/Graphics/Implicit/Export/Render.hs b/Graphics/Implicit/Export/Render.hs index 80ee0fa..bd09297 100644 --- a/Graphics/Implicit/Export/Render.hs +++ b/Graphics/Implicit/Export/Render.hs @@ -8,7 +8,7 @@ -- export getContour and getMesh, which returns the edge of a 2D object, or the surface of a 3D object, respectively. module Graphics.Implicit.Export.Render (getMesh, getContour) where -import Prelude(ceiling, ($), (+), (*), max, div, tail, fmap, reverse, (.), foldMap, min, Int, (<>)) +import Prelude(ceiling, ($), (+), (*), max, div, tail, fmap, reverse, (.), foldMap, min, Int, (<>), (<$>)) import Graphics.Implicit.Definitions (ℝ, ℕ, Fastℕ, ℝ2, ℝ3, TriangleMesh, Obj2, Obj3, Polyline(Polyline), (⋯/), both, allthree, fromℕtoℝ, fromℕ) @@ -129,21 +129,21 @@ getMesh p1@(x1,y1,z1) p2 res@(xres,yres,zres) obj = -- (2) Calculate segments for each side segsZ = [[[ - fmap (injZ z0) $ getSegs (x0,y0) (x1',y1') (obj **$ z0) (objX0Y0Z0, objX1Y0Z0, objX0Y1Z0, objX1Y1Z0) (midA0, midA1, midB0, midB1) + injZ z0 <$> getSegs (x0,y0) (x1',y1') (obj **$ z0) (objX0Y0Z0, objX1Y0Z0, objX0Y1Z0, objX1Y1Z0) (midA0, midA1, midB0, midB1) | x0<-pXs | x1'<-tail pXs |midB0<-mX'' | midB1<-mX'T | midA0<-mY'' | midA1<-tail mY'' | objX0Y0Z0<-objY0Z0 | objX1Y0Z0<- tail objY0Z0 | objX0Y1Z0<-objY1Z0 | objX1Y1Z0<-tail objY1Z0 ]| y0<-pYs | y1'<-tail pYs |mX'' <-mX' | mX'T <-tail mX' | mY'' <-mY' | objY0Z0 <-objZ0 | objY1Z0 <-tail objZ0 ]| z0<-pZs |mX' <-midsX | mY' <-midsY | objZ0 <-objV ] `using` parBuffer (max 1 $ div (fromℕ nz) forcesteps) rdeepseq segsY = [[[ - fmap (injY y0) $ getSegs (x0,z0) (x1',z1') (obj *$* y0) (objX0Y0Z0, objX1Y0Z0, objX0Y0Z1, objX1Y0Z1) (midA0, midA1, midB0, midB1) + injY y0 <$> getSegs (x0,z0) (x1',z1') (obj *$* y0) (objX0Y0Z0, objX1Y0Z0, objX0Y0Z1, objX1Y0Z1) (midA0, midA1, midB0, midB1) | x0<-pXs | x1'<-tail pXs | midB0<-mB'' | midB1<-mBT' | midA0<-mA'' | midA1<-tail mA'' | objX0Y0Z0<-objY0Z0 | objX1Y0Z0<-tail objY0Z0 | objX0Y0Z1<-objY0Z1 | objX1Y0Z1<-tail objY0Z1 ]| y0<-pYs | mB'' <-mB' | mBT' <-mBT | mA'' <-mA' | objY0Z0 <-objZ0 | objY0Z1 <-objZ1 ]| z0<-pZs | z1'<-tail pZs | mB' <-midsX | mBT <-tail midsX | mA' <-midsZ | objZ0 <-objV | objZ1 <-tail objV ] `using` parBuffer (max 1 $ div (fromℕ ny) forcesteps) rdeepseq segsX = [[[ - fmap (injX x0) $ getSegs (y0,z0) (y1',z1') (obj $** x0) (objX0Y0Z0, objX0Y1Z0, objX0Y0Z1, objX0Y1Z1) (midA0, midA1, midB0, midB1) + injX x0 <$> getSegs (y0,z0) (y1',z1') (obj $** x0) (objX0Y0Z0, objX0Y1Z0, objX0Y0Z1, objX0Y1Z1) (midA0, midA1, midB0, midB1) | x0<-pXs | midB0<-mB'' | midB1<-mBT' | midA0<-mA'' | midA1<-mA'T | objX0Y0Z0<-objY0Z0 | objX0Y1Z0<-objY1Z0 | objX0Y0Z1<-objY0Z1 | objX0Y1Z1<- objY1Z1 ]| y0<-pYs | y1'<-tail pYs | mB'' <-mB' | mBT' <-mBT | mA'' <-mA' | mA'T <-tail mA' | objY0Z0 <-objZ0 | objY1Z0 <-tail objZ0 | objY0Z1 <-objZ1 | objY1Z1 <-tail objZ1 ]| z0<-pZs | z1'<-tail pZs | mB' <-midsY | mBT <-tail midsY | mA' <-midsZ | objZ0 <- objV | objZ1 <- tail objV diff --git a/Graphics/Implicit/Export/SymbolicFormats.hs b/Graphics/Implicit/Export/SymbolicFormats.hs index 651f34b..3ae33b3 100644 --- a/Graphics/Implicit/Export/SymbolicFormats.hs +++ b/Graphics/Implicit/Export/SymbolicFormats.hs @@ -11,7 +11,7 @@ -- output SCAD code, AKA an implicitcad to openscad converter. module Graphics.Implicit.Export.SymbolicFormats (scad2, scad3) where -import Prelude(Either(Left, Right), ($), (*), ($!), (-), (/), pi, error, (+), (==), take, floor, (&&), const, pure, (<>), sequenceA, fmap) +import Prelude(Either(Left, Right), ($), (*), ($!), (-), (/), pi, error, (+), (==), take, floor, (&&), const, pure, (<>), sequenceA, fmap, (<$>)) import Graphics.Implicit.Definitions(ℝ, SymbolicObj2(RectR, Circle, PolygonR, Complement2, UnionR2, DifferenceR2, IntersectR2, Translate2, Scale2, Rotate2, Outset2, Shell2, EmbedBoxedObj2), SymbolicObj3(Rect3R, Sphere, Cylinder, Complement3, UnionR3, IntersectR3, DifferenceR3, Translate3, Scale3, Rotate3, Rotate3V, Outset3, Shell3, ExtrudeR, ExtrudeRotateR, ExtrudeRM, EmbedBoxedObj3, RotateExtrude, ExtrudeOnEdgeOf)) import Graphics.Implicit.Export.TextBuilderUtils(Text, Builder, toLazyText, fromLazyText, bf) @@ -39,7 +39,7 @@ callToken :: (Text, Text) -> Builder -> [Builder] -> [Reader a Builder] -> Reade callToken cs name args [] = pure $ name <> buildArgs cs args <> ";" callToken cs name args [obj] = fmap ((name <> buildArgs cs args) <>) obj callToken cs name args objs = do - objs' <- fmap (foldMap (<> "\n")) $ sequenceA objs + objs' <- foldMap (<> "\n") <$> sequenceA objs pure $! name <> buildArgs cs args <> "{\n" <> objs' <> "}\n" buildArgs :: (Text, Text) -> [Builder] -> Builder diff --git a/Graphics/Implicit/Export/SymbolicObj2.hs b/Graphics/Implicit/Export/SymbolicObj2.hs index 67b2bed..9f66d06 100644 --- a/Graphics/Implicit/Export/SymbolicObj2.hs +++ b/Graphics/Implicit/Export/SymbolicObj2.hs @@ -8,7 +8,7 @@ module Graphics.Implicit.Export.SymbolicObj2 (symbolicGetOrientedContour, symbolicGetContour, symbolicGetContourMesh) where -import Prelude(fmap, ($), (-), (/), (+), (>), (*), reverse, cos, pi, sin, max, ceiling) +import Prelude(fmap, ($), (-), (/), (+), (>), (*), reverse, cos, pi, sin, max, ceiling, (<$>)) import Graphics.Implicit.Definitions (ℝ, ℝ2, Fastℕ, SymbolicObj2(RectR, Circle, Translate2, Scale2), Polyline(Polyline), Polytri(Polytri), (⋯*), fromFastℕtoℝ) @@ -23,7 +23,7 @@ import Graphics.Implicit.Export.Render (getContour) import Data.VectorSpace ((^/), magnitude) symbolicGetOrientedContour :: ℝ -> SymbolicObj2 -> [Polyline] -symbolicGetOrientedContour res symbObj = fmap orient $ symbolicGetContour res symbObj +symbolicGetOrientedContour res symbObj = orient <$> symbolicGetContour res symbObj where obj = getImplicit2 symbObj -- FIXME: cowardly case handling. @@ -56,10 +56,10 @@ appOpPolyline :: (ℝ2 -> ℝ2) -> Polyline -> Polyline appOpPolyline op (Polyline xs) = Polyline $ fmap op xs symbolicGetContourMesh :: ℝ -> SymbolicObj2 -> [Polytri] -symbolicGetContourMesh res (Translate2 v obj) = fmap (\(Polytri (a,b,c)) -> Polytri (a + v, b + v, c + v) ) $ - symbolicGetContourMesh res obj -symbolicGetContourMesh res (Scale2 s@(a,b) obj) = fmap (\(Polytri (c,d,e)) -> Polytri (c ⋯* s, d ⋯* s, e ⋯* s) ) $ - symbolicGetContourMesh (res/sc) obj where sc = max a b +symbolicGetContourMesh res (Translate2 v obj) = (\(Polytri (a,b,c)) -> Polytri (a + v, b + v, c + v)) <$> + symbolicGetContourMesh res obj +symbolicGetContourMesh res (Scale2 s@(a,b) obj) = (\(Polytri (c,d,e)) -> Polytri (c ⋯* s, d ⋯* s, e ⋯* s)) <$> + symbolicGetContourMesh (res/sc) obj where sc = max a b symbolicGetContourMesh _ (RectR 0 (x1,y1) (x2,y2)) = [Polytri ((x1,y1), (x2,y1), (x2,y2)), Polytri ((x2,y2), (x1,y2), (x1,y1)) ] -- FIXME: magic number. symbolicGetContourMesh res (Circle r) = diff --git a/Graphics/Implicit/Export/TriangleMeshFormats.hs b/Graphics/Implicit/Export/TriangleMeshFormats.hs index 8c5ebd9..7358de4 100644 --- a/Graphics/Implicit/Export/TriangleMeshFormats.hs +++ b/Graphics/Implicit/Export/TriangleMeshFormats.hs @@ -78,7 +78,7 @@ cleanupTris tris = -- | Generate an STL file is ASCII format. stl :: TriangleMesh -> Text -stl triangles = toLazyText $ stlHeader <> (foldMap triangle $ unmesh $ cleanupTris triangles) <> stlFooter +stl triangles = toLazyText $ stlHeader <> foldMap triangle (unmesh $ cleanupTris triangles) <> stlFooter where stlHeader :: Builder stlHeader = "solid ImplictCADExport\n" @@ -107,7 +107,7 @@ float32LE = writeStorable . LE -- | Generate an STL file in it's binary format. binaryStl :: TriangleMesh -> ByteString -binaryStl triangles = toLazyByteString $ header <> lengthField <> (foldMap triangle $ unmesh $ cleanupTris triangles) +binaryStl triangles = toLazyByteString $ header <> lengthField <> foldMap triangle (unmesh $ cleanupTris triangles) where header = fromByteString $ replicate 80 0 lengthField = fromWord32le $ toEnum $ length $ unmesh $ cleanupTris triangles triangle (Triangle (a,b,c)) = normalV (a,b,c) <> point a <> point b <> point c <> fromWord16le 0 diff --git a/Graphics/Implicit/ExtOpenScad/Definitions.hs b/Graphics/Implicit/ExtOpenScad/Definitions.hs index 88de0c1..e31d92e 100644 --- a/Graphics/Implicit/ExtOpenScad/Definitions.hs +++ b/Graphics/Implicit/ExtOpenScad/Definitions.hs @@ -191,8 +191,8 @@ data SourcePosition = SourcePosition deriving (Eq) instance Show SourcePosition where - show (SourcePosition line col []) = "line " <> show ((fromFastℕ line) :: Int) <> ", column " <> show ((fromFastℕ col) :: Int) - show (SourcePosition line col filePath) = "line " <> show ((fromFastℕ line) :: Int) <> ", column " <> show ((fromFastℕ col) :: Int) <> ", file " <> filePath + show (SourcePosition line col []) = "line " <> show (fromFastℕ line :: Int) <> ", column " <> show (fromFastℕ col :: Int) + show (SourcePosition line col filePath) = "line " <> show (fromFastℕ line :: Int) <> ", column " <> show (fromFastℕ col :: Int) <> ", file " <> filePath -- | The types of messages the execution engine can send back to the application. data MessageType = TextOut -- text intetionally output by the ExtOpenScad program. diff --git a/Graphics/Implicit/ExtOpenScad/Eval/Expr.hs b/Graphics/Implicit/ExtOpenScad/Eval/Expr.hs index 47f4ce1..dd15b45 100644 --- a/Graphics/Implicit/ExtOpenScad/Eval/Expr.hs +++ b/Graphics/Implicit/ExtOpenScad/Eval/Expr.hs @@ -69,7 +69,7 @@ patMatch _ _ = Nothing -- | Construct a VarLookup from the given Pattern and OVal, if possible. matchPat :: Pattern -> OVal -> Maybe VarLookup -matchPat pat val = VarLookup . fromList . zip (fmap Symbol $ patVars pat) <$> patMatch pat val +matchPat pat val = VarLookup . fromList . zip (Symbol <$> patVars pat) <$> patMatch pat val -- | The entry point from StateC. evaluates an expression, pureing the result, and moving any error messages generated into the calling StateC. evalExpr :: SourcePosition -> Expr -> StateC OVal diff --git a/Graphics/Implicit/ExtOpenScad/Eval/Statement.hs b/Graphics/Implicit/ExtOpenScad/Eval/Statement.hs index ac2d4c9..3fec899 100644 --- a/Graphics/Implicit/ExtOpenScad/Eval/Statement.hs +++ b/Graphics/Implicit/ExtOpenScad/Eval/Statement.hs @@ -11,7 +11,7 @@ module Graphics.Implicit.ExtOpenScad.Eval.Statement (runStatementI) where -import Prelude(Maybe(Just, Nothing), Bool(True, False), Either(Left, Right), (.), ($), show, pure, (<>), reverse, fst, snd, readFile, filter, length, (&&), (==), (/=), fmap, notElem, elem, not, zip, init, last, null, String, (*>)) +import Prelude(Maybe(Just, Nothing), Bool(True, False), Either(Left, Right), (.), ($), show, pure, (<>), reverse, fst, snd, readFile, filter, length, (&&), (==), (/=), fmap, notElem, elem, not, zip, init, last, null, String, (*>), (<$>)) import Graphics.Implicit.ExtOpenScad.Definitions ( Statement(Include, (:=), If, NewModule, ModuleCall, DoNothing), @@ -195,22 +195,22 @@ runStatementI (StatementI sourcePos (ModuleCall (Symbol name) argsExpr suite)) = valUnnamed = unnamedParameters argsExpr mapFromUnnamed :: [(Symbol, Expr)] mapFromUnnamed = zip notMappedNotDefaultable valUnnamed - missingNotDefaultable = filter (`notElem` (mappedDefaulted <> mappedNotDefaulted <> (fmap fst mapFromUnnamed))) valNotDefaulted + missingNotDefaultable = filter (`notElem` (mappedDefaulted <> mappedNotDefaulted <> fmap fst mapFromUnnamed)) valNotDefaulted extraUnnamed = filter (`notElem` (valDefaulted <> valNotDefaulted)) $ namedParameters argsExpr parameterReport = "Passed " <> - (if (null valNamed && null valUnnamed) then "no parameters" else "" ) <> + (if null valNamed && null valUnnamed then "no parameters" else "" ) <> (if not (null valNamed) then show (length valNamed) <> (if length valNamed == 1 then " named parameter" else " named parameters") else "" ) <> (if not (null valNamed) && not (null valUnnamed) then ", and " else "") <> (if not (null valUnnamed) then show (length valUnnamed) <> (if length valUnnamed == 1 then " un-named parameter." else " un-named parameters.") else ".") <> (if not (null missingNotDefaultable) then (if length missingNotDefaultable == 1 then " Couldn't match one parameter: " <> showSymbol (last missingNotDefaultable) - else " Couldn't match " <> show (length missingNotDefaultable) <> " parameters: " <> intercalate ", " (fmap showSymbol $ init missingNotDefaultable) <> " and " <> showSymbol (last missingNotDefaultable) <> "." + else " Couldn't match " <> show (length missingNotDefaultable) <> " parameters: " <> intercalate ", " (showSymbol <$> init missingNotDefaultable) <> " and " <> showSymbol (last missingNotDefaultable) <> "." ) else "") <> (if not (null extraUnnamed) then (if length extraUnnamed == 1 then " Had one extra parameter: " <> showSymbol (last extraUnnamed) - else " Had " <> show (length extraUnnamed) <> " extra parameters. They are:" <> intercalate ", " (fmap showSymbol $ init extraUnnamed) <> " and " <> showSymbol (last extraUnnamed) <> "." + else " Had " <> show (length extraUnnamed) <> " extra parameters. They are:" <> intercalate ", " (showSymbol <$> init extraUnnamed) <> " and " <> showSymbol (last extraUnnamed) <> "." ) else "") showSymbol :: Symbol -> String showSymbol (Symbol sym) = show sym diff --git a/Graphics/Implicit/ExtOpenScad/Util/ArgParser.hs b/Graphics/Implicit/ExtOpenScad/Util/ArgParser.hs index ef2ea2a..357aab6 100644 --- a/Graphics/Implicit/ExtOpenScad/Util/ArgParser.hs +++ b/Graphics/Implicit/ExtOpenScad/Util/ArgParser.hs @@ -11,7 +11,7 @@ module Graphics.Implicit.ExtOpenScad.Util.ArgParser (argument, doc, defaultTo, example, test, eulerCharacteristic, argMap) where -- imported twice, once qualified. null from Data.Map conflicts with null from Prelude. -import Prelude(String, Maybe(Just, Nothing), ($), (<>), show, error, return, fmap, snd, filter, (.), fst, foldl1, not, (&&)) +import Prelude(String, Maybe(Just, Nothing), ($), (<>), show, error, return, fmap, snd, filter, (.), fst, foldl1, not, (&&), (<$>)) import qualified Prelude as P (null) import Graphics.Implicit.ExtOpenScad.Definitions (ArgParser(AP, APTest, APBranch, APTerminator, APFailIf, APExample), OVal (OError), TestInvariant(EulerCharacteristic), Symbol, VarLookup(VarLookup)) @@ -82,8 +82,8 @@ argMap :: -> ArgParser a -- ^ ArgParser to apply them to -> (Maybe a, [String]) -- ^ (result, error messages) argMap args = argMap2 unnamedArgs (VarLookup $ fromList namedArgs) where - unnamedArgs = fmap snd $ filter (isNothing . fst) args - namedArgs = fmap (first fromJust) $ filter (isJust . fst) args + unnamedArgs = snd <$> filter (isNothing . fst) args + namedArgs = first fromJust <$> filter (isJust . fst) args argMap2 :: [OVal] -> VarLookup -> ArgParser a -> (Maybe a, [String]) argMap2 unnamedArgs namedArgs (APBranch branches) = diff --git a/Graphics/Implicit/ObjectUtil/GetImplicit3.hs b/Graphics/Implicit/ObjectUtil/GetImplicit3.hs index 96bcb41..626c512 100644 --- a/Graphics/Implicit/ObjectUtil/GetImplicit3.hs +++ b/Graphics/Implicit/ObjectUtil/GetImplicit3.hs @@ -5,7 +5,7 @@ module Graphics.Implicit.ObjectUtil.GetImplicit3 (getImplicit3) where -import Prelude (Either(Left, Right), abs, (-), (/), (*), sqrt, (+), atan2, max, cos, fmap, minimum, ($), (**), sin, pi, (.), Bool(True, False), ceiling, floor, pure, error, head, tail, (>), (&&), (<), (==), otherwise) +import Prelude (Either(Left, Right), abs, (-), (/), (*), sqrt, (+), atan2, max, cos, fmap, minimum, ($), (**), sin, pi, (.), Bool(True, False), ceiling, floor, pure, error, head, tail, (>), (&&), (<), (==), otherwise, (<$>)) import Graphics.Implicit.Definitions (ℝ, ℕ, ℝ2, ℝ3, (⋯/), Obj3, SymbolicObj3(Shell3, UnionR3, IntersectR3, DifferenceR3, Translate3, Scale3, Rotate3, @@ -49,25 +49,21 @@ getImplicit3 (Complement3 symbObj) = in \p -> - obj p getImplicit3 (UnionR3 r symbObjs) = - let - objs = fmap getImplicit3 symbObjs - in - \p -> rminimum r $ fmap ($p) objs + \p -> rminimum r $ fmap ($p) $ getImplicit3 <$> symbObjs + getImplicit3 (IntersectR3 r symbObjs) = - let - objs = fmap getImplicit3 symbObjs - in - \p -> rmaximum r $ fmap ($p) objs + \p -> rmaximum r $ fmap ($p) $ getImplicit3 <$> symbObjs + getImplicit3 (DifferenceR3 r symbObjs) = let - tailObjs = fmap getImplicit3 $ tail symbObjs + tailObjs = getImplicit3 <$> tail symbObjs headObj = getImplicit3 $ head symbObjs complement :: Obj3 -> ℝ3 -> ℝ complement obj' p = - obj' p in \p -> do let - maxTail = rmaximum r $ fmap ($p) $ fmap complement tailObjs + maxTail = rmaximum r $ fmap ($p) $ complement <$> tailObjs if maxTail > -minℝ && maxTail < minℝ then rmax r (headObj p) minℝ else rmax r (headObj p) maxTail diff --git a/programs/Benchmark.hs b/programs/Benchmark.hs index 1ce0c24..e9edf1b 100644 --- a/programs/Benchmark.hs +++ b/programs/Benchmark.hs @@ -6,7 +6,7 @@ -- Let's be explicit about where things come from :) -import Prelude (($), (*), (/), String, IO, cos, pi, fmap, zip3, Either(Left, Right), fromIntegral, (<>)) +import Prelude (($), (*), (/), String, IO, cos, pi, fmap, zip3, Either(Left, Right), fromIntegral, (<>), (<$>)) -- Use criterion for benchmarking. see import Criterion.Main (Benchmark, bgroup, bench, nf, nfAppIO, defaultMain) @@ -48,12 +48,13 @@ object2 = squarePipe (10,10,10) 1 100 squarePipe :: (ℝ,ℝ,ℝ) -> ℝ -> ℝ -> SymbolicObj3 squarePipe (x,y,z) diameter precision = union - $ fmap (\start-> translate start + ((\start-> translate start $ rect3R 0 (0,0,0) (diameter,diameter,diameter) ) - $ zip3 (fmap (\n->(fromIntegral n/precision)*x) [0..100::Fastℕ]) + <$> + zip3 (fmap (\n->(fromIntegral n/precision)*x) [0..100::Fastℕ]) (fmap (\n->(fromIntegral n/precision)*y) [0..100::Fastℕ]) - (fmap (\n->(fromIntegral n/precision)*z) [0..100::Fastℕ]) + (fmap (\n->(fromIntegral n/precision)*z) [0..100::Fastℕ])) -- | A third 3d object to benchmark. object3 :: SymbolicObj3 diff --git a/programs/extopenscad.hs b/programs/extopenscad.hs index 8910339..17c1ee0 100644 --- a/programs/extopenscad.hs +++ b/programs/extopenscad.hs @@ -349,7 +349,7 @@ run rawargs = do _ -> hPutStr stderr "ERROR: File contains a mixture of 2D and 3D objects, what do you want to render?\n" -- | Always display our warnings, errors, and other non-textout messages on stderr. - hPutStr stderr $ unlines $ fmap show $ filter (not . isTextOut) messages + hPutStr stderr $ unlines $ show <$> filter (not . isTextOut) messages let textOutHandler = case () of @@ -357,7 +357,7 @@ run rawargs = do _ | rawEcho args -> textOutBare _ -> show - hPutStr hMessageOutput $ unlines $ fmap textOutHandler $ filter isTextOut messages + hPutStr hMessageOutput $ unlines $ textOutHandler <$> filter isTextOut messages -- | The entry point. Use the option parser then run the extended OpenScad code. main :: IO () diff --git a/tests/MessageSpec/Util.hs b/tests/MessageSpec/Util.hs index 4152af5..96d4ac1 100644 --- a/tests/MessageSpec/Util.hs +++ b/tests/MessageSpec/Util.hs @@ -36,7 +36,7 @@ infixr 1 --> -- | Types -- | An even smaller wrapper which runs a program, and only returns the generated messages. for the test suite. -getOpenscadMessages :: ScadOpts -> [String] -> String -> IO ([Message]) +getOpenscadMessages :: ScadOpts -> [String] -> String -> IO [Message] getOpenscadMessages scadOpts constants source = do (_, _, _, messages) <- runOpenscad scadOpts constants source return messages