module Control.Concurrent.Session.Map
( TyMap (..)
, emptyMap
, MapInsert (..)
, MapLookup (..)
, MapUpdate (..)
, MapSize (..)
, tyMapKeys
, MapDelete (..)
) where
import Control.Concurrent.Session.Number
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')
, MapDelete (TyMap keyToIdx' idxToValue') key (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 ( TyListLength keyToIdx newIdx
, TyListReverse keyToIdx keyToIdxRev
, TyListReverse (Cons key keyToIdxRev) keyToIdx'
, TyListUpdateVar idxToValue newIdx value idxToValue'
, TyList keyToIdxRev
, MapDelete (TyMap keyToIdx' idxToValue') key (TyMap keyToIdx idxToValue)
) =>
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
class MapDelete mp key mp' | mp key -> mp' where
mapDelete :: mp -> key -> mp'
instance ( TyListElem keyToIdx key idx
, TyListTake idx keyToIdx keyToIdxPrefix
, TyListTake idx idxToValue idxToValuePrefix
, TyListDrop idxP keyToIdx keyToIdxSuffix
, TyListDrop idxP idxToValue idxToValueSuffix
, Succ idx idxP
, Pred idxP idx
, TyListAppend keyToIdxPrefix keyToIdxSuffix keyToIdx'
, TyListAppend idxToValuePrefix idxToValueSuffix idxToValue'
) =>
MapDelete (TyMap keyToIdx idxToValue) key (TyMap keyToIdx' idxToValue') where
mapDelete (TM keyToIdx idxToValue) key
= TM (tyListAppend keyToIdxPrefix keyToIdxSuffix) (tyListAppend idxToValuePrefix idxToValueSuffix)
where
idx = tyListElem keyToIdx key
idxP = tySucc idx
keyToIdxPrefix = tyListTake idx keyToIdx
keyToIdxSuffix = tyListDrop idxP keyToIdx
idxToValuePrefix = tyListTake idx idxToValue
idxToValueSuffix = tyListDrop idxP idxToValue