{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE DeriveDataTypeable #-}

-- | VariableMap is analagous to VariableSet and provides a mutable map ordered
-- by key whose changes can be tracked.
module Util.VariableMap(
   VariableMapData,
   VariableMapUpdate(..),
   VariableMap,
   newEmptyVariableMap,
   newVariableMap,
   newVariableMapFromFM,
   updateMap,
   lookupMap,
   lookupWithDefaultMap,
   mapToList,
   mapToFM,
   mapToVariableSetSource,

   addToVariableMap,
   delFromVariableMap,
   variableMapToList,
   lookupVariableMap,
   getVariableMapByKey,
   ) where

import Data.Maybe

import qualified Data.Map as Map

import Util.Dynamics
import Util.Broadcaster
import Util.VariableSet
import Util.Sources

-- --------------------------------------------------------------------
-- The datatype
-- --------------------------------------------------------------------

-- | Describes a map update.  For DelUpdate, the second parameter (the one
-- of type elt) is irrelevant and may be undefined.
newtype VariableMapData key elt = VariableMapData (Map.Map key elt)

-- | We recycle the VariableSetUpdate type for this.
newtype VariableMapUpdate key elt =
   VariableMapUpdate (VariableSetUpdate (key,elt))

-- | The Bool indicates whether the operation was successfully carried out.
-- We block updating a value which is already in the map, or
-- deleting one that isn\'t.
update :: Ord key
   => VariableMapUpdate key elt -> VariableMapData key elt
   -> (VariableMapData key elt,[VariableMapUpdate key elt],Bool)
update :: VariableMapUpdate key elt
-> VariableMapData key elt
-> (VariableMapData key elt, [VariableMapUpdate key elt], Bool)
update (variableUpdate :: VariableMapUpdate key elt
variableUpdate @ (VariableMapUpdate VariableSetUpdate (key, elt)
update))
       (variableMap :: VariableMapData key elt
variableMap @ (VariableMapData Map key elt
map)) =
   case VariableSetUpdate (key, elt)
update of
      AddElement (key
key,elt
elt) ->
         if key -> Bool
member key
key
            then
               (VariableMapData key elt
variableMap,[],Bool
False)
            else
               (Map key elt -> VariableMapData key elt
forall key elt. Map key elt -> VariableMapData key elt
VariableMapData (key -> elt -> Map key elt -> Map key elt
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert key
key elt
elt Map key elt
map),[VariableMapUpdate key elt
variableUpdate],Bool
True)
      DelElement (key
key,elt
_) ->
         -- we ignore the element, allowing delFromVariable map to put an
         -- error there.
         case key -> Map key elt -> Maybe elt
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup key
key Map key elt
map of
            Just elt
elt ->
               (Map key elt -> VariableMapData key elt
forall key elt. Map key elt -> VariableMapData key elt
VariableMapData (key -> Map key elt -> Map key elt
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete key
key Map key elt
map),
                  [VariableSetUpdate (key, elt) -> VariableMapUpdate key elt
forall key elt.
VariableSetUpdate (key, elt) -> VariableMapUpdate key elt
VariableMapUpdate ((key, elt) -> VariableSetUpdate (key, elt)
forall x. x -> VariableSetUpdate x
DelElement (key
key,elt
elt))],Bool
True)
            Maybe elt
Nothing -> (VariableMapData key elt
variableMap,[],Bool
False)
      VariableSetUpdate (key, elt)
BeginGroup -> (VariableMapData key elt
variableMap,[VariableMapUpdate key elt
variableUpdate],Bool
True)
      VariableSetUpdate (key, elt)
EndGroup -> (VariableMapData key elt
variableMap,[VariableMapUpdate key elt
variableUpdate],Bool
True)
   where
      member :: key -> Bool
member key
key = Maybe elt -> Bool
forall a. Maybe a -> Bool
isJust (key -> Map key elt -> Maybe elt
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup key
key Map key elt
map)

newtype VariableMap key elt =
   VariableMap (GeneralBroadcaster (VariableMapData key elt)
      (VariableMapUpdate key elt))
   deriving (Typeable)

-- --------------------------------------------------------------------
-- The provider's interface
-- --------------------------------------------------------------------

-- | Create a new empty variable map.
newEmptyVariableMap :: Ord key => IO (VariableMap key elt)
newEmptyVariableMap :: IO (VariableMap key elt)
newEmptyVariableMap =
   do
      GeneralBroadcaster
  (VariableMapData key elt) (VariableMapUpdate key elt)
broadcaster <- VariableMapData key elt
-> IO
     (GeneralBroadcaster
        (VariableMapData key elt) (VariableMapUpdate key elt))
forall x d. x -> IO (GeneralBroadcaster x d)
newGeneralBroadcaster (Map key elt -> VariableMapData key elt
forall key elt. Map key elt -> VariableMapData key elt
VariableMapData Map key elt
forall k a. Map k a
Map.empty)
      VariableMap key elt -> IO (VariableMap key elt)
forall (m :: * -> *) a. Monad m => a -> m a
return (GeneralBroadcaster
  (VariableMapData key elt) (VariableMapUpdate key elt)
-> VariableMap key elt
forall key elt.
GeneralBroadcaster
  (VariableMapData key elt) (VariableMapUpdate key elt)
-> VariableMap key elt
VariableMap GeneralBroadcaster
  (VariableMapData key elt) (VariableMapUpdate key elt)
broadcaster)

-- | Create a new variable map with given contents
newVariableMap :: Ord key => [(key,elt)] -> IO (VariableMap key elt)
newVariableMap :: [(key, elt)] -> IO (VariableMap key elt)
newVariableMap [(key, elt)]
contents = Map key elt -> IO (VariableMap key elt)
forall key elt. Ord key => Map key elt -> IO (VariableMap key elt)
newVariableMapFromFM ([(key, elt)] -> Map key elt
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(key, elt)]
contents)

newVariableMapFromFM :: Ord key
   => Map.Map key elt -> IO (VariableMap key elt)
newVariableMapFromFM :: Map key elt -> IO (VariableMap key elt)
newVariableMapFromFM Map key elt
fmap =
   do
      GeneralBroadcaster
  (VariableMapData key elt) (VariableMapUpdate key elt)
broadcaster <- VariableMapData key elt
-> IO
     (GeneralBroadcaster
        (VariableMapData key elt) (VariableMapUpdate key elt))
forall x d. x -> IO (GeneralBroadcaster x d)
newGeneralBroadcaster (Map key elt -> VariableMapData key elt
forall key elt. Map key elt -> VariableMapData key elt
VariableMapData Map key elt
fmap)
      VariableMap key elt -> IO (VariableMap key elt)
forall (m :: * -> *) a. Monad m => a -> m a
return (GeneralBroadcaster
  (VariableMapData key elt) (VariableMapUpdate key elt)
-> VariableMap key elt
forall key elt.
GeneralBroadcaster
  (VariableMapData key elt) (VariableMapUpdate key elt)
-> VariableMap key elt
VariableMap GeneralBroadcaster
  (VariableMapData key elt) (VariableMapUpdate key elt)
broadcaster)


-- | Update a variable map in some way.  Returns True if the update was
-- sucessful (so for insertions, the object is not already there; for
-- deletions the object is not there).
updateMap :: Ord key => VariableMap key elt -> VariableMapUpdate key elt
   -> IO Bool
updateMap :: VariableMap key elt -> VariableMapUpdate key elt -> IO Bool
updateMap (VariableMap GeneralBroadcaster
  (VariableMapData key elt) (VariableMapUpdate key elt)
broadcaster) VariableMapUpdate key elt
mapUpdate =
   GeneralBroadcaster
  (VariableMapData key elt) (VariableMapUpdate key elt)
-> (VariableMapData key elt
    -> (VariableMapData key elt, [VariableMapUpdate key elt], Bool))
-> IO Bool
forall x d extra.
GeneralBroadcaster x d -> (x -> (x, [d], extra)) -> IO extra
applyGeneralUpdate GeneralBroadcaster
  (VariableMapData key elt) (VariableMapUpdate key elt)
broadcaster (VariableMapUpdate key elt
-> VariableMapData key elt
-> (VariableMapData key elt, [VariableMapUpdate key elt], Bool)
forall key elt.
Ord key =>
VariableMapUpdate key elt
-> VariableMapData key elt
-> (VariableMapData key elt, [VariableMapUpdate key elt], Bool)
update VariableMapUpdate key elt
mapUpdate)


-- --------------------------------------------------------------------
-- The client's interface
-- --------------------------------------------------------------------


-- | Unlike VariableSet, the contents of a variable map are not returned in
-- concrete form but as the abstract data type VariableMapData.  We provide
-- functions for querying this.
instance Ord key => HasSource (VariableMap key elt)
      (VariableMapData key elt) (VariableMapUpdate key elt)
      where
   toSource :: VariableMap key elt
-> Source (VariableMapData key elt) (VariableMapUpdate key elt)
toSource (VariableMap GeneralBroadcaster
  (VariableMapData key elt) (VariableMapUpdate key elt)
broadcaster) = GeneralBroadcaster
  (VariableMapData key elt) (VariableMapUpdate key elt)
-> Source (VariableMapData key elt) (VariableMapUpdate key elt)
forall hasSource x d.
HasSource hasSource x d =>
hasSource -> Source x d
toSource GeneralBroadcaster
  (VariableMapData key elt) (VariableMapUpdate key elt)
broadcaster

lookupMap :: Ord key => VariableMapData key elt -> key -> Maybe elt
lookupMap :: VariableMapData key elt -> key -> Maybe elt
lookupMap (VariableMapData Map key elt
map) key
key = key -> Map key elt -> Maybe elt
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup key
key Map key elt
map

lookupWithDefaultMap :: Ord key => VariableMapData key elt -> elt -> key -> elt
lookupWithDefaultMap :: VariableMapData key elt -> elt -> key -> elt
lookupWithDefaultMap (VariableMapData Map key elt
map) elt
def key
key
   = elt -> key -> Map key elt -> elt
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault elt
def key
key Map key elt
map

mapToList :: Ord key => VariableMapData key elt -> [(key,elt)]
mapToList :: VariableMapData key elt -> [(key, elt)]
mapToList = Map key elt -> [(key, elt)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map key elt -> [(key, elt)])
-> (VariableMapData key elt -> Map key elt)
-> VariableMapData key elt
-> [(key, elt)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VariableMapData key elt -> Map key elt
forall key elt. Ord key => VariableMapData key elt -> Map key elt
mapToFM

mapToFM :: Ord key => VariableMapData key elt -> Map.Map key elt
mapToFM :: VariableMapData key elt -> Map key elt
mapToFM (VariableMapData Map key elt
map) = Map key elt
map

-- --------------------------------------------------------------------
-- An interface to a VariableMap which makes it look like a variable
-- set source.
-- --------------------------------------------------------------------

data VariableMapSet key elt element = VariableMapSet {
   VariableMapSet key elt element -> VariableMap key elt
variableMap :: VariableMap key elt,
   VariableMapSet key elt element -> key -> elt -> element
mkElement :: key -> elt -> element
   }

-- | Given a variable map and conversion function, produce a VariableSetSource
mapToVariableSetSource :: Ord key => (key -> elt -> element)
   -> VariableMap key elt -> VariableSetSource element
mapToVariableSetSource :: (key -> elt -> element)
-> VariableMap key elt -> VariableSetSource element
mapToVariableSetSource key -> elt -> element
mkElement VariableMap key elt
variableMap = VariableMapSet key elt element -> VariableSetSource element
forall hasSource x d.
HasSource hasSource x d =>
hasSource -> Source x d
toSource (VariableMapSet :: forall key elt element.
VariableMap key elt
-> (key -> elt -> element) -> VariableMapSet key elt element
VariableMapSet
      {variableMap :: VariableMap key elt
variableMap = VariableMap key elt
variableMap,mkElement :: key -> elt -> element
mkElement = key -> elt -> element
mkElement})

instance Ord key => HasSource (VariableMapSet key elt element) [element]
     (VariableSetUpdate element)
   where
      toSource :: VariableMapSet key elt element
-> Source [element] (VariableSetUpdate element)
toSource (VariableMapSet
         {variableMap :: forall key elt element.
VariableMapSet key elt element -> VariableMap key elt
variableMap = VariableMap key elt
variableMap,mkElement :: forall key elt element.
VariableMapSet key elt element -> key -> elt -> element
mkElement = key -> elt -> element
mkElement}) =
            ((VariableMapData key elt -> [element])
-> Source (VariableMapData key elt) (VariableSetUpdate element)
-> Source [element] (VariableSetUpdate element)
forall x1 x2 d. (x1 -> x2) -> Source x1 d -> Source x2 d
map1
               (\ (VariableMapData Map key elt
contents) ->
                  ((key, elt) -> element) -> [(key, elt)] -> [element]
forall a b. (a -> b) -> [a] -> [b]
map ((key -> elt -> element) -> (key, elt) -> element
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry key -> elt -> element
mkElement) (Map key elt -> [(key, elt)]
forall k a. Map k a -> [(k, a)]
Map.toList Map key elt
contents)
                  )
               )
            (Source (VariableMapData key elt) (VariableSetUpdate element)
 -> Source [element] (VariableSetUpdate element))
-> (Source (VariableMapData key elt) (VariableMapUpdate key elt)
    -> Source (VariableMapData key elt) (VariableSetUpdate element))
-> Source (VariableMapData key elt) (VariableMapUpdate key elt)
-> Source [element] (VariableSetUpdate element)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            ((VariableMapUpdate key elt -> VariableSetUpdate element)
-> Source (VariableMapData key elt) (VariableMapUpdate key elt)
-> Source (VariableMapData key elt) (VariableSetUpdate element)
forall d1 d2 x. (d1 -> d2) -> Source x d1 -> Source x d2
map2
               (\ (VariableMapUpdate VariableSetUpdate (key, elt)
update) ->
                  ((key, elt) -> element)
-> VariableSetUpdate (key, elt) -> VariableSetUpdate element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ (key
key,elt
elt) -> key -> elt -> element
mkElement key
key elt
elt) VariableSetUpdate (key, elt)
update
                  )
               )
            (Source (VariableMapData key elt) (VariableMapUpdate key elt)
 -> Source [element] (VariableSetUpdate element))
-> Source (VariableMapData key elt) (VariableMapUpdate key elt)
-> Source [element] (VariableSetUpdate element)
forall a b. (a -> b) -> a -> b
$
            (VariableMap key elt
-> Source (VariableMapData key elt) (VariableMapUpdate key elt)
forall hasSource x d.
HasSource hasSource x d =>
hasSource -> Source x d
toSource VariableMap key elt
variableMap)

-- --------------------------------------------------------------------
-- A couple of simple access functions
-- NB.  We don't follow the Registry interface because, without altering
-- the design, it would be difficult to implement some Registry functions.
-- --------------------------------------------------------------------

addToVariableMap :: Ord key => VariableMap key elt -> key -> elt -> IO Bool
addToVariableMap :: VariableMap key elt -> key -> elt -> IO Bool
addToVariableMap VariableMap key elt
variableMap key
key elt
elt =
   VariableMap key elt -> VariableMapUpdate key elt -> IO Bool
forall key elt.
Ord key =>
VariableMap key elt -> VariableMapUpdate key elt -> IO Bool
updateMap VariableMap key elt
variableMap (VariableSetUpdate (key, elt) -> VariableMapUpdate key elt
forall key elt.
VariableSetUpdate (key, elt) -> VariableMapUpdate key elt
VariableMapUpdate ((key, elt) -> VariableSetUpdate (key, elt)
forall x. x -> VariableSetUpdate x
AddElement (key
key,elt
elt)))

delFromVariableMap :: Ord key => VariableMap key elt -> key -> IO Bool
delFromVariableMap :: VariableMap key elt -> key -> IO Bool
delFromVariableMap VariableMap key elt
variableMap key
key =
   VariableMap key elt -> VariableMapUpdate key elt -> IO Bool
forall key elt.
Ord key =>
VariableMap key elt -> VariableMapUpdate key elt -> IO Bool
updateMap VariableMap key elt
variableMap (VariableSetUpdate (key, elt) -> VariableMapUpdate key elt
forall key elt.
VariableSetUpdate (key, elt) -> VariableMapUpdate key elt
VariableMapUpdate ((key, elt) -> VariableSetUpdate (key, elt)
forall x. x -> VariableSetUpdate x
DelElement (key
key,
      [Char] -> elt
forall a. HasCallStack => [Char] -> a
error ([Char]
"VariableMap.delFromVariableMap"))))

variableMapToList :: Ord key => VariableMap key elt -> IO [(key,elt)]
variableMapToList :: VariableMap key elt -> IO [(key, elt)]
variableMapToList (VariableMap GeneralBroadcaster
  (VariableMapData key elt) (VariableMapUpdate key elt)
broadcaster) =
   do
      VariableMapData key elt
contents <- GeneralBroadcaster
  (VariableMapData key elt) (VariableMapUpdate key elt)
-> IO (VariableMapData key elt)
forall source x d. HasSource source x d => source -> IO x
readContents GeneralBroadcaster
  (VariableMapData key elt) (VariableMapUpdate key elt)
broadcaster
      [(key, elt)] -> IO [(key, elt)]
forall (m :: * -> *) a. Monad m => a -> m a
return (VariableMapData key elt -> [(key, elt)]
forall key elt. Ord key => VariableMapData key elt -> [(key, elt)]
mapToList VariableMapData key elt
contents)

lookupVariableMap :: Ord key => VariableMap key elt -> key -> IO (Maybe elt)
lookupVariableMap :: VariableMap key elt -> key -> IO (Maybe elt)
lookupVariableMap (VariableMap GeneralBroadcaster
  (VariableMapData key elt) (VariableMapUpdate key elt)
broadcaster) key
key =
   do
      (VariableMapData Map key elt
finiteMap) <- GeneralBroadcaster
  (VariableMapData key elt) (VariableMapUpdate key elt)
-> IO (VariableMapData key elt)
forall source x d. HasSource source x d => source -> IO x
readContents GeneralBroadcaster
  (VariableMapData key elt) (VariableMapUpdate key elt)
broadcaster
      Maybe elt -> IO (Maybe elt)
forall (m :: * -> *) a. Monad m => a -> m a
return (key -> Map key elt -> Maybe elt
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup key
key Map key elt
finiteMap)

-- --------------------------------------------------------------------
-- Returns current value of key (if any) in variable map
-- NB.  This implementation is very inefficient and it is in an inner loop
-- in types/LinkManager.  However it could be made much better by changing
-- the type.
-- --------------------------------------------------------------------

getVariableMapByKey :: Ord key => VariableMap key elt -> key
   -> SimpleSource (Maybe elt)
getVariableMapByKey :: VariableMap key elt -> key -> SimpleSource (Maybe elt)
getVariableMapByKey VariableMap key elt
variableMap key
key =
   let
      source1 :: Source (VariableMapData key elt) (VariableMapUpdate key elt)
source1 = VariableMap key elt
-> Source (VariableMapData key elt) (VariableMapUpdate key elt)
forall hasSource x d.
HasSource hasSource x d =>
hasSource -> Source x d
toSource VariableMap key elt
variableMap
      source2 :: Source (Maybe elt) (Maybe elt)
source2 =
         ((VariableMapData key elt -> Maybe elt)
-> Source (VariableMapData key elt) (Maybe elt)
-> Source (Maybe elt) (Maybe elt)
forall x1 x2 d. (x1 -> x2) -> Source x1 d -> Source x2 d
map1
            (\ (VariableMapData Map key elt
fmap) -> key -> Map key elt -> Maybe elt
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup key
key Map key elt
fmap)
            )
         (Source (VariableMapData key elt) (Maybe elt)
 -> Source (Maybe elt) (Maybe elt))
-> (Source (VariableMapData key elt) (VariableMapUpdate key elt)
    -> Source (VariableMapData key elt) (Maybe elt))
-> Source (VariableMapData key elt) (VariableMapUpdate key elt)
-> Source (Maybe elt) (Maybe elt)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         ((VariableMapUpdate key elt -> Maybe (Maybe elt))
-> Source (VariableMapData key elt) (VariableMapUpdate key elt)
-> Source (VariableMapData key elt) (Maybe elt)
forall d1 d2 x. (d1 -> Maybe d2) -> Source x d1 -> Source x d2
filter2
            (\ (VariableMapUpdate VariableSetUpdate (key, elt)
update) -> case VariableSetUpdate (key, elt)
update of
               AddElement (key
key2,elt
elt)
                  | key
key2 key -> key -> Bool
forall a. Eq a => a -> a -> Bool
== key
key -> Maybe elt -> Maybe (Maybe elt)
forall a. a -> Maybe a
Just (elt -> Maybe elt
forall a. a -> Maybe a
Just elt
elt)
               DelElement (key
key2,elt
elt)
                  | key
key2 key -> key -> Bool
forall a. Eq a => a -> a -> Bool
== key
key -> Maybe elt -> Maybe (Maybe elt)
forall a. a -> Maybe a
Just Maybe elt
forall a. Maybe a
Nothing
               VariableSetUpdate (key, elt)
_ -> Maybe (Maybe elt)
forall a. Maybe a
Nothing
               )
            )
         (Source (VariableMapData key elt) (VariableMapUpdate key elt)
 -> Source (Maybe elt) (Maybe elt))
-> Source (VariableMapData key elt) (VariableMapUpdate key elt)
-> Source (Maybe elt) (Maybe elt)
forall a b. (a -> b) -> a -> b
$
         Source (VariableMapData key elt) (VariableMapUpdate key elt)
source1
   in
      Source (Maybe elt) (Maybe elt) -> SimpleSource (Maybe elt)
forall x. Source x x -> SimpleSource x
SimpleSource Source (Maybe elt) (Maybe elt)
source2