content: {-# 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 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
  