Skip to content

Instantly share code, notes, and snippets.

@khibino
Created August 26, 2022 07:30
Show Gist options
  • Save khibino/6c82783a1680a15771956a4968a8147b to your computer and use it in GitHub Desktop.
Save khibino/6c82783a1680a15771956a4968a8147b to your computer and use it in GitHub Desktop.
{-# 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment