TMap.hs

import ClassyPrelude

import Data.Proxy (Proxy (..))
import GHC.Exts (Any, Constraint)
import GHC.TypeLits
import Unsafe.Coerce (unsafeCoerce)


newtype TMap (map :: TMap_) = TMap (HashMap Text Any)  -- daaanger zone

emptyTMap :: TMap 'TM
emptyTMap = TMap mempty

insertTMap :: KnownSymbol key => Proxy key -> value -> TMap map -> TMap (TMapInsert key value map)
insertTMap keyProxy value (TMap anyMap) = TMap $
    insertMap (pack $ symbolVal keyProxy) (unsafeCoerce value) anyMap

lookupTMap
    :: (KnownSymbol key, TMapHasKey map key, value ~ TMapValue map key)
    => Proxy key -> TMap map -> value
lookupTMap keyProxy (TMap anyMap) = case lookup (pack $ symbolVal keyProxy) anyMap of
    Nothing -> error "impossible missing value from TMap"
    Just anyValue -> unsafeCoerce anyValue



type family TMapInsert (key :: Symbol) (value :: *) (map :: TMap_) :: TMap_ where
    TMapInsert key value 'TM                 = key ':= value ':| 'TM
    TMapInsert key value (key ':= u ':| map) = key ':= value ':| map
    TMapInsert key value (j ':= u ':| map)   = j ':= u ':| (TMapInsert key value map)

type family TMapValue (map :: TMap_) (key :: Symbol) :: k where
    TMapValue (key ':= value ':| map) key = value
    TMapValue (j ':= u ':| map) key       = TMapValue map key

type family TMapHasKey (map :: TMap_) (key :: Symbol) :: Constraint where
    TMapHasKey (key ':= v ':| map) key = ()
    TMapHasKey (j ':= u ':| map) key   = TMapHasKey map key



data TMap_ = TM | KV :| TMap_
infixr 4 :|
data KV = forall a. Symbol := a
infix 5 :=