3 files changed, 100 insertions(+), 29 deletions(-)

M src/Data/Text/ParagraphLayout/Internal/ParagraphExtents.hs
M src/Data/Text/ParagraphLayout/Internal/Rect.hs
M test/Data/Text/ParagraphLayout/RectSpec.hs

@@ 23,4 23,4 @@ emptyRect = Rect
     }
 
 containRects :: (Ord a, Num a) => [Rect a] -> Rect a
-containRects = foldr union emptyRect
+containRects = foldr (union LH) emptyRect

@@ 1,7 1,8 @@
 -- | Representation of an axis-aligned rectangle on a 2D plane, with one of its
 -- corners being a designated origin point.
 module Data.Text.ParagraphLayout.Internal.Rect
-    ( Rect (Rect, x_origin, y_origin, x_size, y_size)
+    ( Bias (LL, LH, HL, HH)
+    , Rect (Rect, x_origin, y_origin, x_size, y_size)
     , height
     , union
     , width


@@ 59,17 60,44 @@ x_max r = x_origin r `max` x_terminus r
 y_max :: (Num a, Ord a) => Rect a -> a
 y_max r = y_origin r `max` y_terminus r
 
--- | Calculate the smallest rectangle that completely contains the given two
--- rectangles.
+-- | Determines which corner of a calculated rectangle should be its origin.
+data Bias
+    = LL
+    -- ^ Set the origin as the corner with low X and low Y coordinates.
+    | LH
+    -- ^ Set the origin as the corner with low X and high Y coordinates.
+    | HL
+    -- ^ Set the origin as the corner with high X and low Y coordinates.
+    | HH
+    -- ^ Set the origin as the corner with high X and high Y coordinates.
+
+-- | The smallest rectangle completely containing the given two rectangles.
+--
+-- The origin of the output rectangle will be set according to `Bias`,
+-- regardless of which corners of the input rectangles are designated
+-- as their origins.
+--
+-- Note that this operation has no identity element. A rectangle whose
+-- `x_size` and/or `y_size` are zero is not considered null or neutral,
+-- but effectively acts as a point, which will be contained in the union.
+--
+-- You can use `Nothing` as an identity element if you lift this operation
+-- over the `Maybe` applicative functor:
 --
--- The origin of the resulting rectangle will be the corner with the lowest
--- X coordinate and the highest Y coordinate, regardless of the origin of the
--- input rectangles.
-union :: (Num a, Ord a) => Rect a -> Rect a -> Rect a
-union a b = Rect x_low y_high dx (-dy) where
-    x_low = x_min a `min` x_min b
-    y_low = y_min a `min` y_min b
-    x_high = x_max a `max` x_max b
-    y_high = y_max a `max` y_max b
-    dx = x_high - x_low
-    dy = y_high - y_low
+-- @
+-- `Control.Applicative.liftA2` (`union` bias)
+-- @
+union :: (Num a, Ord a) => Bias -> Rect a -> Rect a -> Rect a
+union bias a b =
+    case bias of
+        LL -> Rect lx ly dx dy
+        LH -> Rect lx hy dx (-dy)
+        HL -> Rect hx ly (-dx) dy
+        HH -> Rect hx hy (-dx) (-dy)
+    where
+        lx = x_min a `min` x_min b
+        ly = y_min a `min` y_min b
+        hx = x_max a `max` x_max b
+        hy = y_max a `max` y_max b
+        dx = hx - lx
+        dy = hy - ly

@@ 13,17 13,60 @@ negativeRect = Rect 80 (-75) (-15) (-15)
 
 spec :: Spec
 spec = do
-    describe "union of two rects" $ do
-        let r = union positiveRect negativeRect
-        it "has origin at 50,-60" $
-            (x_origin r, y_origin r) `shouldBe` (50, -60)
-        it "has minimum coordinates at at 50,-90" $
-            (x_min r, y_min r) `shouldBe` (50, -90)
-        it "has terminus at 80,-90" $
-            (x_terminus r, y_terminus r) `shouldBe` (80, -90)
-        it "has maximum coordinates at 80,-60" $
-            (x_max r, y_max r) `shouldBe` (80, -60)
-        it "has size 30,-30" $
-            (x_size r, y_size r) `shouldBe` (30, -30)
-        it "has absolute size 30,30" $
-            (width r, height r) `shouldBe` (30, 30)
+    describe "union of two rects (low X, low Y)" $
+        llSpec $ union LL positiveRect negativeRect
+    describe "union of two rects (low X, high Y)" $
+        lhSpec $ union LH positiveRect negativeRect
+    describe "union of two rects (high X, low Y)" $
+        hlSpec $ union HL positiveRect negativeRect
+    describe "union of two rects (high X, high Y)" $
+        hhSpec $ union HH positiveRect negativeRect
+
+llSpec :: Rect Int32 -> SpecWith ()
+llSpec r = do
+    commonSpec r
+    it "has origin at 50,-90" $
+        (x_origin r, y_origin r) `shouldBe` (50, -90)
+    it "has terminus at 80,-60" $
+        (x_terminus r, y_terminus r) `shouldBe` (80, -60)
+    it "has size 30,30" $
+        (x_size r, y_size r) `shouldBe` (30, 30)
+
+lhSpec :: Rect Int32 -> SpecWith ()
+lhSpec r = do
+    commonSpec r
+    it "has origin at 50,-60" $
+        (x_origin r, y_origin r) `shouldBe` (50, -60)
+    it "has terminus at 80,-90" $
+        (x_terminus r, y_terminus r) `shouldBe` (80, -90)
+    it "has size 30,-30" $
+        (x_size r, y_size r) `shouldBe` (30, -30)
+
+hlSpec :: Rect Int32 -> SpecWith ()
+hlSpec r = do
+    commonSpec r
+    it "has origin at 80,-90" $
+        (x_origin r, y_origin r) `shouldBe` (80, -90)
+    it "has terminus at 50,-60" $
+        (x_terminus r, y_terminus r) `shouldBe` (50, -60)
+    it "has size -30,30" $
+        (x_size r, y_size r) `shouldBe` (-30, 30)
+
+hhSpec :: Rect Int32 -> SpecWith ()
+hhSpec r = do
+    commonSpec r
+    it "has origin at 80,-60" $
+        (x_origin r, y_origin r) `shouldBe` (80, -60)
+    it "has terminus at 50,-90" $
+        (x_terminus r, y_terminus r) `shouldBe` (50, -90)
+    it "has size -30,-30" $
+        (x_size r, y_size r) `shouldBe` (-30, -30)
+
+commonSpec :: Rect Int32 -> SpecWith ()
+commonSpec r = do
+    it "has minimum coordinates at at 50,-90" $
+        (x_min r, y_min r) `shouldBe` (50, -90)
+    it "has maximum coordinates at 80,-60" $
+        (x_max r, y_max r) `shouldBe` (80, -60)
+    it "has absolute size 30,30" $
+        (width r, height r) `shouldBe` (30, 30)