{-# LANGUAGE Haskell2010
    , MultiParamTypeClasses
    , FunctionalDependencies
    , TypeOperators
    , FlexibleInstances
    , UndecidableInstances
    , OverlappingInstances
 #-}

module Data.NamedRecord where


data a := b = a := b deriving Show

infixl 3 :=


class Property o n v | o n -> v where
    
    get :: o -> n -> v
    set :: o -> n := v -> o

infixl 1 `set`
infixl 1 `get`


add :: b -> a -> a :+ b
add = flip (:+)

infixl 1 `add`


instance Property (n := v) n v where

    get (_ := v) _ = v
    set _ v = v


instance Property ((n := v) :+ b) n v where

    get (a :+ b) n = get a n
    set (a :+ b) p = (set a p) :+ b


instance Property b n v => Property (a :+ b) n v where

    get (a :+ b) n = get b n
    set (a :+ b) p = a :+ (set b p)


data a :+ b = a :+ b deriving Show

infixr 2 :+