{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}

-- examples of using labels and type tags from Data.Label

import Data.Label

-- the usual extensible-records-as-nested-pairs
data label := value  = label := value  deriving Show
data field :& record = field :& record deriving Show
infixr :&

-- no quasiquoting for types:-(, so generate type synonyms instead
$(genTypeTag "TTrue")
$(genTypeTag "TFalse")

-- a type-level predicate
class HasField record label tbool | label record -> tbool
instance HasField ()                       label TFalse
instance HasField ((label:=value):&record) label TTrue
instance HasField record                   label tbool 
      => HasField (field:&record)          label tbool

-- record field selection, driven by field label types
class Select record label value 
  where (!) :: record -> label -> value

instance v~value => Select ((label:=value):&record) label v 
  where ((_:=v):&_) ! _ = v

instance Select record label value
      => Select (field:&record) label value 
  where (_:&r) ! l = r ! l

-- example records 

-- no need to declare field labels, and they will be
-- shared with other importers of Data.Label!
-- but we collect them here, to make bridging GHC-6.12 to GHC-7 easier
-- http://haskell.org/haskellwiki/Upgrading_packages/Updating_to_GHC_7
#if __GLASGOW_HASKELL__>=700
this = [l|this|]
that = [l|that|]
x    = [l|x|]
y    = [l|y|]
#else
this = [$l|this|]
that = [$l|that|]
x    = [$l|x|]
y    = [$l|y|]
#endif

a = (this := True)
  :&(that := "hi")
  :&()

b = (that := "there")
  :&(x := 100)
  :&(y := 200)
  :&()

-- we don't even need label values for this, 
-- type tags are sufficient, as long as we don't
-- evaluate the (undefined) values of tags
c = (this := 'x')
  :&(y := ())
  :&()

-- testing Show and record selection
records = do
  print a
  print b
  print c
  print $ (a ! this)
  print $ (c ! this)
  print $ (a ! that) ++ ", " ++ (b ! that)