Skip to content

Instantly share code, notes, and snippets.

@scudelletti
Last active December 17, 2020 09:26
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save scudelletti/210bad2436c7ca9b9b051886b6004267 to your computer and use it in GitHub Desktop.
Save scudelletti/210bad2436c7ca9b9b051886b6004267 to your computer and use it in GitHub Desktop.
-- In a hypothetical scenario where:
-- * I have packs of beverages
-- * Each pack belongs to a Brand (Coke or Pepsi) and contains a Product
-- * Each product belongs to a Brand (Coke or Pepsi)
-- * A Coke pack filled with Coke cans is correct
-- * A Coke pack filled with Pepsi cans is incorrect
--
-- Is there a way that I can make the type system check that for me during compilation time?
-- I know I could have smart constructors that would build the correct pack with the correct content but I'd like to know if there are other and smarter -- ways of achieving it.
module Beverages where
data Brand = Coke | Pepsi deriving (Show)
data Product brand = Bottle brand | Can brand deriving (Show)
data Pack brand product = Pack brand product deriving (Show)
-- valid
coke_bottle_pack = Pack Coke (Bottle Coke)
coke_can_pack = Pack Coke (Can Coke)
pepsi_bottle_pack = Pack Pepsi (Bottle Pepsi)
pepsi_can_pack = Pack Pepsi (Can Pepsi)
-- must be invalid - compilation should fail but it does not
coke_pack_with_pepsi_bottles = Pack Coke (Bottle Pepsi)
coke_pack_with_pepsi_cans = Pack Coke (Can Pepsi)
pepsi_pack_with_coke_bottles = Pack Pepsi (Bottle Coke)
pepsi_pack_with_coke_cans = Pack Pepsi (Can Coke)
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
-- The person who wrote it does not recommended to to this
data Brand = Coke | Pepsi
data SBrand brand where
SCoke :: SBrand 'Coke
SPepsi :: SBrand 'Pepsi
data Product = Bottle | Can
data SProduct brand product where
SBottle :: SBrand brand -> SProduct brand 'Bottle
SCan :: SBrand brand -> SProduct brand 'Can
data Pack brand product = Pack (SBrand brand) (SProduct brand product)
-- valid
coke_bottle_pack = Pack SCoke (SBottle SCoke)
coke_can_pack = Pack SCoke (SCan SCoke)
pepsi_bottle_pack = Pack SPepsi (SBottle SPepsi)
pepsi_can_pack = Pack SPepsi (SCan SPepsi)
-- invalid: compilation fails
coke_pack_with_pepsi_bottles = Pack SCoke (SBottle SPepsi)
coke_pack_with_pepsi_cans = Pack SCoke (SCan SPepsi)
pepsi_pack_with_coke_bottles = Pack SPepsi (SBottle SCoke)
pepsi_pack_with_coke_cans = Pack SPepsi (SCan SCoke)
{-# LANGUAGE GADTs #-}
module Beverages where
data Coke
data Pepsi
data Brand a where
Coke :: Brand Coke
Pepsi :: Brand Pepsi
data Product brand = Can brand | Bottle brand deriving Show
data Pack brand product where
Pack :: a -> Product a -> Pack a (Product a)
-- valid
coke_bottle_pack = Pack Coke (Bottle Coke)
coke_can_pack = Pack Coke (Can Coke)
pepsi_bottle_pack = Pack Pepsi (Bottle Pepsi)
pepsi_can_pack = Pack Pepsi (Can Pepsi)
-- invalid: compilation fails
coke_pack_with_pepsi_bottles = Pack Coke (Bottle Pepsi)
coke_pack_with_pepsi_cans = Pack Coke (Can Pepsi)
pepsi_pack_with_coke_bottles = Pack Pepsi (Bottle Coke)
pepsi_pack_with_coke_cans = Pack Pepsi (Can Coke)
module Beverages where
data Coke = Coke deriving (Show)
data Pepsi = Pepsi deriving (Show)
data Product brand = Bottle brand | Can brand deriving (Show)
data Pack brand = Pack brand (Product brand) deriving (Show)
-- valid
coke_bottle_pack = Pack Coke (Bottle Coke)
coke_can_pack = Pack Coke (Can Coke)
pepsi_bottle_pack = Pack Pepsi (Bottle Pepsi)
pepsi_can_pack = Pack Pepsi (Can Pepsi)
-- invalid: compilation fails
coke_pack_with_pepsi_bottles = Pack Coke (Bottle Pepsi)
coke_pack_with_pepsi_cans = Pack Coke (Can Pepsi)
pepsi_pack_with_coke_bottles = Pack Pepsi (Bottle Coke)
pepsi_pack_with_coke_cans = Pack Pepsi (Can Coke)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment