packages feed

fmr-0.2: src/Data/Field/Observe.hs

{- |
    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.
    observed :: field m record a,
    -- | 'getRecord' observer
    onGet    :: record -> a -> m (),
    -- | 'setRecord' observer
    onSet    :: record -> a -> m (),
    -- | 'modifyRecord' observer
    onModify :: record -> m ()
  }
  deriving ( Typeable )

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

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

instance (FieldSwitch field) => FieldSwitch (Observe field)
  where
    switchRecord field record n = do
      switchRecord (observed field) record n
      onModify field record

instance (FieldGet field) => FieldGet (Observe field)
  where
    getRecord field record = do
      res <- getRecord (observed field) record
      onGet field record res
      return res

instance (FieldSet field) => FieldSet (Observe field)
  where
    setRecord field record val = do
      setRecord (observed field) record val
      onSet field record val

instance (FieldModify field, FieldGet field) => FieldModify (Observe field)
  where
    modifyRecord field record upd = do
      res <- modifyRecord (observed field) record upd
      onModify field record
      return res
    
    modifyRecordM field record upd = do
      res <- modifyRecordM (observed field) record upd
      onModify field record
      return res