Type classes vs interfaces

40

I wonder, would you consider this a ‘mimic’ of interfaces, or does it get closer to the real thing for you? Or is this ‘additional magic’ (the chooseMildlyRegressiveEthnicStereotype function does basically encode an existential type)?

class Monad m => SandwichRecipe impl m where
  startNewSandwich :: impl -> BreadType -> Component -> m SandwichBody
  addComponent :: impl -> Component -> SandwichBody -> m SandwichBody
  finishSandwich :: impl -> Maybe BreadType -> SandwichBody -> m Sandwich

class Monad m => PizzaRecipe impl m where
  makeCirclePizza :: impl -> Crust -> [PizzaComponent] -> m Pizza
  makeSquarePizza :: impl -> Crust -> [PizzaComponent] -> m Pizza

class Monad m => CookingMachine impl m where
  makePizza :: impl -> Pizza -> m Meal
  makeSandwich :: impl -> Sandwich -> m Meal
  makeRandomPizzaRecipe :: impl -> m Pizza

mySandwich :: SandwichRecipe impl m => impl -> m Sandwich
mySandwich impl = do
  body1 <- startNewSandwich impl Toast Tomato
  body2 <- addComponent impl Cheese body1
  body3 <- addComponent impl Salt body2
  finishSandwich impl Nothing body3

sampleCookingMachine :: CookingMachine cook m => PizzaRecipe pizza m => cook -> pizza -> m [Meal]
sampleCookingMachine cook pizza = do
  -- note the separation of `cook` and `pizza` allows different implementations to be provided, as long as they run in the same monad
  pizza <- makePizza cook =<< myPizza pizza

  rndPizzaRecipe <- makeRandomPizzaRecipe cook
  rndPizza <- makePizza cook rndPizzaRecipe
  pure [pizza, rndPizza]

data ItalianChef = ItalianChef
data SwedishChef = SwedishChef

instance PizzaRecipe ItalianChef IO where
  -- TODO: That's a nice-a pizza!
instance PizzaRecipe SwedishChef IO where
  -- TODO: Bork bork bork!
instance SandwichRecipe ItalianChef IO where
  -- TODO
instance SandwichRecipe SwedishChef IO where
  -- TODO
instance CookingMachine ItalianChef IO where
  -- TODO
instance CookingMachine SwedishChef IO where
  -- TODO

chooseMildlyRegressiveEthnicStereotype ::
  ( forall impl.
    PizzaRecipe impl IO =>
    SandwichRecipe impl IO =>
    CookingMachine impl IO =>
      impl -> IO a
  ) ->
    IO a
chooseMildlyRegressiveEthnicStereotype f = do
  -- lookup implementation at runtime
  condition <- lookupConfig
  if condition then f ItalianChef else f SwedishChef

main :: IO ()
main =
  chooseMildlyRegressiveEthnicStereotype $ \chef -> do
    meals <- sampleCookingMachine chef chef
    print meals
1 Like