polySum.hs

{-# LANGUAGE DataKinds, KindSignatures, MultiParamTypeClasses,
             FunctionalDependencies, FlexibleInstances, FlexibleContexts,
             OverloadedLabels, ScopedTypeVariables #-}

import GHC.OverloadedLabels (IsLabel(..))
import GHC.TypeLits (Symbol)

data Label (l :: Symbol) = Put

class Belongs a l b | l b -> a where
  to :: a -> Label l -> b

data X
  = Ax Int
  | Bx Int
  deriving Show

instance Belongs Int "a" X where to ia _ = Ax ia
instance Belongs Int "b" X where to ib _ = Bx ib

data Y
  = Ay Int
  | By Int
  | Cy Int
  deriving Show

instance Belongs Int "a" Y where to ia _ = Ay ia
instance Belongs Int "b" Y where to ib _ = By ib
instance Belongs Int "c" Y where to ic _ = Cy ic

instance Belongs a l b => IsLabel l (a -> b) where
  fromLabel x = to x (Put :: Label l)

fromB :: Belongs Int "b" r => Int -> r
fromB i = #b i

xB :: X
xB = #b 1

yB :: Y
yB = #b 2