{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE CPP #-}
module Haxl.Core.StateStore (
StateKey(..), StateStore, stateGet, stateSet, stateEmpty
) where
import Data.Map (Map)
import qualified Data.Map.Strict as Map
import Data.Typeable
import Unsafe.Coerce
#if __GLASGOW_HASKELL__ >= 708
class Typeable f => StateKey (f :: * -> *) where
data State f
#else
class Typeable1 f => StateKey (f :: * -> *) where
data State f
#endif
newtype StateStore = StateStore (Map TypeRep StateStoreData)
data StateStoreData = forall f. StateKey f => StateStoreData (State f)
stateEmpty :: StateStore
stateEmpty = StateStore Map.empty
stateSet :: forall f . StateKey f => State f -> StateStore -> StateStore
stateSet st (StateStore m) =
StateStore (Map.insert (getType st) (StateStoreData st) m)
stateGet :: forall r . StateKey r => StateStore -> Maybe (State r)
stateGet (StateStore m) =
case Map.lookup ty m of
Nothing -> Nothing
Just (StateStoreData st)
| getType st == ty -> Just (unsafeCoerce st)
| otherwise -> Nothing
where
ty = getType (undefined :: State r)
getType :: forall f . StateKey f => State f -> TypeRep
getType _ = typeOf1 (undefined :: f a)