{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
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 :: ProtectedModel c d -> a -> IO () -> IO ()
onChanged ProtectedModel c d
pm a
field IO ()
p = (d -> IO ()) -> [d] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\d
e -> ProtectedModel c d -> d -> IO () -> IO ()
forall b a. Event b => ProtectedModel a b -> b -> IO () -> IO ()
onEvent ProtectedModel c d
pm d
e IO ()
p) (a -> [d]
forall a b c d. ReactiveField a b c d => a -> [d]
events a
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 a
x ProtectedModel c d
pm b -> b
f = do
b
v <- a -> Getter b c d
forall a b c d. ReactiveReadField a b c d => a -> Getter b c d
getter a
x ProtectedModel c d
pm
let v' :: b
v' = b -> b
f b
v
a -> Setter b c d
forall a b c d. ReactiveWriteField a b c d => a -> Setter b c d
setter a
x ProtectedModel c d
pm b
v'
modifierIO :: a -> ModifierIO b c d
modifierIO a
x ProtectedModel c d
pm b -> IO b
f = do
b
v <- a -> Getter b c d
forall a b c d. ReactiveReadField a b c d => a -> Getter b c d
getter a
x ProtectedModel c d
pm
b
v' <- b -> IO b
f b
v
a -> Setter b c d
forall a b c d. ReactiveWriteField a b c d => a -> Setter b c d
setter a
x ProtectedModel c d
pm b
v'
data Event c => ReactiveElement a b c = ReactiveElement
{ ReactiveElement a b c -> [c]
reEvents :: [ c ]
, ReactiveElement a b c -> Setter a b c
reSetter :: Setter a b c
, ReactiveElement a b c -> Getter a b c
reGetter :: Getter a b c
}
instance Event c => ReactiveField (ReactiveElement a b c) a b c where
events :: ReactiveElement a b c -> [c]
events = ReactiveElement a b c -> [c]
forall a b c. Event c => ReactiveElement a b c -> [c]
reEvents
instance Event c => ReactiveReadField (ReactiveElement a b c) a b c where
getter :: ReactiveElement a b c -> Getter a b c
getter = ReactiveElement a b c -> Getter a b c
forall a b c. Event c => ReactiveElement a b c -> Getter a b c
reGetter
instance Event c => ReactiveWriteField (ReactiveElement a b c) a b c where
setter :: ReactiveElement a b c -> Setter a b c
setter = ReactiveElement a b c -> Setter a b c
forall a b c. Event c => ReactiveElement a b c -> Setter a b c
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 a b c
-> ProtectedModel b c -> ReactiveFieldReadWrite IO a
mkFieldAccessor (ReactiveElement [c]
evs Setter a b c
setter' Getter a b c
getter') ProtectedModel b c
pm = FieldSetter IO a
-> FieldGetter IO a
-> (IO () -> IO ())
-> ReactiveFieldReadWrite IO a
forall (m :: * -> *) a.
FieldSetter m a
-> FieldGetter m a
-> FieldNotifier m a
-> ReactiveFieldReadWrite m a
ReactiveFieldReadWrite FieldSetter IO a
set FieldGetter IO a
get IO () -> IO ()
notify
where set :: FieldSetter IO a
set = Setter a b c
setter' ProtectedModel b c
pm
get :: FieldGetter IO a
get = Getter a b c
getter' ProtectedModel b c
pm
notify :: IO () -> IO ()
notify IO ()
p = ProtectedModel b c -> [c] -> IO () -> IO ()
forall (container :: * -> *) b a.
(Foldable container, Event b) =>
ProtectedModel a b -> container b -> IO () -> IO ()
onEvents ProtectedModel b c
pm (c
forall a. InitialisedEvent a => a
initialisedEvent c -> [c] -> [c]
forall a. a -> [a] -> [a]
: [c]
evs) IO ()
p