Singletons

Sing.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}

module Sing where

data Broker = B1 | B2 | B3 deriving (Show)

data PolicyB1 = PB1 deriving (Show)
data PolicyB2 = PB2 deriving (Show)
data PolicyB3 = PB3 deriving (Show)

data PolicyB1FSM = PB1FSM deriving (Show)
data PolicyB2FSM = PB2FSM deriving (Show)
data PolicyB3FSM = PB3FSM deriving (Show)

-- singleton to link types with values to provide static info to the type system
data BrokerSing (id :: Broker) where
  SB1 :: BrokerSing 'B1
  SB2 :: BrokerSing 'B2
  SB3 :: BrokerSing 'B3

-- type family to dispatch on the value
type family F (id :: Broker) where
  F 'B1 = (PolicyB1, PolicyB1FSM)
  F 'B2 = (PolicyB2, PolicyB2FSM)
  F 'B3 = (PolicyB3, PolicyB3FSM)

f :: BrokerSing id -> F id
f SB1 = (PB1, PB1FSM)
f SB2 = (PB2, PB2FSM)
f SB3 = (PB3, PB3FSM)