Replace most of Prelude head, last, minimum, maximum with their Safe …

Graphics/Slicer/Machine/Infill.hs

@@ -22,7 +22,8 @@
 
 module Graphics.Slicer.Machine.Infill (makeInfill, makeSupport) where
 
-import Prelude ((+), (<$>), ($), maximum, minimum, filter, (>), head, (.), flip, (*), sqrt, (-), (<>), show, error, otherwise, (&&), (==), length, (<), concat, not, null, (!!), fmap, (||))
+import Prelude ((+), (<$>), ($), head, filter, (>), (.), flip, (*), sqrt, (-), (<>), show, error, otherwise, (&&), (==), length, (<), concat, not, null, (!!), fmap, (||))
+import Safe (headNote, maximumNote, minimumNote)
 
 import Data.Maybe (Maybe(Just, Nothing), catMaybes, mapMaybe, fromMaybe)
 
@@ -90,10 +91,10 @@ coveringLinesNegative :: Contour -> ℝ -> ℝ -> [Line]
 coveringLinesNegative (Contour contourPoints) ls zHeight = flip Line s . f <$> [-xMin,-xMin+lsX..xMax]
     where s = Point (xMaxOutside,yMaxOutside,0)
           f v = Point (v,0,zHeight)
-          xMinRaw = minimum $ xOf <$> contourPoints
-          xMin = head $ filter (> xMinRaw) [0,ls..]
-          xMax = maximum $ xOf <$> contourPoints
-          yMax = maximum $ yOf <$> contourPoints
+          xMinRaw = minimumNote "convergingLinesNegative xMinRaw" $ xOf <$> contourPoints
+          xMin = headNote "convergingLinesNegative xMin" $ filter (> xMinRaw) [0,ls..]
+          xMax = maximumNote "convergingLinesNegative x" $ xOf <$> contourPoints
+          yMax = maximumNote "convergingLinesNegative y" $ yOf <$> contourPoints
           xMaxOutside = xMax + ls
           yMaxOutside = yMax + ls
           lsX = sqrt $ ls*ls+ls*ls
@@ -107,10 +108,10 @@ coveringLinesPositive :: Contour -> ℝ -> ℝ -> [Line]
 coveringLinesPositive (Contour contourPoints) ls zHeight = flip Line s . f <$> [0,lsY..yMax + xMax]
     where s =  Point (xMaxOutside + yMaxOutside,- xMaxOutside - yMaxOutside,0)
           f v = Point (0,v,zHeight)
-          yMinRaw = minimum $ yOf <$> contourPoints
-          yMin = head $ filter (> yMinRaw) [0,ls..]
-          yMax = maximum $ yOf <$> contourPoints
-          xMax = maximum $ xOf <$> contourPoints
+          yMinRaw = minimumNote "convergingLinesPositive yMinRaw" $ yOf <$> contourPoints
+          yMin = headNote "convergingLinesPositive yMin" $ filter (> yMinRaw) [0,ls..]
+          yMax = maximumNote "convergingLinesPositive y" $ yOf <$> contourPoints
+          xMax = maximumNote "convergingLinesPositive x" $ xOf <$> contourPoints
           xMaxOutside = xMax + ls
           yMaxOutside = yMax + ls
           lsY = sqrt $ ls*ls+ls*ls
@@ -124,10 +125,10 @@ coveringLinesVertical :: Contour -> ℝ -> ℝ -> [Line]
 coveringLinesVertical (Contour contourPoints) ls zHeight = flip Line s . f <$> [xMin,xMin+ls..xMax]
     where s =  Point (0,yMaxOutside,0)
           f v = Point (v,0,zHeight)
-          xMinRaw = minimum $ xOf <$> contourPoints
-          xMin = head $ filter (> xMinRaw) [0,ls..]
-          xMax = maximum $ xOf <$> contourPoints
-          yMax = maximum $ yOf <$> contourPoints
+          xMinRaw = minimumNote "convergingLinesVertical xMin" $ xOf <$> contourPoints
+          xMin = headNote "convergingLinesVertical xMin"$ filter (> xMinRaw) [0,ls..]
+          xMax = maximumNote "convergingLinesVertical x" $ xOf <$> contourPoints
+          yMax = maximumNote "convergingLinesVertical y" $ yOf <$> contourPoints
           yMaxOutside = yMax + ls
           xOf, yOf :: Point -> ℝ
           xOf (Point (x,_,_)) = x
@@ -139,10 +140,10 @@ coveringLinesHorizontal :: Contour -> ℝ -> ℝ -> [Line]
 coveringLinesHorizontal (Contour contourPoints) ls zHeight = flip Line s . f <$> [yMin,yMin+ls..yMax]
     where s =  Point (xMaxOutside,0,0)
           f v = Point (0,v,zHeight)
-          yMinRaw = minimum $ yOf <$> contourPoints
-          yMin = head $ filter (> yMinRaw) [0,ls..]
-          yMax = maximum $ yOf <$> contourPoints
-          xMax = maximum $ xOf <$> contourPoints
+          yMinRaw = minimumNote "convergingLinesHorizontal yMinRaw" $ yOf <$> contourPoints
+          yMin = headNote "convergingLinesHorizontal yMin" $ filter (> yMinRaw) [0,ls..]
+          yMax = maximumNote "convergingLinesHorizontal y" $ yOf <$> contourPoints
+          xMax = maximumNote "convergingLinesHorizontal x" $ xOf <$> contourPoints
           xMaxOutside = xMax + ls
           xOf, yOf :: Point -> ℝ
           xOf (Point (x,_,_)) = x
@@ -178,10 +179,10 @@ boundingBoxAll :: [Contour] -> Maybe BBox
 boundingBoxAll contours = if isEmptyBBox box then Nothing else Just box
     where
       box  = BBox (minX, minY) (maxX, maxY)
-      minX = minimum $ (\(BBox (x1,_) _) -> x1) <$> bBoxes
-      minY = minimum $ (\(BBox (_,y1) _) -> y1) <$> bBoxes
-      maxX = maximum $ (\(BBox _ (x2,_)) -> x2) <$> bBoxes
-      maxY = maximum $ (\(BBox _ (_,y2)) -> y2) <$> bBoxes
+      minX = minimumNote "boundingBoxAll" $ (\(BBox (x1,_) _) -> x1) <$> bBoxes
+      minY = minimumNote "boundingBoxAll" $ (\(BBox (_,y1) _) -> y1) <$> bBoxes
+      maxX = maximumNote "boundingBoxAll" $ (\(BBox _ (x2,_)) -> x2) <$> bBoxes
+      maxY = maximumNote "boundingBoxAll" $ (\(BBox _ (_,y2)) -> y2) <$> bBoxes
       bBoxes = mapMaybe boundingBox contours
 
 -- Get a 2D bounding box of a 2D contour.
@@ -190,10 +191,10 @@ boundingBox (Contour []) = Nothing
 boundingBox (Contour contourPoints) = if isEmptyBBox box then Nothing else Just box
   where
     box  = BBox (minX, minY) (maxX, maxY)
-    minX = minimum $ xOf <$> contourPoints
-    minY = minimum $ yOf <$> contourPoints
-    maxX = maximum $ xOf <$> contourPoints
-    maxY = maximum $ yOf <$> contourPoints
+    minX = minimumNote "boundingBox" $ xOf <$> contourPoints
+    minY = minimumNote "boundingBox" $ yOf <$> contourPoints
+    maxX = maximumNote "boundingBox" $ xOf <$> contourPoints
+    maxY = maximumNote "boundingBox" $ yOf <$> contourPoints
     xOf,yOf :: Point -> ℝ
     xOf (Point (x,_,_)) = x
     yOf (Point (_,y,_)) = y

Graphics/Slicer/Math/Contour.hs

@@ -21,7 +21,8 @@
 
 module Graphics.Slicer.Math.Contour (getContours, makeContourTree, innerPerimeterPoint, outerPerimeterPoint, lineToOutsideContour, ContourTree(ContourTree), lineEntersContour) where
 
-import Prelude ((==), otherwise, (++), (||), (.), null, (<$>), ($), (>), length, Show, filter, (/=), odd, snd, error, (<>), show, fst, (*), Bool, (-), (<), pi, (&&), sqrt, (+), (<*>), minimum, maximum)
+import Prelude ((==), otherwise, (++), (||), (.), null, (<$>), ($), (>), length, Show, filter, (/=), odd, snd, error, (<>), show, fst, (*), Bool, (-), (<), pi, (&&), sqrt, (+), (<*>))
+import Safe (maximumNote, minimumNote, headNote, lastNote)
 
 import Data.List(find, delete, tail, last, head, init, zipWith, nub)
 
@@ -52,7 +53,7 @@ makeContours :: ([[Point]], [[Point]]) -> [[Point]]
 makeContours (contours, pairs)
   | null pairs = contours
   | otherwise = makeContours (contours ++ [next], ps)
-  where (next, ps) = findContour (head pairs, tail pairs)
+  where (next, ps) = findContour (headNote "makeContours" pairs, tail pairs)
 
 -- FIXME: square is double loop?
 -- NOTE: drop contours with less than 3 points.
@@ -72,7 +73,7 @@ getContours pointPairs = Contour <$> (filteredContourSets foundContourSets)
 
 -- | Given a line, generate a pair of lines from points on both sides of the given line's midpoint to the origin, on the same z plane as the given line.
 perimeterLinesToCheck :: ℝ -> Line -> (Line, Line)
-perimeterLinesToCheck pathWidth l@(Line p _) = (head linePair, last linePair)
+perimeterLinesToCheck pathWidth l@(Line p _) = (headNote "perimeterLinesToCheck" linePair, lastNote "perimeterLinesToCheck" linePair)
   where
     linePair = (`lineFromEndpoints` Point (0,0,zOf p)) . endpoint . pointSlopeLength (midpoint l) (lineSlope m) . (*pathWidth) <$> [-1,1]
     Line _ m = perpendicularBisector l
@@ -109,8 +110,8 @@ innerPerimeterPoint pathWidth contour l
 -- | Find an exterior point on the perpendicular bisector of the given line, pathWidth from the line.
 outerPerimeterPoint :: ℝ -> Contour -> Line -> Point
 outerPerimeterPoint pathWidth contour l
-      | (snd $ head intersections) == innerPoint = snd $ last intersections
-      | otherwise = snd $ head intersections
+      | (snd $ headNote "outerPerimeterPoint" intersections) == innerPoint = snd $ lastNote "outerPerimeterPoint" intersections
+      | otherwise = snd $ headNote "outerPerimeterPoint #2" intersections
     where
       linesToCheck = perimeterLinesToCheck pathWidth l
       bothLinesToCheck = fst linesToCheck : [snd linesToCheck]
@@ -129,7 +130,7 @@ outerPerimeterPoint pathWidth contour l
 
 -- | Given a point and slope (on an xy plane), make a line segment, where the far end is guaranteed to be outside the contour.
 lineToOutsideContour :: Contour -> ℝ -> Slope -> Point -> Line
-lineToOutsideContour (Contour contourPoints) outsideDistance m p@(Point (_,_,z)) = head . makeLines . nub $ (roundPoint <$> points)
+lineToOutsideContour (Contour contourPoints) outsideDistance m p@(Point (_,_,z)) = headNote "lineToOutsideContour" . makeLines . nub $ (roundPoint <$> points)
     where
       longestLength = sqrt $ dx*dx + dy*dy
       halfLine@(Line p' s) = pointSlopeLength p m longestLength -- should have p' == p
@@ -142,10 +143,10 @@ lineToOutsideContour (Contour contourPoints) outsideDistance m p@(Point (_,_,z))
       saneIntersection res = error $ "insane result drawing a line to the edge: " <> show res <> "\n"
       edges = lineFromEndpoints <$> [Point (xMin,yMin,z), Point (xMax,yMax,z)]
                                 <*> [Point (xMin,yMax,z), Point (xMax,yMin,z)]
-      xMinRaw = minimum $ xOf <$> contourPoints
-      yMinRaw = minimum $ yOf <$> contourPoints
-      xMaxRaw = maximum $ xOf <$> contourPoints
-      yMaxRaw = maximum $ yOf <$> contourPoints
+      xMinRaw = minimumNote "lineToOutsideContour x" $ xOf <$> contourPoints
+      yMinRaw = minimumNote "lineToOutsideContour y" $ yOf <$> contourPoints
+      xMaxRaw = maximumNote "lineToOutsideContour x" $ xOf <$> contourPoints
+      yMaxRaw = maximumNote "lineToOutsideContour y" $ yOf <$> contourPoints
       (dx,dy) = (xMax-xMin, yMax-yMin)
       xMin = xMinRaw - outsideDistance
       yMin = yMinRaw - outsideDistance
@@ -183,7 +184,7 @@ contourContainsContour parent child = if odd noIntersections then Just child els
     saneIntersection res = error $ "insane result determining whether a contour contains a contour: " <> show res <> "\n"
     innerPointOf contour = innerPerimeterPoint 0.0001 contour $ oneLineOf contour
       where
-        oneLineOf (Contour contourPoints) = head $ makeLines contourPoints
+        oneLineOf (Contour contourPoints) = headNote "contourContainsContour" $ makeLines contourPoints
 
 -- determine whether a contour is inside of another contour.
 contourContainedByContour :: Contour -> Contour -> Maybe Contour
@@ -200,7 +201,7 @@ contourContainedByContour child parent = if odd noIntersections then Just child
     saneIntersection res = error $ "insane result determining whether a contour is contained by a contour: " <> show res <> "\n"    
     innerPointOf contour = innerPerimeterPoint 0.0001 contour $ oneLineOf contour
       where
-        oneLineOf (Contour contourPoints) = head $ makeLines contourPoints
+        oneLineOf (Contour contourPoints) = headNote "contourContainedByContour" $ makeLines contourPoints
 
 -- Does a given line, in the direction it is given, enter from outside of a contour to inside of a contour, through a given point?
 -- Used to check the corner case of corner cases.
@@ -221,5 +222,5 @@ lineEntersContour (Line _ m) intersection contour@(Contour contourPoints) = line
     -- lineTo has an endpoint of the intersection, lineFrom has a starting point of the intersection.
     (lineTo, lineFrom) = findLinesInContour intersection
     contourLines = makeLinesLooped contourPoints
-    findLinesInContour (HitEndpointL2 pt) = head $ catMaybes $ zipWith (\l1@(Line _ _) l2@(Line p2 _) -> if p2 == pt then Just (l1,l2) else Nothing) (init contourLines) (tail contourLines)
+    findLinesInContour (HitEndpointL2 pt) = headNote "lineEntersContour" $ catMaybes $ zipWith (\l1@(Line _ _) l2@(Line p2 _) -> if p2 == pt then Just (l1,l2) else Nothing) (init contourLines) (tail contourLines)
     findLinesInContour other = error $ "trying to find where a line enters a contour on something not a point of a contour where two lines intersect: " <> show other <> "\n" 

hslice.cabal

@@ -22,6 +22,7 @@ Library
                   implicit,
                   mtl,
                   parallel,
+                  safe,
                   utf8-string
     Ghc-options:
                 -optc-O3
@@ -67,6 +68,7 @@ Executable extcuraengine
                   optparse-applicative,
                   parallel,
                   text,
+                  safe,
                   utf8-string
     Ghc-options:
                 -threaded

programs/extcuraengine.hs

@@ -41,7 +41,8 @@ import Data.String (String)
 
 import Data.Bool(Bool(True, False), otherwise, not)
 
-import Data.List (length, zip, tail, head, zipWith, maximum, minimum, last, (++), concat, null)
+import Data.List (length, zip, tail, head, zipWith, last, (++), concat, null)
+import Safe (minimumNote, maximumNote)
 
 import Control.Monad ((>>=))
 
@@ -104,11 +105,11 @@ centeredFacetsFromSTL (RectArea (bedX,bedY,_)) stl = shiftedFacets
       shiftedFacets = [shiftFacet centerPoint facet | facet <- facets] `using` parListChunk (div (length facets) (fromFastℕ threads)) rseq
       facets = facetLinesFromSTL threads stl
       (dx,dy,dz) = (bedX/2-x0, bedY/2-y0, -zMin)
-      xMin = minimum $ xOf.point <$> foldMap sides facets
-      yMin = minimum $ yOf.point <$> foldMap sides facets
-      zMin = minimum $ zOf.point <$> foldMap sides facets
-      xMax = maximum $ xOf.point <$> foldMap sides facets
-      yMax = maximum $ yOf.point <$> foldMap sides facets
+      xMin = minimumNote "centeredFacetsFromSTL xMin" $ xOf.point <$> foldMap sides facets
+      yMin = minimumNote "centeredFacetsFromSTL yMin" $ yOf.point <$> foldMap sides facets
+      zMin = minimumNote "centeredFacetsFromSTL zMin" $ zOf.point <$> foldMap sides facets
+      xMax = maximumNote "centeredFacetsFromSTL xMax" $ xOf.point <$> foldMap sides facets
+      yMax = maximumNote "centeredFacetsFromSTL yMax" $ yOf.point <$> foldMap sides facets
       (x0,y0) = ((xMax+xMin)/2-xMin, (yMax+yMin)/2-yMin)
       xOf, yOf, zOf :: Point -> ℝ
       xOf (Point (x,_,_)) = x
@@ -128,7 +129,7 @@ layers print fs = catMaybes <$> rawContours
     allIntersections zLayer = catMaybes $ facetIntersects zLayer <$> fs
     zs = [zOf $ point triPoints | triPoints <- foldMap sides fs ] `using` parListChunk (div (length fs) (fromFastℕ threads)) rseq
     zmax :: ℝ
-    zmax = maximum zs
+    zmax = maximumNote "layers zmax" zs
     lh = layerHeight print
     zOf :: Point -> ℝ
     zOf (Point (_,_,z)) = z