never executed always true always false

    1 module HelVM.HelMA.Automata.Piet.Types.Label
    2   ( LabelBorder (..)
    3   , LabelInfo (..)
    4   , LabelKey
    5   , addPixel
    6   , borderCoord
    7   , borderMax
    8   , borderMin
    9   , getLabelSize
   10   , labelBottom
   11   , labelLeft
   12   , labelRight
   13   , labelSize
   14   , labelTop
   15   ) where
   16 
   17 import           HelVM.HelMA.Automata.Piet.Types.Coordinates
   18 
   19 import           Lens.Micro                                  ( (%~), (^.) )
   20 import           Lens.Micro.TH                               ( makeLenses )
   21 
   22 -- Types
   23 
   24 type LabelKey = Int
   25 
   26 data LabelBorder
   27   = LabelBorder
   28       { _borderCoord :: !Int
   29       , _borderMin   :: !Int
   30       , _borderMax   :: !Int
   31       }
   32   deriving stock (Eq, Ord, Show)
   33 
   34 makeLenses ''LabelBorder
   35 
   36 data LabelInfo
   37   = LabelInfo
   38       { _labelSize   :: !Int
   39       , _labelTop    :: !LabelBorder
   40       , _labelLeft   :: !LabelBorder
   41       , _labelBottom :: !LabelBorder
   42       , _labelRight  :: !LabelBorder
   43       }
   44   deriving stock (Eq, Ord, Show)
   45 
   46 makeLenses ''LabelInfo
   47 
   48 -- Exported Functions
   49 
   50 addPixel ∷ Coordinates → Maybe LabelInfo → Maybe LabelInfo
   51 addPixel (x, y) Nothing = Just $ LabelInfo 1 (LabelBorder y x x) (LabelBorder x y y) (LabelBorder y x x) (LabelBorder x y y)
   52 addPixel (x, y) (Just stats) = Just $ stats
   53   & labelSize %~ (+ 1)
   54   & labelTop %~ (`mergeMin` LabelBorder y x x)
   55   & labelLeft %~ (`mergeMin` LabelBorder x y y)
   56   & labelBottom %~ (`mergeMax` LabelBorder y x x)
   57   & labelRight %~ (`mergeMax` LabelBorder x y y)
   58 
   59 getLabelSize ∷ Maybe LabelInfo → Int
   60 getLabelSize Nothing     = 0
   61 getLabelSize (Just info) = info ^. labelSize
   62 
   63 instance Semigroup LabelInfo where
   64   s1 <> s2 = LabelInfo
   65     (s1 ^. labelSize + s2 ^. labelSize)
   66     (mergeMin (s1 ^. labelTop) (s2 ^. labelTop))
   67     (mergeMin (s1 ^. labelLeft) (s2 ^. labelLeft))
   68     (mergeMax (s1 ^. labelBottom) (s2 ^. labelBottom))
   69     (mergeMax (s1 ^. labelRight) (s2 ^. labelRight))
   70 
   71 -- Internal
   72 
   73 mergeMin ∷ LabelBorder → LabelBorder → LabelBorder
   74 mergeMin = merge $ comparing (^. borderCoord)
   75 
   76 mergeMax ∷ LabelBorder → LabelBorder → LabelBorder
   77 mergeMax = merge $ comparing (negate . (^. borderCoord))
   78 
   79 merge ∷ (LabelBorder → LabelBorder → Ordering) → LabelBorder → LabelBorder → LabelBorder
   80 merge comp b1 b2 = go $ comp b1 b2 where
   81   go EQ = b1
   82     & borderMin %~ min (b2 ^. borderMin)
   83     & borderMax %~ max (b2 ^. borderMax)
   84   go LT = b1
   85   go GT = b2