From a08fe0554fcdf787beb65c1c767b9ecbd7e6e1de Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Tue, 6 Jun 2023 10:47:45 +1200
Subject: [PATCH] Improve debuggability, correct rect shrinking.

---
 app/Main.hs                                   | 3 ++-
 lib/Graphics/Rendering/Rect.hs                | 2 +-
 lib/Graphics/Rendering/Rect/CSS.hs            | 5 ++++-
 lib/Graphics/Rendering/Rect/CSS/Background.hs | 2 +-
 lib/Graphics/Rendering/Rect/CSS/Colour.hs     | 2 +-
 5 files changed, 9 insertions(+), 5 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 7239a10..fd9b739 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -26,7 +26,8 @@ parseStyle syn
     toks = tokenize $ pack syn
     apply ((key, val):props)
         | Just self' <- longhand self self key val = self'
-        | otherwise = apply (shorthand self key val ++ props)
+        | props'@(_:_) <- shorthand self key val = apply (props' ++ props)
+        | otherwise = trace ("Unsupported property " ++ unpack key) self
       where self = apply props
     apply [] = temp
 
diff --git a/lib/Graphics/Rendering/Rect.hs b/lib/Graphics/Rendering/Rect.hs
index 93058e6..e8be21f 100644
--- a/lib/Graphics/Rendering/Rect.hs
+++ b/lib/Graphics/Rendering/Rect.hs
@@ -10,7 +10,7 @@ import Control.Monad.IO.Class (MonadIO)
 
 shrink :: Rect -> Float -> Float -> Float -> Float -> Rect
 shrink self dLeft dTop dRight dBottom =
-    Rect (left self - dLeft) (top self - dTop)
+    Rect (left self + dLeft) (top self + dTop)
          (right self - dRight) (bottom self - dBottom)
 shrink1 :: Rect -> Float -> Rect
 shrink1 self d = shrink self d d d d
diff --git a/lib/Graphics/Rendering/Rect/CSS.hs b/lib/Graphics/Rendering/Rect/CSS.hs
index 8fd8252..4256f7c 100644
--- a/lib/Graphics/Rendering/Rect/CSS.hs
+++ b/lib/Graphics/Rendering/Rect/CSS.hs
@@ -5,7 +5,10 @@ import Stylist (PropertyParser(..))
 import Graphics.Rendering.Rect.CSS.Colour (ColourPallet(foreground))
 import Graphics.Rendering.Rect.CSS.Background (Backgrounds(..))
 
-data RectStyle = RectStyle { colours :: ColourPallet, backgrounds :: Backgrounds }
+data RectStyle = RectStyle {
+    colours :: ColourPallet,
+    backgrounds :: Backgrounds
+} deriving (Read, Show, Eq)
 colour = foreground . colours
 
 instance PropertyParser RectStyle where
diff --git a/lib/Graphics/Rendering/Rect/CSS/Background.hs b/lib/Graphics/Rendering/Rect/CSS/Background.hs
index 2016c6f..d41fd77 100644
--- a/lib/Graphics/Rendering/Rect/CSS/Background.hs
+++ b/lib/Graphics/Rendering/Rect/CSS/Background.hs
@@ -8,7 +8,7 @@ import Data.Colour (AlphaColour, transparent)
 data Backgrounds = Backgrounds {
     pallet :: ColourPallet,
     background :: AlphaColour Float
-}
+} deriving (Read, Show, Eq)
 
 instance PropertyParser Backgrounds where
     temp = Backgrounds { pallet = temp, background = transparent }
diff --git a/lib/Graphics/Rendering/Rect/CSS/Colour.hs b/lib/Graphics/Rendering/Rect/CSS/Colour.hs
index 82bfeda..a54334c 100644
--- a/lib/Graphics/Rendering/Rect/CSS/Colour.hs
+++ b/lib/Graphics/Rendering/Rect/CSS/Colour.hs
@@ -25,7 +25,7 @@ hsl' h s l = uncurryRGB rgb $ hsl h s l
 data ColourPallet = ColourPallet {
     foreground :: AlphaColour Float,
     accent :: AlphaColour Float
-}
+} deriving (Read, Show, Eq)
 
 instance PropertyParser ColourPallet where
     temp = ColourPallet { foreground = opaque black, accent = opaque blue }
-- 
2.30.2