module Data.TypeLevelKVList
(
NamedVal
, namedVal
, (:.)(..)
, Null(..)
, get
, Lookup
, keys
, keys'
)
where
import Data.Proxy (Proxy(..))
import Data.Typeable (Typeable)
import GHC.TypeLits (KnownSymbol, symbolVal)
type NamedVal v key = (Proxy key, v)
namedVal :: v -> NamedVal v k
namedVal a = (Proxy, a)
data a :. b = a :. b
deriving (Typeable, Eq, Show)
infixr 8 :.
data Null = Null
deriving (Typeable, Eq, Show)
type family Lookup pkey list where
Lookup pk ((pk, v) :. b) = v
Lookup pk ((px, v) :. b) = Lookup pk b
Lookup pk Null = Null
class NamedList layout where
type family NamedList' layout
keys :: Proxy layout -> [String]
instance (NamedList b, KnownSymbol k) => NamedList (NamedVal v k :. b) where
type NamedList' (NamedVal v k :. b) = NamedVal v k :. NamedList' b
keys _ = symbolVal (Proxy :: Proxy k) : keys (Proxy :: Proxy b)
instance NamedList Null where
type NamedList' Null = Null
keys _ = []
class HasKey list pkey value where
get' :: pkey -> list -> value
instance HasKey (NamedVal v k :. b) (Proxy k) v where
get' _ ((_, a) :. _) = a
instance HasKey b (Proxy k) v =>
HasKey (a :. b) (Proxy k) v where
get' p (_ :. b) = get' p b
instance HasKey Null (Proxy k) Null where
get' _ Null = Null
get :: (HasKey list pkey (Lookup pkey list))
=> pkey -> list -> Lookup pkey list
get (pkey :: pkey) (list :: list) =
get' pkey list :: Lookup pkey list
keys' :: NamedList k => k -> [String]
keys' (_ :: k) = keys (Proxy :: Proxy k)