{- |
    License     :  BSD-style
    Module      :  Data.Field.Observe
    Copyright   :  (c) Andrey Mulik 2021
    Maintainer  :  work.a.mulik@gmail.com
    
    @Data.Field.Observe@ simple field observer.
-}
module Data.Field.Observe
(
  -- * Exports
  module Data.Property,
  
  -- * Observable field
  Observe (..), observe
)
where

import Data.Typeable
import Data.Property

default ()

--------------------------------------------------------------------------------

-- | Simple field observer, which can run some handlers after each action.
data Observe field m record a = Observe
  {
    -- | Field to observe.
    Observe field m record a -> field m record a
observed :: field m record a,
    -- | 'getRecord' observer
    Observe field m record a -> record -> a -> m ()
onGet    :: record -> a -> m (),
    -- | 'setRecord' observer
    Observe field m record a -> record -> a -> m ()
onSet    :: record -> a -> m (),
    -- | 'modifyRecord' observer
    Observe field m record a -> record -> m ()
onModify :: record -> m ()
  }
  deriving ( Typeable )

-- | Create field with default observers.
observe :: (Monad m) => field m record a -> Observe field m record a
observe :: field m record a -> Observe field m record a
observe field m record a
field =
  let og :: p -> p -> m ()
og = \ p
_ p
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return (); om :: p -> m ()
om = \ p
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return (); os :: p -> p -> m ()
os = p -> p -> m ()
forall p p. p -> p -> m ()
og
  in  field m record a
-> (record -> a -> m ())
-> (record -> a -> m ())
-> (record -> m ())
-> Observe field m record a
forall (field :: (* -> *) -> * -> * -> *) (m :: * -> *) record a.
field m record a
-> (record -> a -> m ())
-> (record -> a -> m ())
-> (record -> m ())
-> Observe field m record a
Observe field m record a
field record -> a -> m ()
forall p p. p -> p -> m ()
og record -> a -> m ()
forall p p. p -> p -> m ()
os record -> m ()
forall p. p -> m ()
om

--------------------------------------------------------------------------------

instance (FieldSwitch field) => FieldSwitch (Observe field)
  where
    switchRecord :: Observe field m record a -> record -> Int -> m ()
switchRecord Observe field m record a
field record
record Int
n = do
      field m record a -> record -> Int -> m ()
forall (field :: (* -> *) -> * -> * -> *) (m :: * -> *) a record.
(FieldSwitch field, Monad m, IsSwitch a) =>
field m record a -> record -> Int -> m ()
switchRecord (Observe field m record a -> field m record a
forall (field :: (* -> *) -> * -> * -> *) (m :: * -> *) record a.
Observe field m record a -> field m record a
observed Observe field m record a
field) record
record Int
n
      Observe field m record a -> record -> m ()
forall (field :: (* -> *) -> * -> * -> *) (m :: * -> *) record a.
Observe field m record a -> record -> m ()
onModify Observe field m record a
field record
record

instance (FieldGet field) => FieldGet (Observe field)
  where
    getRecord :: Observe field m record a -> record -> m a
getRecord Observe field m record a
field record
record = do
      a
res <- field m record a -> record -> m a
forall (field :: (* -> *) -> * -> * -> *) (m :: * -> *) record a.
(FieldGet field, Monad m) =>
field m record a -> record -> m a
getRecord (Observe field m record a -> field m record a
forall (field :: (* -> *) -> * -> * -> *) (m :: * -> *) record a.
Observe field m record a -> field m record a
observed Observe field m record a
field) record
record
      Observe field m record a -> record -> a -> m ()
forall (field :: (* -> *) -> * -> * -> *) (m :: * -> *) record a.
Observe field m record a -> record -> a -> m ()
onGet Observe field m record a
field record
record a
res
      a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res

instance (FieldSet field) => FieldSet (Observe field)
  where
    setRecord :: Observe field m record a -> record -> a -> m ()
setRecord Observe field m record a
field record
record a
val = do
      field m record a -> record -> a -> m ()
forall (field :: (* -> *) -> * -> * -> *) (m :: * -> *) record a.
(FieldSet field, Monad m) =>
field m record a -> record -> a -> m ()
setRecord (Observe field m record a -> field m record a
forall (field :: (* -> *) -> * -> * -> *) (m :: * -> *) record a.
Observe field m record a -> field m record a
observed Observe field m record a
field) record
record a
val
      Observe field m record a -> record -> a -> m ()
forall (field :: (* -> *) -> * -> * -> *) (m :: * -> *) record a.
Observe field m record a -> record -> a -> m ()
onSet Observe field m record a
field record
record a
val

instance (FieldModify field, FieldGet field) => FieldModify (Observe field)
  where
    modifyRecord :: Observe field m record a -> record -> (a -> a) -> m a
modifyRecord Observe field m record a
field record
record a -> a
upd = do
      a
res <- field m record a -> record -> (a -> a) -> m a
forall (field :: (* -> *) -> * -> * -> *) (m :: * -> *) record a.
(FieldModify field, Monad m) =>
field m record a -> record -> (a -> a) -> m a
modifyRecord (Observe field m record a -> field m record a
forall (field :: (* -> *) -> * -> * -> *) (m :: * -> *) record a.
Observe field m record a -> field m record a
observed Observe field m record a
field) record
record a -> a
upd
      Observe field m record a -> record -> m ()
forall (field :: (* -> *) -> * -> * -> *) (m :: * -> *) record a.
Observe field m record a -> record -> m ()
onModify Observe field m record a
field record
record
      a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res
    
    modifyRecordM :: Observe field m record a -> record -> (a -> m a) -> m a
modifyRecordM Observe field m record a
field record
record a -> m a
upd = do
      a
res <- field m record a -> record -> (a -> m a) -> m a
forall (field :: (* -> *) -> * -> * -> *) (m :: * -> *) record a.
(FieldModify field, Monad m, FieldGet field) =>
field m record a -> record -> (a -> m a) -> m a
modifyRecordM (Observe field m record a -> field m record a
forall (field :: (* -> *) -> * -> * -> *) (m :: * -> *) record a.
Observe field m record a -> field m record a
observed Observe field m record a
field) record
record a -> m a
upd
      Observe field m record a -> record -> m ()
forall (field :: (* -> *) -> * -> * -> *) (m :: * -> *) record a.
Observe field m record a -> record -> m ()
onModify Observe field m record a
field record
record
      a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res