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(..))
data StateBox w = forall s . (Widget w s, Show w) => StateBox (w, s)
data WidgetBox = forall w . WidgetBox (StateBox w)
instance Show WidgetBox where
show (WidgetBox (StateBox (w,s))) = showWidget w s
newtype WidgetSet = WidgetSet { unWidgetSet :: HashMap WidgetId WidgetBox }
deriving (Show)
emptyWidgetSet :: WidgetSet
emptyWidgetSet = WidgetSet H.empty
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
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
f (Success s) = s
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