Comments, or other hlint inspired nonfuncional changes.

Author: julialongtin

Graphics/Implicit/Definitions.hs

@@ -83,7 +83,7 @@ where
 
 import GHC.Generics (Generic)
 
-import Prelude (Foldable, Num, Ord, Eq, atan2, asin, pi, (>=), signum, abs, (+), (-), RealFloat, (==), ($), flip, Semigroup((<>)), Monoid (mempty), Double, Either(Left, Right), Bool(True, False), (*), (/), fromIntegral, Float, realToFrac, (&&), RealFloat(isNaN), (||), any)
+import Prelude (Foldable, Num, Ord, Eq, atan2, asin, elem, pi, (>=), signum, abs, (+), (-), RealFloat, (==), ($), flip, Semigroup((<>)), Monoid (mempty), Double, Either(Left, Right), Bool(True, False), (*), (/), fromIntegral, Float, realToFrac, (&&), RealFloat(isNaN), (||))
 
 import Graphics.Implicit.FastIntUtil as F (Fastℕ(Fastℕ), fromFastℕ, toFastℕ)
 
@@ -456,4 +456,4 @@ hasZeroComponent
     => f a
     -> Bool
 {-# INLINABLE hasZeroComponent #-}
-hasZeroComponent =  any (==0)
+hasZeroComponent =  elem 0

Graphics/Implicit/Export/DiscreteAproxable.hs

@@ -31,8 +31,10 @@ import Codec.Picture (DynamicImage(ImageRGBA8), PixelRGBA8(PixelRGBA8), generate
 
 import Control.Parallel.Strategies (using, rdeepseq, parBuffer)
 
-import Linear ( V3(V3), V2(V2), (*^), (^/) )
-import Linear.Affine ( Affine((.+^), (.-^)) )
+import Linear (V3(V3), V2(V2), (*^), (^/))
+
+import Linear.Affine (Affine((.+^), (.-^)))
+
 import Graphics.Implicit.Primitives (getImplicit)
 
 default (ℝ)
@@ -82,13 +84,13 @@ instance DiscreteAproxable SymbolicObj3 DynamicImage where
                             (cameraRay camera (V2 a b + V2 ( 0.25/w) (0.25/h)))
                             2 box scene,
                         traceRay
-                            (cameraRay camera (V2 a b + V2 (-0.25/w) (0.25/h)))
+                            (cameraRay camera (V2 a b + V2 (-(0.25/w)) (0.25/h)))
                             0.5 box scene,
                         traceRay
-                            (cameraRay camera (V2 a b + V2 (0.25/w) (-0.25/h)))
+                            (cameraRay camera (V2 a b + V2 (0.25/w) (-(0.25/h))))
                             0.5 box scene,
                         traceRay
-                            (cameraRay camera (V2 a b + V2 (-0.25/w) (-0.25/h)))
+                            (cameraRay camera (V2 a b + V2 (-(0.25/w)) (-(0.25/h))))
                             0.5 box scene
                         ]
                     where
@@ -113,7 +115,7 @@ instance DiscreteAproxable SymbolicObj2 DynamicImage where
             pixelRenderer :: Int -> Int -> PixelRGBA8
             pixelRenderer mya myb = mycolor
                 where
-                    xy a b = (V2 x1 y2 .-^ V2 (dxy-dx) (dy-dxy) ^/2) .+^ dxy *^ V2 (a/w) (-b/h)
+                    xy a b = (V2 x1 y2 .-^ V2 (dxy-dx) (dy-dxy) ^/2) .+^ dxy *^ V2 (a/w) (-(b/h))
                     s = 0.25 :: ℝ
                     V2 a' b' = V2 (realToFrac mya) (realToFrac myb) :: ℝ2
                     mycolor = colorToPixelRGBA8 $ average [objColor $ xy a' b', objColor $ xy a' b',

Graphics/Implicit/Export/Render/RefineSegs.hs

@@ -41,7 +41,7 @@ detail n res obj (Polyline [p1, p2]) | n < 2 =
        else
          let
            normal = (\(V2 a b) -> V2 b (-a)) $ normalize (p2 - p1)
-           derivN = -(obj (mid - (normal ^* (midval/2))) - midval) * (2/midval)
+           derivN = -((obj (mid - (normal ^* (midval/2))) - midval) * (2/midval))
          in
            if abs derivN > 0.5 && abs derivN < 2 && abs (midval/derivN) < 3*res
            then

Graphics/Implicit/Export/SymbolicFormats.hs

@@ -137,7 +137,7 @@ buildS3 _ (Cylinder h r1 r2) = callNaked "cylinder" ["r1 = " <> pretty (bf r1)
                                                     , pretty $ bf h
                                                     ] []
 
-buildS3 _ (Polyhedron points tris) = callNaked "polyhedron" ["points = [" <> (fold $ intersperse "," $ renderPoint <$> points) <> "], faces = [" <> (fold $ intersperse "," $ renderTri <$> tris) <> "]" ] []
+buildS3 _ (Polyhedron points tris) = callNaked "polyhedron" ["points = [" <> fold (intersperse "," $ renderPoint <$> points) <> "], faces = [" <> fold (intersperse "," $ renderTri <$> tris) <> "]" ] []
   where
     renderPoint (V3 v1 v2 v3) = "[" <> pretty (bf v1) <> "," <> pretty (bf v2) <> "," <> pretty (bf v3) <> "]"
     renderTri (n1,n2,n3) = "[" <> pretty (bℕ n1) <> "," <> pretty (bℕ n2) <> "," <> pretty (bℕ n3) <> "]"

Graphics/Implicit/ExtOpenScad/Default.hs

@@ -51,6 +51,7 @@ import Graphics.Implicit.MathUtil (infty)
 clamp :: Ord a => (a, a) -> a -> a
 clamp (lower, upper) a = min upper (max lower a)
 
+-- | Find functions in our SCAD sandbox.
 defaultObjects :: Bool -> VarLookup
 defaultObjects withCSG = VarLookup $ fromList $
     defaultConstants
@@ -62,6 +63,7 @@ defaultObjects withCSG = VarLookup $ fromList $
     <> objectFunctions
     <> varArgModules
 
+-- | Constants from Haskell.
 defaultConstants :: [(Symbol, OVal)]
 defaultConstants = (\(a,b) -> (a, toOObj (b :: ℝ))) <$>
     [(Symbol "pi", pi),
@@ -77,6 +79,7 @@ nanNegInf x = if isNaN x then -infty else x
 signedNaNInf :: RealFloat a => a -> a -> a
 signedNaNInf x y = if isNaN y then signum x * infty else y
 
+-- | Functions which only take one argument.
 defaultFunctions :: [(Symbol, OVal)]
 defaultFunctions = (\(a,b) -> (a, toOObj ( b :: ℝ -> ℝ))) <$>
     [
@@ -108,6 +111,7 @@ defaultFunctions = (\(a,b) -> (a, toOObj ( b :: ℝ -> ℝ))) <$>
         (Symbol "sqrt",  clamp (0, infty) . nanNegInf . sqrt)
     ]
 
+-- | Functions which take two arguments.
 defaultFunctions2 :: [(Symbol, OVal)]
 defaultFunctions2 = (\(a,b) -> (a, toOObj (b :: ℝ -> ℝ -> ℝ))) <$>
     [
@@ -117,6 +121,7 @@ defaultFunctions2 = (\(a,b) -> (a, toOObj (b :: ℝ -> ℝ -> ℝ))) <$>
         (Symbol "pow",   (**))
     ]
 
+-- | Special functions, which accept a funcion as their first argument. Map has to be special.
 defaultFunctionsSpecial :: [(Symbol, OVal)]
 defaultFunctionsSpecial =
     [

Graphics/Implicit/ExtOpenScad/Definitions.hs

@@ -199,9 +199,9 @@ data OVal = OUndefined
          | OIO (IO OVal)
          -- Name, arguments, argument parsers.
          | OUModule Symbol (Maybe [(Symbol, Bool)]) (VarLookup -> ArgParser (StateC [OVal]))
-         -- Name, implementation, arguments.
+         -- Name, implementation, instances.
          | ONModule Symbol (SourcePosition -> ArgParser (StateC [OVal])) [[(Symbol, Bool)]]
-         -- Name, implementation, arguments.
+         -- Name, implementation, instances.
          | ONModuleWithSuite Symbol (SourcePosition -> [OVal] -> ArgParser (StateC [OVal])) [[(Symbol, Bool)]]
          | OVargsModule Symbol (Symbol -> SourcePosition -> [(Maybe Symbol, OVal)] -> [StatementI] -> ([StatementI] -> StateC ()) -> StateC ())
          | OObj3 SymbolicObj3
@@ -303,11 +303,11 @@ varUnion (VarLookup a) (VarLookup b) = VarLookup $ union a b
 lookupVarIn :: Text -> VarLookup -> Maybe OVal
 lookupVarIn target (VarLookup vars) = lookup (Symbol target) vars
 
--- | Our tests. We only have the one, and it is to check the Euler characteristic of a mesh.
+-- | Our tests.
 data TestInvariant =
-    EulerCharacteristic ℕ
-  | ContoursAreClosed
-  | MeshIsWaterTight
+    EulerCharacteristic ℕ -- check the Euler characteristic of a mesh.
+  | ContoursAreClosed -- Ensure all contours are Closed (start and stop with the same point)
+  | MeshIsWaterTight -- Ensure all of the triangles in the mesh have neighbors.
     deriving (Show)
 
 -- | for composing ArgParsers.

Graphics/Implicit/ExtOpenScad/Eval/Expr.hs

@@ -5,6 +5,9 @@
 -- Allow us to use string literals for Text
 {-# LANGUAGE OverloadedStrings #-}
 
+-- Allow us to treat incomplete tuples as function references.
+{-# LANGUAGE TupleSections #-}
+
 module Graphics.Implicit.ExtOpenScad.Eval.Expr (evalArgs, evalExpr, rawRunExpr, matchPat, StateE, ExprState(ExprState), addMessage) where
 
 import Prelude (String, Monoid, Maybe(Just, Nothing), Bool (False, True), ($), elem, mempty, pure, show, zip, (&&), const, (<>), foldr, foldMap, (.), (<$>), traverse)
@@ -72,14 +75,14 @@ type StateE a = ImplicitCadM Input [Message] ExprState Identity a
 runStateE :: Input -> ExprState -> StateE a -> (a, [Message], ExprState)
 runStateE r s m = runIdentity $ runImplicitCadM r s m
 
--- Add a message to our list of messages contained in the StatE monad.
+-- | Add a message to our list of messages contained in the StateE monad.
 addMessage :: MessageType -> SourcePosition -> Text -> StateE ()
 addMessage mtype pos text = addMesg $ Message mtype pos text
   where
     addMesg :: Message -> StateE ()
     addMesg = tell . pure
 
--- Log an error condition.
+-- | Log an error condition.
 errorE :: SourcePosition -> Text -> StateE ()
 errorE = addMessage Error
 
@@ -122,10 +125,10 @@ evalExpr sourcePos expr = case expr of
                                 evalExprStateC sourcePos expr
                             _ -> evalExprStateC sourcePos expr
   where
-    isModule (OUModule _ _ _) = True
-    isModule (ONModule _ _ _) = True
-    isModule (ONModuleWithSuite _ _ _) = True
-    isModule (OVargsModule _ _) = True
+    isModule (OUModule {}) = True
+    isModule (ONModule {}) = True
+    isModule (ONModuleWithSuite {}) = True
+    isModule (OVargsModule {}) = True
     isModule _ = False
     -- FIXME: We may need a better result cannonicalizer here.
     canonicalizeRes (OList [oneItem]) = oneItem
@@ -136,7 +139,7 @@ runExprModule :: SourcePosition -> OVal -> [Expr] -> StateC [OVal]
 runExprModule sourcePos mod argExprsRaw = do
   let
     -- Mark all of our arguments as unnamed. There are no named arguments in expressions.
-    argExprs = (\a -> (Nothing, a)) <$> argExprsRaw
+    argExprs = (Nothing,) <$> argExprsRaw
     -- Common error messages.
     noSuiteError,notModError :: (Monoid a) => StateC a
     noSuiteError = do
@@ -151,10 +154,10 @@ runExprModule sourcePos mod argExprsRaw = do
 
   -- We can't handle any suites, either.
   _ <- case mod of
-         (OUModule _ _ _) -> pure mempty :: StateC ()
-         (ONModule _ _ _) -> pure mempty
-         (ONModuleWithSuite _ _ _) -> noSuiteError
-         (OVargsModule _ _) -> noSuiteError
+         (OUModule {}) -> pure mempty :: StateC ()
+         (ONModule {}) -> pure mempty
+         (ONModuleWithSuite {}) -> noSuiteError
+         (OVargsModule {}) -> noSuiteError
          _ -> notModError
 
   -- Perform any per-module-type specific housework, and call the module.
@@ -169,8 +172,8 @@ runExprModule sourcePos mod argExprsRaw = do
     (ONModule _ implementation _) -> do
       -- Run the module.
       runModule sourcePos $ argMap evaluatedArgs $ implementation sourcePos
-    (ONModuleWithSuite _ _ _) -> noSuiteError
-    (OVargsModule _ _) -> noSuiteError
+    (ONModuleWithSuite {}) -> noSuiteError
+    (OVargsModule {}) -> noSuiteError
     _ -> notModError
 
 -- | The inner monadic entry point. Evaluates an expression, pureing the result, and moving any error messages generated into the calling StateC.
@@ -185,7 +188,7 @@ evalExprStateC pos expr = do
     traverse_ moveMessage messages
     pure $ valf []
 
--- A more raw entry point, that does not depend on IO.
+-- A pure entry point, that does not do module calls, and does not depend on IO.
 rawRunExpr :: SourcePosition -> VarLookup -> Expr -> (OVal, [Message])
 rawRunExpr pos vars expr = do
   let
@@ -241,7 +244,7 @@ evalExpr' (fexpr :$ argExprs) = do
             app f l = case (getErrors f, getErrors $ OList l) of
                 (Nothing, Nothing) -> app' f l
                     where
-                        -- apply function to the list of its arguments until we run out
+                        -- Apply a function to the list of its arguments until we run out
                         -- of them
                         app' (OFunc f') (x:xs) = app (f' x) xs
                         app' a [] = a

Graphics/Implicit/ExtOpenScad/Eval/Statement.hs

@@ -51,11 +51,10 @@ import System.Directory (doesFileExist)
 import System.FilePath (takeDirectory)
 import Control.Monad.Reader.Class (MonadReader(ask))
 
--- | Run statements out of the OpenScad file.
+-- | Run a single OpenSCAD statement.
 runStatementI :: StatementI -> StateC ()
 runStatementI (StatementI sourcePos (pat := expr)) = do
     -- Interpret variable assignment
-    -- FIXME: instead of just expression evaluation, module calling?
     val <- evalExpr sourcePos expr
     let posMatch = matchPat pat val
     case (getErrors val, posMatch) of
@@ -107,19 +106,19 @@ runStatementI (StatementI sourcePos (ModuleCall (Symbol name) argsExpr suite)) =
 
           -- Evaluate the suites, if required.
           suiteResults <- case maybeMod of
-                            Just mod@(OUModule _ _ _) -> ensureNoSuite sourcePos mod suite
-                            Just mod@(ONModule _ _ _) -> ensureNoSuite sourcePos mod suite
-                            Just (ONModuleWithSuite _ _ _) -> evalSuite varlookup sourcePos suite
-                            Just mod@(OVargsModule _ _) -> ensureNoSuite sourcePos mod suite
-                            _ -> pure []
+            Just mod@(OUModule {}) -> ensureNoSuite sourcePos mod suite
+            Just mod@(ONModule {}) -> ensureNoSuite sourcePos mod suite
+            Just (ONModuleWithSuite {}) -> evalSuite varlookup sourcePos suite
+            Just mod@(OVargsModule {}) -> ensureNoSuite sourcePos mod suite
+            _ -> pure []
 
           -- Check that an instance exists that can execute the module, as it was called.
-          _ <- case maybeMod of
-                 Just (OUModule _ _ _) -> pure ()
-                 Just mod@(ONModule _ _ forms) -> checkInstances sourcePos mod argsExpr forms
-                 Just mod@(ONModuleWithSuite _ _ forms) -> checkInstances sourcePos mod argsExpr forms
-                 Just (OVargsModule _ _) -> pure ()
-                 _ -> pure ()
+          case maybeMod of
+            Just (OUModule {}) -> pure ()
+            Just mod@(ONModule _ _ forms) -> checkInstances sourcePos mod argsExpr forms
+            Just mod@(ONModuleWithSuite _ _ forms) -> checkInstances sourcePos mod argsExpr forms
+            Just (OVargsModule {}) -> pure ()
+            _ -> pure ()
 
           -- do any per-module-type work, and run the module.
           case maybeMod of
@@ -137,17 +136,17 @@ runStatementI (StatementI sourcePos (ModuleCall (Symbol name) argsExpr suite)) =
               -- Run the module.
               runModule sourcePos $ argMap evaluatedArgs $ implementation sourcePos suiteResults
             Just (OVargsModule modname implementation) -> do
-              -- Run the module, which evaluates it's own suite.
-              _ <- implementation modname sourcePos evaluatedArgs suite runSuite -- no values are pureed
+              -- Run the module, which evaluates it's own suite, and cannot return anything.
+              implementation modname sourcePos evaluatedArgs suite runSuite
               pure []
             Just foo -> do
-                    case getErrors foo of
-                        Just err -> errorC sourcePos err
-                        Nothing  -> errorC sourcePos $ "Object " <> name <> " is not a module!"
-                    pure []
+              case getErrors foo of
+                Just err -> errorC sourcePos err
+                Nothing  -> errorC sourcePos $ "Object " <> name <> " is not a module!"
+              pure []
             _ -> do
-                errorC sourcePos $ "Module " <> name <> " not in scope."
-                pure []
+              errorC sourcePos $ "Module " <> name <> " not in scope."
+              pure []
         pushVals newVals
 
 runStatementI (StatementI sourcePos (Include name injectVals)) = do