implementation module Gtk.Shares

import StdEnv
import StdMaybe
import StdDebug

import Control.Monad
import Data.Functor
import qualified Data.Map

import Gtk

:: Shared a :== (String,a)

share :: !ShareId a -> Shared a | shared a
share id default = (id,default)

getShared :: !(Shared a) -> GtkM a | shared a
getShared (id,default) = retrieve <$> getState
where
	retrieve {shares} = case 'Data.Map'.get id shares of
		Nothing        -> default
		Just (v :: a^) -> v
		Just d         -> trace_n warning default
		with
			warning = "getShared type mismatch: expected "+++
				toString (typeCodeOfDynamic (dynamic default))+++"; got "+++
				toString (typeCodeOfDynamic d)

setShared :: !(Shared a) !a -> GtkM a | shared a
setShared (id,_) v =
	modState (\st -> {st & shares='Data.Map'.put id (dynamic v) st.shares}) >>|
	pure v

updateShared :: !(a -> a) !(Shared a) -> GtkM a | shared a
updateShared f shared = getShared shared >>= setShared shared o f

singletonShared :: !String !(GtkM a) -> GtkM a | shared a
singletonShared name setup =
	let shr = share name Nothing in
	getShared shr >>= \val -> case val of
		Just val ->
			pure val
		Nothing ->
			setup >>= \val ->
			setShared shr (Just val) >>|
			pure val