{-# LANGUAGE RankNTypes #-}

module Graphics.HaGL.Util.DepMap (
    GenHashable(..),
    DepMap,
    Graphics.HaGL.Util.DepMap.empty,
    Graphics.HaGL.Util.DepMap.insert,
    Graphics.HaGL.Util.DepMap.lookup,
    Graphics.HaGL.Util.DepMap.mapWithKey,
    Graphics.HaGL.Util.DepMap.traverseWithKey) 
where

import Data.Word (Word64)
import Data.Hashable (Hashable(..))
import Unsafe.Coerce (unsafeCoerce)

import qualified Data.HashMap.Strict as HashMap


type Hash = Word64

class GenHashable k where
    genHash :: k t -> Hash


data DepMap :: (* -> *) -> (* -> *) -> * where
    DepMap :: GenHashable k => HashMap.HashMap (DMK k) (DMV v) -> DepMap k v

data DMK k where
    DMK :: GenHashable k => k t -> DMK k

instance Eq (DMK k) where
    (DMK k t
key1) == :: DMK k -> DMK k -> Bool
== (DMK k t
key2) = forall (k :: * -> *) t. GenHashable k => k t -> Hash
genHash k t
key1 forall a. Eq a => a -> a -> Bool
== forall (k :: * -> *) t. GenHashable k => k t -> Hash
genHash k t
key2 

instance Hashable (DMK k) where
    hashWithSalt :: Int -> DMK k -> Int
hashWithSalt Int
salt (DMK k t
key) = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt forall a b. (a -> b) -> a -> b
$ forall (k :: * -> *) t. GenHashable k => k t -> Hash
genHash k t
key

data DMV v where
    DMV :: v t -> DMV v


empty :: GenHashable k => DepMap k v
empty :: forall (k :: * -> *) (v :: * -> *). GenHashable k => DepMap k v
empty = forall (k :: * -> *) (v :: * -> *).
GenHashable k =>
HashMap (DMK k) (DMV v) -> DepMap k v
DepMap (forall k v. HashMap k v
HashMap.empty :: HashMap.HashMap (DMK k) (DMV v))

insert :: GenHashable k => k t -> v t -> DepMap k v -> DepMap k v
insert :: forall (k :: * -> *) t (v :: * -> *).
GenHashable k =>
k t -> v t -> DepMap k v -> DepMap k v
insert k t
key v t
val (DepMap HashMap (DMK k) (DMV v)
hm) = forall (k :: * -> *) (v :: * -> *).
GenHashable k =>
HashMap (DMK k) (DMV v) -> DepMap k v
DepMap forall a b. (a -> b) -> a -> b
$ forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert (forall (k :: * -> *) t. GenHashable k => k t -> DMK k
DMK k t
key) (forall (v :: * -> *) t. v t -> DMV v
DMV v t
val) HashMap (DMK k) (DMV v)
hm

lookup :: GenHashable k => k t -> DepMap k v -> Maybe (v t)
lookup :: forall (k :: * -> *) t (v :: * -> *).
GenHashable k =>
k t -> DepMap k v -> Maybe (v t)
lookup k t
key (DepMap HashMap (DMK k) (DMV v)
hm) = forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (forall (k :: * -> *) t. GenHashable k => k t -> DMK k
DMK k t
key) HashMap (DMK k) (DMV v)
hm forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 
    \(DMV v t
val) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> b
unsafeCoerce v t
val

mapWithKey :: (forall t. k t -> v1 t -> v2 t) -> DepMap k v1 -> DepMap k v2
mapWithKey :: forall (k :: * -> *) (v1 :: * -> *) (v2 :: * -> *).
(forall t. k t -> v1 t -> v2 t) -> DepMap k v1 -> DepMap k v2
mapWithKey forall t. k t -> v1 t -> v2 t
f (DepMap HashMap (DMK k) (DMV v1)
hm) = forall (k :: * -> *) (v :: * -> *).
GenHashable k =>
HashMap (DMK k) (DMV v) -> DepMap k v
DepMap HashMap (DMK k) (DMV v2)
hm' where
    hm' :: HashMap (DMK k) (DMV v2)
hm' = forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
HashMap.mapWithKey (\(DMK k t
k) (DMV v1 t
v) -> forall (v :: * -> *) t. v t -> DMV v
DMV (forall t. k t -> v1 t -> v2 t
f k t
k forall a b. (a -> b) -> a -> b
$ forall a b. a -> b
unsafeCoerce v1 t
v)) HashMap (DMK k) (DMV v1)
hm 

traverseWithKey :: Applicative a => (forall t. k t -> v1 t -> a (v2 t)) -> DepMap k v1 -> a (DepMap k v2)
traverseWithKey :: forall (a :: * -> *) (k :: * -> *) (v1 :: * -> *) (v2 :: * -> *).
Applicative a =>
(forall t. k t -> v1 t -> a (v2 t))
-> DepMap k v1 -> a (DepMap k v2)
traverseWithKey forall t. k t -> v1 t -> a (v2 t)
f (DepMap HashMap (DMK k) (DMV v1)
hm) = forall (k :: * -> *) (v :: * -> *).
GenHashable k =>
HashMap (DMK k) (DMV v) -> DepMap k v
DepMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a (HashMap (DMK k) (DMV v2))
hm' where
    hm' :: a (HashMap (DMK k) (DMV v2))
hm' = forall (f :: * -> *) k v1 v2.
Applicative f =>
(k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)
HashMap.traverseWithKey (\(DMK k t
k) (DMV v1 t
v) -> forall (v :: * -> *) t. v t -> DMV v
DMV forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. k t -> v1 t -> a (v2 t)
f k t
k (forall a b. a -> b
unsafeCoerce v1 t
v)) HashMap (DMK k) (DMV v1)
hm 

{-data Expr t where
    IntExpr :: Int -> Expr Int
    BoolExpr :: Bool -> Expr Bool

instance GenHashable Expr where
    genHash (IntExpr x) = x
    genHash (BoolExpr False) = 0
    genHash (BoolExpr True) = 1

myMap :: DepMap Expr Identity
myMap = insert (IntExpr 0) 0 $ insert (BoolExpr True) (Identity True) $ empty-}