{-
    Map.hs
        Copyright 2008 Matthew Sackman <matthew@wellquite.org>

    This file is part of Session Types for Haskell.

    Session Types for Haskell is free software: you can redistribute it
    and/or modify it under the terms of the GNU General Public License
    as published by the Free Software Foundation, either version 3 of
    the License, or (at your option) any later version.

    Session Types for Haskell is distributed in the hope that it will
    be useful, but WITHOUT ANY WARRANTY; without even the implied
    warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
    See the GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with Session Types for Haskell.
    If not, see <http://www.gnu.org/licenses/>.
-}

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, UndecidableInstances #-}

-- | Heterogeneous maps at the type level. Obviously equality is done
-- on types and not values and I also don't actually check that a key
-- doesn't already exist - i.e. every time you insert the same key,
-- the map changes. So not really a map after all...

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

-- | Insert into a map. Remember, the values are irrelevant, it's only
-- the types that matter.
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

-- | Lookup in a map. Will call fail in Monad if it's not there.
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
                 }

-- | Update a map. The key must already be in the map. The value is
-- the type of the value, if you see what I mean and so obviously,
-- updating the map means changing the type of the value.
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'
                 }

-- | A helper class - the ability to modify a value in the map and
-- immediately update the map.
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'
                 }

-- | Find the size of a map.
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