hetero.purs

newtype Circle = Circle { circleRadius :: Number, circleCenter :: Tuple Number Number }

derive instance genericCircle :: Generic Circle _

instance showCircle :: Show Circle where
  show c = genericShow c

instance eqCircle :: Eq Circle where
  eq x y = genericEq x y

newtype Square = Square { squareTopLeft :: Tuple Number Number, squareWidth :: Number }

derive instance genericSquare :: Generic Square _

instance showSquare :: Show Square where
  show c = genericShow c

instance eqSquare :: Eq Square where
  eq x y = genericEq x y

class Resizable a where
  resize :: Number -> a -> a

instance resizableCircle :: Resizable Circle where
  resize f (Circle r) = Circle $ r { circleRadius = f * r.circleRadius }

instance resizableSquare :: Resizable Square where
  resize f (Square r) = Square $ r { squareWidth = f * r.squareWidth }

data ResizeCase n = ResizeCase n

instance resizeCase :: Resizable r => H.Mapping (ResizeCase Number) r r where
  mapping (ResizeCase n) r = resize n r

type Shape = (circle :: Circle, square :: Square | ())

_circle = (SProxy :: SProxy "circle")
_square = (SProxy :: SProxy "square")

circle :: Number -> Tuple Number Number -> Variant.Variant Shape
circle r c = Variant.inj _circle  (Circle { circleRadius: r, circleCenter: c })

square :: Tuple Number Number -> Number -> Variant.Variant Shape
square tl w = Variant.inj _square (Square { squareTopLeft: tl, squareWidth: w })

shapes :: Array ( Variant.Variant Shape )
shapes = [ square (Tuple 1.0 2.0) 5.0, circle 4.0 (Tuple 2.0 3.0), circle 1.0 (Tuple 5.0 7.0) ]

resizeAll :: Number -> Array (Variant.Variant Shape) -> Array (Variant.Variant Shape)
resizeAll n = map f
  where
    f = Variant.match
      {
        circle: Variant.inj _circle <<< resize n,
        square: Variant.inj _square <<< resize n
      }

resizeAll' :: Number -> Array (Variant.Variant Shape) -> Array (Variant.Variant Shape)
resizeAll' n = map $ H.hmap (ResizeCase n)