module Control.Concurrent.Session.Map
( TyMap ()
, emptyMap
, MapInsert (..)
, MapLookup (..)
, MapUpdate (..)
, MapWith (..)
, MapSize (..)
) where
import Control.Concurrent.Session.List
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 ( TyListLength keyToIdx newIdx
, TyListReverse keyToIdx keyToIdxRev
, TyListReverse (Cons key keyToIdxRev) keyToIdx'
, TyListUpdateVar idxToValue newIdx value idxToValue'
, TyList keyToIdxRev
) =>
MapInsert (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 :: (Monad m) => mp -> key -> m val
instance ( TyListElem keyToIdx key idx
, TyListIndex idxToValue idx val
) =>
MapLookup (TyMap keyToIdx idxToValue) key val where
mapLookup (TM keyToIdx idxToValue) key
= do { idx <- tyListElem keyToIdx key
; return . tyListIndex idxToValue $ idx
}
class MapUpdate mp key val' mp' | mp key val' -> mp' where
mapUpdate :: (Monad m) => mp -> key -> val' -> m 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'
= do { idx <- tyListElem keyToIdx key
; return . TM keyToIdx . tyListUpdateVar idxToValue idx $ val'
}
class MapWith mp key val val' mp' | mp key -> val
, mp key val' -> mp'
where
mapWith :: (Monad m) => mp -> key -> (val -> m val') -> m mp'
instance ( TyListUpdateVar idxToValue idx val' idxToValue'
, TyListElem keyToIdx key idx
, TyListIndex idxToValue idx val
, MapLookup (TyMap keyToIdx idxToValue) key val
, MapLookup (TyMap keyToIdx idxToValue') key val'
) =>
MapWith (TyMap keyToIdx idxToValue) key val val' (TyMap keyToIdx idxToValue') where
mapWith (TM keyToIdx idxToValue) key f
= do { idx <- tyListElem keyToIdx key
; val' <- f . tyListIndex idxToValue $ idx
; return . TM keyToIdx . tyListUpdateVar idxToValue idx $ 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