{-# LANGUAGE GADTs #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE MultiParamTypeClasses #-} import Data.Proxy import GHC.TypeLits data Field (l :: Symbol) a where Field :: a -> Field l a class HasField a f where getField :: a -> f setField :: a -> f -> a instance HasField (Field l a, b) (Field l a) where getField (x, _) = x setField (x, y) z = (z, y) instance {-# OVERLAPPABLE #-} HasField a v => HasField (b, a) v where getField (_, x) = getField x setField (x, y) z = (x, setField y z) instance (Show a, KnownSymbol l) => Show (Field l a) where show (Field x) = "[Field \"" ++ (symbolVal (Proxy :: Proxy l)) ++ "\" " ++ (show x) ++ "]" getValue :: forall l a. Field l a -> a getValue (Field x) = x -- getEntry :: forall a v (l :: Symbol). (HasField a (Field l v)) => a -> v -- getEntry x = let (Field y) = getField x in y -- -- setEntry :: HasField a (Field l v) => a -> v -> a -- setEntry x y = setField x (Field y) type Foo = Field "Foo" String type Bar = Field "Bar" String type Baz = Field "Baz" String type Inner a = Field "Inner" a type Config a = (HasField a Foo, HasField a Bar, HasField a Baz) getFoo :: HasField a Foo => a -> String getFoo = (getValue :: Field "Foo" String -> String) . getField setFoo :: HasField a Foo => a -> String -> a setFoo x v = setField x (Field v :: Foo) addBaz :: a -> String -> (Baz, a) addBaz x y = (Field y :: Baz, x) getInner :: HasField a (Inner b) => a -> b getInner = (getValue :: Inner b -> b) . getField config :: (Foo, (Bar, (Foo, ()))) config = (Field "baz", (Field "bar", (Field "foo", ()))) foo :: String foo = getFoo config config2 :: (Foo, (Bar, (Foo, ()))) config2 = setFoo config "fool" config3 :: (Baz, (Foo, (Bar, (Foo, ())))) config3 = addBaz config "buzz" config4 :: (Inner (Bar, (Foo, ())), ()) config4 = (Field (Field "bar", (Field "foo", ())), ()) -- getInnerFoo :: forall a b. (HasField a (Inner b), HasField b Foo) => a -> String -- getInnerFoo = getFoo . getInner inner :: (Bar, (Foo, ())) inner = getInner config4 foo2 :: String foo2 = getFoo $ (getInner config4 :: (Bar, (Foo, ())))