module Hails.MVC.Model.ProtectedModel.Reactive where
import Data.ReactiveValue
import Hails.MVC.Model.ProtectedModel
import Hails.MVC.Model.ReactiveModel hiding (onEvent, onEvents)
import Hails.MVC.Model.ReactiveModel.Events
type Setter a b c = ProtectedModel b c -> a -> IO()
type Getter a b c = ProtectedModel b c -> IO a
type Modifier a b c = ProtectedModel b c -> (a -> a) -> IO()
type ModifierIO a b c = ProtectedModel b c -> (a -> IO a) -> IO()
class ReactiveField a b c d | a -> b, a -> c, a -> d where
events :: a -> [ d ]
onChanged :: (Event d, ReactiveField a b c d) => ProtectedModel c d -> a -> IO () -> IO ()
onChanged pm field p = mapM_ (\e -> onEvent pm e p) (events field)
class ReactiveField a b c d => ReactiveReadField a b c d where
getter :: a -> Getter b c d
class ReactiveWriteField a b c d where
setter :: a -> Setter b c d
class (ReactiveField a b c d, ReactiveReadField a b c d, ReactiveWriteField a b c d) => ReactiveReadWriteField a b c d where
modifier :: a -> Modifier b c d
modifier x pm f = do
v <- getter x pm
let v' = f v
setter x pm v'
modifierIO :: a -> ModifierIO b c d
modifierIO x pm f = do
v <- getter x pm
v' <- f v
setter x pm v'
data Event c => ReactiveElement a b c = ReactiveElement
{ reEvents :: [ c ]
, reSetter :: Setter a b c
, reGetter :: Getter a b c
}
instance Event c => ReactiveField (ReactiveElement a b c) a b c where
events = reEvents
instance Event c => ReactiveReadField (ReactiveElement a b c) a b c where
getter = reGetter
instance Event c => ReactiveWriteField (ReactiveElement a b c) a b c where
setter = reSetter
instance Event c => ReactiveReadWriteField (ReactiveElement a b c) a b c where
type FieldAccessor a b c = ProtectedModel b c -> ReactiveFieldReadWrite IO a
mkFieldAccessor :: (InitialisedEvent c, Event c) => ReactiveElement a b c -> ProtectedModel b c -> ReactiveFieldReadWrite IO a
mkFieldAccessor (ReactiveElement evs setter' getter') pm = ReactiveFieldReadWrite set get notify
where set = setter' pm
get = getter' pm
notify p = onEvents pm (initialisedEvent : evs) p