module Control.Concurrent.Session.Map
( TyMap (..)
, emptyMap
, MapInsert (..)
, MapLookup (..)
, MapUpdate (..)
, MapSize (..)
, tyMapKeys
) where
import Control.Concurrent.Session.List
import Control.Concurrent.Session.Bool
data TyMap keyToIdx idxToValue = TM keyToIdx idxToValue
deriving (Show)
emptyMap :: TyMap Nil Nil
emptyMap = TM nil nil
class MapInsert m1 key val m2 | m1 key val -> m2 where
mapInsert :: key -> val -> m1 -> m2
instance ( TyListMember keyToIdx key res
, MapInsert' res (TyMap keyToIdx idxToValue) key val (TyMap keyToIdx' idxToValue')
) =>
MapInsert (TyMap keyToIdx idxToValue) key val (TyMap keyToIdx' idxToValue') where
mapInsert key val m1@(TM keyToIdx _)
= mapInsert' res key val m1
where
res = isTyListMember key keyToIdx
class MapInsert' bool m1 key val m2 | bool m1 key val -> m2 where
mapInsert' :: bool -> key -> val -> m1 -> m2
instance ( TyListUpdateVar idxToValue idx value idxToValue'
, TyListElem keyToIdx key idx
) =>
MapInsert' True (TyMap keyToIdx idxToValue) key value (TyMap keyToIdx idxToValue') where
mapInsert' _ key value (TM keyToIdx idxToValue)
= TM keyToIdx idxToValue'
where
idx = tyListElem keyToIdx key
idxToValue' = tyListUpdateVar idxToValue idx value
instance ( TyListLength keyToIdx newIdx
, TyListReverse keyToIdx keyToIdxRev
, TyListReverse (Cons key keyToIdxRev) keyToIdx'
, TyListUpdateVar idxToValue newIdx value idxToValue'
, TyList keyToIdxRev
) =>
MapInsert' False (TyMap keyToIdx idxToValue) key value (TyMap keyToIdx' idxToValue') where
mapInsert' _ key value (TM keyToIdx idxToValue)
= TM keyToIdx' idxToValue'
where
keyToIdx' = tyListReverse . cons key . tyListReverse $ keyToIdx
idxToValue' = tyListUpdateVar idxToValue (tyListLength keyToIdx) value
class MapLookup mp key val | mp key -> val where
mapLookup :: mp -> key -> val
instance ( TyListElem keyToIdx key idx
, TyListIndex idxToValue idx val
) =>
MapLookup (TyMap keyToIdx idxToValue) key val where
mapLookup (TM keyToIdx idxToValue) key
= tyListIndex idxToValue $ tyListElem keyToIdx key
class MapUpdate mp key val' mp' | mp key val' -> mp' where
mapUpdate :: mp -> key -> val' -> mp'
instance ( TyListUpdateVar idxToValue idx val' idxToValue'
, TyListElem keyToIdx key idx
, MapLookup (TyMap keyToIdx idxToValue') key val'
) =>
MapUpdate (TyMap keyToIdx idxToValue) key val' (TyMap keyToIdx idxToValue') where
mapUpdate (TM keyToIdx idxToValue) key val'
= TM keyToIdx . tyListUpdateVar idxToValue (tyListElem keyToIdx key) $ val'
class MapSize mp size | mp -> size where
mapSize :: mp -> size
instance (TyListLength keyToIdx len) =>
MapSize (TyMap keyToIdx idxToValue) len where
mapSize (TM keyToIdx _) = tyListLength keyToIdx
tyMapKeys :: TyMap keyToIdx idxToValue -> keyToIdx
tyMapKeys (TM keyToIdx _) = keyToIdx