{-|
Module      : Language.Grammars.AspectAG.Label
Description : Labels (polykinded, phantom)
Copyright   : (c) Juan García Garland, Marcos Viera 2020
License     : GPL-3
Maintainer  : jpgarcia@fing.edu.uy
Stability   : experimental
Portability : POSIX
-}

{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE DataKinds #-}

module Data.GenRec.Label where
import Data.Proxy

data Label l = Label

sndLabel :: Label '(a,b) -> Label b
sndLabel :: Label '(a, b) -> Label b
sndLabel Label '(a, b)
_ = Label b
forall a. HasCallStack => a
undefined

fstLabel :: Label '(a,b) -> Label a
fstLabel :: Label '(a, b) -> Label a
fstLabel Label '(a, b)
_ = Label a
forall a. HasCallStack => a
undefined

labelFromType :: a -> Label a
labelFromType :: a -> Label a
labelFromType a
_ = Label a
forall k (l :: k). Label l
Label

proxyToLabel :: Proxy a -> Label a
proxyToLabel :: Proxy a -> Label a
proxyToLabel Proxy a
_ = Label a
forall k (l :: k). Label l
Label