{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
-- | Protected Reactive Fields
--
-- This module defines several classes and operations that are used to
-- create reactive fields and to bind reactive fields in the view to
-- reactive fields in the model.
--
-- FIXME: Due to the restrictions in the type classes, the current
-- version uses Model.ProtectedModel.ProtectedModelInternals.ProtectedModel.
--
-- Copyright   : (C) Keera Studios Ltd, 2013
-- License     : BSD3
-- Maintainer  : support@keera.co.uk
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