module Dingo.Internal.WidgetSet ( WidgetSet , emptyWidgetSet , getWidgetState , setWidgetState , setWidgetStateJ ) where import Data.Aeson (Value, Result(..), fromJSON) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as H import Data.Typeable (cast) import Dingo.Internal.Base import Dingo.Internal.WidgetTypes (Widget(..)) -- Existential wrapper type for widgets to be able to store them homogeneously. data StateBox w = forall s . (Widget w s, Show w) => StateBox (w, s) data WidgetBox = forall w . WidgetBox (StateBox w) -- Show instance for WidgetBox. instance Show WidgetBox where show (WidgetBox (StateBox (w,s))) = showWidget w s -- WidgetSet data type. newtype WidgetSet = WidgetSet { unWidgetSet :: HashMap WidgetId WidgetBox } deriving (Show) -- The empty widget set. emptyWidgetSet :: WidgetSet emptyWidgetSet = WidgetSet H.empty -- Set a widget's state. setWidgetState :: (Widget w s, Show w) => w -> s -> WidgetSet -> WidgetSet setWidgetState w s (WidgetSet ws) = WidgetSet $ H.insert (getWidgetId w) (WidgetBox (StateBox (w,s))) ws -- Set a widget's state from a JSON object. setWidgetStateJ :: WidgetId -> Value -> WidgetSet -> WidgetSet setWidgetStateJ widgetId j (WidgetSet ws) = WidgetSet $ H.adjust (update j) widgetId ws where update :: Value -> WidgetBox -> WidgetBox update json (WidgetBox (StateBox (w0,s0))) = WidgetBox (StateBox (w0, f $ fromJSON json)) where f (Error _) = s0 -- Couldn't convert JSON; leave state unmodified. f (Success s) = s -- Set state. -- Get a widget's state. getWidgetState :: (Show w, Widget w s) => WidgetSet -> w -> Maybe s getWidgetState ws w = case H.lookup (getWidgetId w) $ unWidgetSet ws of Nothing -> Nothing Just (WidgetBox (StateBox (_, s))) -> cast s