never executed always true always false

    1 module HelVM.HelMA.Automata.Piet.Types.Label (
    2   labelSize,
    3   addPixel,
    4   LabelKey,
    5   LabelInfo(..),
    6   LabelBorder(..),
    7 ) where
    8 
    9 import           HelVM.HelMA.Automata.Piet.Types.Coordinates
   10 
   11 addPixel :: Coordinates -> Maybe LabelInfo -> Maybe LabelInfo
   12 addPixel (x, y) Nothing = Just $ LabelInfo 1 (LabelBorder y x x) (LabelBorder x y y) (LabelBorder y x x) (LabelBorder x y y)
   13 addPixel (x, y) (Just stats) = Just $ stats
   14   { _labelSize   = 1 + _labelSize stats
   15   , labelTop    = mergeMin (labelTop stats) (LabelBorder y x x)
   16   , labelLeft   = mergeMin (labelLeft stats) (LabelBorder x y y)
   17   , labelBottom = mergeMax (labelBottom stats) (LabelBorder y x x)
   18   , labelRight  = mergeMax (labelRight stats) (LabelBorder x y y)
   19   }
   20 
   21 labelSize :: Maybe LabelInfo -> Int
   22 labelSize Nothing     = 0
   23 labelSize (Just info) = _labelSize info
   24 
   25 instance Semigroup LabelInfo where
   26   s1 <> s2 = LabelInfo
   27     (_labelSize s1 + _labelSize s2)
   28     (mergeMin (labelTop s1) (labelTop s2))
   29     (mergeMin (labelLeft s1) (labelLeft s2))
   30     (mergeMax (labelBottom s1) (labelBottom s2))
   31     (mergeMax (labelRight s1) (labelRight s2))
   32 
   33 -- Internal
   34 
   35 mergeMin :: LabelBorder -> LabelBorder -> LabelBorder
   36 mergeMin = merge $ comparing borderCoord
   37 
   38 mergeMax :: LabelBorder -> LabelBorder -> LabelBorder
   39 mergeMax = merge $ comparing (negate . borderCoord)
   40 
   41 merge :: (LabelBorder -> LabelBorder -> Ordering) -> LabelBorder -> LabelBorder -> LabelBorder
   42 merge comp b1 b2 = go $ comp b1 b2 where
   43   go EQ = b1 { borderMin = min (borderMin b1) (borderMin b2), borderMax = max (borderMax b1) (borderMax b2) }
   44   go LT = b1
   45   go GT = b2
   46 
   47 -- | Types
   48 
   49 type LabelKey = Int
   50 
   51 data LabelInfo = LabelInfo
   52   { _labelSize  :: !Int
   53   , labelTop    :: !LabelBorder
   54   , labelLeft   :: !LabelBorder
   55   , labelBottom :: !LabelBorder
   56   , labelRight  :: !LabelBorder
   57   } deriving stock (Show, Eq, Ord)
   58 
   59 data LabelBorder = LabelBorder
   60   { borderCoord :: !Int
   61   , borderMin   :: !Int
   62   , borderMax   :: !Int
   63   } deriving stock (Show, Eq, Ord)