{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}
{-# LANGUAGE Safe, UndecidableInstances #-}

{- |
    License     :  BSD-style
    Module      :  Data.Field
    Copyright   :  (c) Andrey Mulik 2020
    Maintainer  :  work.a.mulik@gmail.com
    
    @Data.Field@ provides fake field type for record-style operations.
-}
module Data.Field
(
  -- * Simple field
  SField (..), SOField, sfield,
  
  -- * Field
  Field (..), OField,
  
  -- * Observable field
  Observe (..), observe
)
where

import qualified Data.List as L

import Data.Property
import Data.Functor

default ()

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

-- | Simple field, which contain only getter and setter.
data SField m record a = SField
  {
    -- | Get field value
    SField m record a -> record -> m a
getSField :: !(record -> m a),
    -- | Set field value
    SField m record a -> record -> a -> m ()
setSField :: !(record -> a -> m ())
  }

-- | 'Observe' 'SField'.
type SOField = Observe SField

instance GetProp    SField record where getRecord :: SField m record a -> record -> m a
getRecord = SField m record a -> record -> m a
forall (m :: * -> *) record a. SField m record a -> record -> m a
getSField
instance SetProp    SField record where setRecord :: SField m record a -> record -> a -> m ()
setRecord = SField m record a -> record -> a -> m ()
forall (m :: * -> *) record a.
SField m record a -> record -> a -> m ()
setSField
instance ModifyProp SField record

instance (SwitchProp Field record) => SwitchProp SField record
  where
    switchRecord :: SField m record record -> record -> Int -> m ()
switchRecord = Field m record record -> record -> Int -> m ()
forall (field :: (* -> *) -> * -> * -> *) a (m :: * -> *) record.
(SwitchProp field a, Monad m) =>
field m record a -> record -> Int -> m ()
switchRecord (Field m record record -> record -> Int -> m ())
-> (SField m record record -> Field m record record)
-> SField m record record
-> record
-> Int
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SField m record record -> Field m record record
forall (m :: * -> *) record a.
Monad m =>
SField m record a -> Field m record a
toField
    incRecord :: SField m record record -> record -> m ()
incRecord    = Field m record record -> record -> m ()
forall (field :: (* -> *) -> * -> * -> *) a (m :: * -> *) record.
(SwitchProp field a, Monad m) =>
field m record a -> record -> m ()
incRecord (Field m record record -> record -> m ())
-> (SField m record record -> Field m record record)
-> SField m record record
-> record
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SField m record record -> Field m record record
forall (m :: * -> *) record a.
Monad m =>
SField m record a -> Field m record a
toField
    decRecord :: SField m record record -> record -> m ()
decRecord    = Field m record record -> record -> m ()
forall (field :: (* -> *) -> * -> * -> *) a (m :: * -> *) record.
(SwitchProp field a, Monad m) =>
field m record a -> record -> m ()
decRecord (Field m record record -> record -> m ())
-> (SField m record record -> Field m record record)
-> SField m record record
-> record
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SField m record record -> Field m record record
forall (m :: * -> *) record a.
Monad m =>
SField m record a -> Field m record a
toField

instance (InsertProp Field record many) => InsertProp SField record many
  where
    prependRecord :: a -> SField m record (many a) -> record -> m (many a)
prependRecord a
x = a -> Field m record (many a) -> record -> m (many a)
forall (field :: (* -> *) -> * -> * -> *) record (many :: * -> *)
       (m :: * -> *) a.
(InsertProp field record many, Monad m) =>
a -> field m record (many a) -> record -> m (many a)
prependRecord a
x (Field m record (many a) -> record -> m (many a))
-> (SField m record (many a) -> Field m record (many a))
-> SField m record (many a)
-> record
-> m (many a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SField m record (many a) -> Field m record (many a)
forall (m :: * -> *) record a.
Monad m =>
SField m record a -> Field m record a
toField
    appendRecord :: a -> SField m record (many a) -> record -> m (many a)
appendRecord  a
x = a -> Field m record (many a) -> record -> m (many a)
forall (field :: (* -> *) -> * -> * -> *) record (many :: * -> *)
       (m :: * -> *) a.
(InsertProp field record many, Monad m) =>
a -> field m record (many a) -> record -> m (many a)
appendRecord  a
x (Field m record (many a) -> record -> m (many a))
-> (SField m record (many a) -> Field m record (many a))
-> SField m record (many a)
-> record
-> m (many a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SField m record (many a) -> Field m record (many a)
forall (m :: * -> *) record a.
Monad m =>
SField m record a -> Field m record a
toField

instance (DeleteProp Field record many) => DeleteProp SField record many
  where
    deleteRecord :: a -> SField m record (many a) -> record -> m (many a)
deleteRecord a
x = a -> Field m record (many a) -> record -> m (many a)
forall (field :: (* -> *) -> * -> * -> *) record (many :: * -> *)
       (m :: * -> *) a.
(DeleteProp field record many, Monad m, Eq a) =>
a -> field m record (many a) -> record -> m (many a)
deleteRecord a
x (Field m record (many a) -> record -> m (many a))
-> (SField m record (many a) -> Field m record (many a))
-> SField m record (many a)
-> record
-> m (many a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SField m record (many a) -> Field m record (many a)
forall (m :: * -> *) record a.
Monad m =>
SField m record a -> Field m record a
toField

-- | Create 'Field' from getter and setter.
sfield :: (Monad m) => (record -> m a) -> (record -> a -> m ()) -> Field m record a
sfield :: (record -> m a) -> (record -> a -> m ()) -> Field m record a
sfield record -> m a
g record -> a -> m ()
s = SField m record a -> Field m record a
forall (m :: * -> *) record a.
Monad m =>
SField m record a -> Field m record a
toField ((record -> m a) -> (record -> a -> m ()) -> SField m record a
forall (m :: * -> *) record a.
(record -> m a) -> (record -> a -> m ()) -> SField m record a
SField record -> m a
g record -> a -> m ()
s)

toField :: (Monad m) => SField m record a -> Field m record a
toField :: SField m record a -> Field m record a
toField field :: SField m record a
field@(SField record -> m a
g record -> a -> m ()
s) = (record -> m a)
-> (record -> a -> m ())
-> (record -> (a -> a) -> m a)
-> Field m record a
forall (m :: * -> *) record a.
(record -> m a)
-> (record -> a -> m ())
-> (record -> (a -> a) -> m a)
-> Field m record a
Field record -> m a
g record -> a -> m ()
s (SField m record a -> record -> (a -> a) -> m a
forall (field :: (* -> *) -> * -> * -> *) record (m :: * -> *) a.
(ModifyProp field record, Monad m) =>
field m record a -> record -> (a -> a) -> m a
modifyRecord SField m record a
field)

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

-- | Normal field, which contain getter, setter and modifier.
data Field m record a = Field
  {
    -- | Get field value
    Field m record a -> record -> m a
getField    :: !(record -> m a),
    -- | Set field value
    Field m record a -> record -> a -> m ()
setField    :: !(record -> a -> m ()),
    -- | Modify field value
    Field m record a -> record -> (a -> a) -> m a
modifyField :: !(record -> (a -> a) -> m a)
  }

-- | Observable 'Field'.
type OField = Observe Field

instance GetProp    Field record where getRecord :: Field m record a -> record -> m a
getRecord    = Field m record a -> record -> m a
forall (m :: * -> *) record a. Field m record a -> record -> m a
getField
instance SetProp    Field record where setRecord :: Field m record a -> record -> a -> m ()
setRecord    = Field m record a -> record -> a -> m ()
forall (m :: * -> *) record a.
Field m record a -> record -> a -> m ()
setField
instance ModifyProp Field record where modifyRecord :: Field m record a -> record -> (a -> a) -> m a
modifyRecord = Field m record a -> record -> (a -> a) -> m a
forall (m :: * -> *) record a.
Field m record a -> record -> (a -> a) -> m a
modifyField

instance (Integral switch) => SwitchProp Field switch
  where
    incRecord :: Field m record switch -> record -> m ()
incRecord Field m record switch
field record
record = m switch -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m switch -> m ()) -> m switch -> m ()
forall a b. (a -> b) -> a -> b
$ Field m record switch -> record -> (switch -> switch) -> m switch
forall (field :: (* -> *) -> * -> * -> *) record (m :: * -> *) a.
(ModifyProp field record, Monad m) =>
field m record a -> record -> (a -> a) -> m a
modifyRecord Field m record switch
field record
record switch -> switch
forall a. Enum a => a -> a
succ
    decRecord :: Field m record switch -> record -> m ()
decRecord Field m record switch
field record
record = m switch -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m switch -> m ()) -> m switch -> m ()
forall a b. (a -> b) -> a -> b
$ Field m record switch -> record -> (switch -> switch) -> m switch
forall (field :: (* -> *) -> * -> * -> *) record (m :: * -> *) a.
(ModifyProp field record, Monad m) =>
field m record a -> record -> (a -> a) -> m a
modifyRecord Field m record switch
field record
record switch -> switch
forall a. Enum a => a -> a
pred
    
    switchRecord :: Field m record switch -> record -> Int -> m ()
switchRecord Field m record switch
field record
record = m switch -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m switch -> m ()) -> (Int -> m switch) -> Int -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field m record switch -> record -> (switch -> switch) -> m switch
forall (field :: (* -> *) -> * -> * -> *) record (m :: * -> *) a.
(ModifyProp field record, Monad m) =>
field m record a -> record -> (a -> a) -> m a
modifyRecord Field m record switch
field record
record ((switch -> switch) -> m switch)
-> (Int -> switch -> switch) -> Int -> m switch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. switch -> switch -> switch
forall a. Num a => a -> a -> a
(+) (switch -> switch -> switch)
-> (Int -> switch) -> Int -> switch -> switch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> switch
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance {-# INCOHERENT #-} SwitchProp Field Bool
  where
    incRecord :: Field m record Bool -> record -> m ()
incRecord Field m record Bool
record record
field = m Bool -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Bool -> m ()) -> m Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Field m record Bool -> record -> (Bool -> Bool) -> m Bool
forall (field :: (* -> *) -> * -> * -> *) record (m :: * -> *) a.
(ModifyProp field record, Monad m) =>
field m record a -> record -> (a -> a) -> m a
modifyRecord Field m record Bool
record record
field Bool -> Bool
not
    decRecord :: Field m record Bool -> record -> m ()
decRecord Field m record Bool
record record
field = m Bool -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Bool -> m ()) -> m Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Field m record Bool -> record -> (Bool -> Bool) -> m Bool
forall (field :: (* -> *) -> * -> * -> *) record (m :: * -> *) a.
(ModifyProp field record, Monad m) =>
field m record a -> record -> (a -> a) -> m a
modifyRecord Field m record Bool
record record
field Bool -> Bool
not
    
    switchRecord :: Field m record Bool -> record -> Int -> m ()
switchRecord Field m record Bool
record record
field Int
n = m Bool -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Bool -> m ()) -> m Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Field m record Bool -> record -> (Bool -> Bool) -> m Bool
forall (field :: (* -> *) -> * -> * -> *) record (m :: * -> *) a.
(ModifyProp field record, Monad m) =>
field m record a -> record -> (a -> a) -> m a
modifyRecord Field m record Bool
record record
field (Int -> Bool
forall a. Integral a => a -> Bool
even Int
n Bool -> Bool -> Bool
&&)

instance InsertProp Field record []
  where
    appendRecord :: a -> Field m record [a] -> record -> m [a]
appendRecord  a
x Field m record [a]
record record
field = Field m record [a] -> record -> ([a] -> [a]) -> m [a]
forall (field :: (* -> *) -> * -> * -> *) record (m :: * -> *) a.
(ModifyProp field record, Monad m) =>
field m record a -> record -> (a -> a) -> m a
modifyRecord Field m record [a]
record record
field ([a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
x])
    prependRecord :: a -> Field m record [a] -> record -> m [a]
prependRecord a
x Field m record [a]
record record
field = Field m record [a] -> record -> ([a] -> [a]) -> m [a]
forall (field :: (* -> *) -> * -> * -> *) record (m :: * -> *) a.
(ModifyProp field record, Monad m) =>
field m record a -> record -> (a -> a) -> m a
modifyRecord Field m record [a]
record record
field (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:)

instance DeleteProp Field record []
  where
    deleteRecord :: a -> Field m record [a] -> record -> m [a]
deleteRecord a
x Field m record [a]
record record
field = Field m record [a] -> record -> ([a] -> [a]) -> m [a]
forall (field :: (* -> *) -> * -> * -> *) record (m :: * -> *) a.
(ModifyProp field record, Monad m) =>
field m record a -> record -> (a -> a) -> m a
modifyRecord Field m record [a]
record record
field (a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
L.delete a
x)

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

-- | 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 ()
  }

-- | 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 nothing :: p -> p -> m ()
nothing = \ p
_ p
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  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 ()
nothing record -> a -> m ()
forall p p. p -> p -> m ()
nothing (\ record
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

instance (SwitchProp field a) => SwitchProp (Observe field) a
  where
    incRecord :: Observe field m record a -> record -> m ()
incRecord Observe field m record a
field record
record = do
      field m record a -> record -> m ()
forall (field :: (* -> *) -> * -> * -> *) a (m :: * -> *) record.
(SwitchProp field a, Monad m) =>
field m record a -> record -> m ()
incRecord (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 -> m ()
forall (field :: (* -> *) -> * -> * -> *) (m :: * -> *) record a.
Observe field m record a -> record -> m ()
onModify Observe field m record a
field record
record
    
    decRecord :: Observe field m record a -> record -> m ()
decRecord Observe field m record a
field record
record = do
      field m record a -> record -> m ()
forall (field :: (* -> *) -> * -> * -> *) a (m :: * -> *) record.
(SwitchProp field a, Monad m) =>
field m record a -> record -> m ()
decRecord (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 -> m ()
forall (field :: (* -> *) -> * -> * -> *) (m :: * -> *) record a.
Observe field m record a -> record -> m ()
onModify Observe field m record a
field record
record
    
    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 :: (* -> *) -> * -> * -> *) a (m :: * -> *) record.
(SwitchProp field a, Monad m) =>
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 (GetProp field record) => GetProp (Observe field) record
  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 :: (* -> *) -> * -> * -> *) record (m :: * -> *) a.
(GetProp field record, 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 (SetProp field record) => SetProp (Observe field) record
  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 :: (* -> *) -> * -> * -> *) record (m :: * -> *) a.
(SetProp field record, 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 (ModifyProp field record) => ModifyProp (Observe field) record
  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 :: (* -> *) -> * -> * -> *) record (m :: * -> *) a.
(ModifyProp field record, 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

instance (InsertProp field record many) => InsertProp (Observe field) record many
  where
    prependRecord :: a -> Observe field m record (many a) -> record -> m (many a)
prependRecord a
x Observe field m record (many a)
field record
record = do
      many a
res <- a -> field m record (many a) -> record -> m (many a)
forall (field :: (* -> *) -> * -> * -> *) record (many :: * -> *)
       (m :: * -> *) a.
(InsertProp field record many, Monad m) =>
a -> field m record (many a) -> record -> m (many a)
prependRecord a
x (Observe field m record (many a) -> field m record (many a)
forall (field :: (* -> *) -> * -> * -> *) (m :: * -> *) record a.
Observe field m record a -> field m record a
observed Observe field m record (many a)
field) record
record
      Observe field m record (many a) -> record -> m ()
forall (field :: (* -> *) -> * -> * -> *) (m :: * -> *) record a.
Observe field m record a -> record -> m ()
onModify Observe field m record (many a)
field record
record
      many a -> m (many a)
forall (m :: * -> *) a. Monad m => a -> m a
return many a
res
    
    appendRecord :: a -> Observe field m record (many a) -> record -> m (many a)
appendRecord a
x Observe field m record (many a)
field record
record = do
      many a
res <- a -> field m record (many a) -> record -> m (many a)
forall (field :: (* -> *) -> * -> * -> *) record (many :: * -> *)
       (m :: * -> *) a.
(InsertProp field record many, Monad m) =>
a -> field m record (many a) -> record -> m (many a)
appendRecord a
x (Observe field m record (many a) -> field m record (many a)
forall (field :: (* -> *) -> * -> * -> *) (m :: * -> *) record a.
Observe field m record a -> field m record a
observed Observe field m record (many a)
field) record
record
      Observe field m record (many a) -> record -> m ()
forall (field :: (* -> *) -> * -> * -> *) (m :: * -> *) record a.
Observe field m record a -> record -> m ()
onModify Observe field m record (many a)
field record
record
      many a -> m (many a)
forall (m :: * -> *) a. Monad m => a -> m a
return many a
res

instance (DeleteProp field record many) => DeleteProp (Observe field) record many
  where
    deleteRecord :: a -> Observe field m record (many a) -> record -> m (many a)
deleteRecord a
x Observe field m record (many a)
field record
record = do
      many a
res <- a -> field m record (many a) -> record -> m (many a)
forall (field :: (* -> *) -> * -> * -> *) record (many :: * -> *)
       (m :: * -> *) a.
(DeleteProp field record many, Monad m, Eq a) =>
a -> field m record (many a) -> record -> m (many a)
deleteRecord a
x (Observe field m record (many a) -> field m record (many a)
forall (field :: (* -> *) -> * -> * -> *) (m :: * -> *) record a.
Observe field m record a -> field m record a
observed Observe field m record (many a)
field) record
record
      Observe field m record (many a) -> record -> m ()
forall (field :: (* -> *) -> * -> * -> *) (m :: * -> *) record a.
Observe field m record a -> record -> m ()
onModify Observe field m record (many a)
field record
record
      many a -> m (many a)
forall (m :: * -> *) a. Monad m => a -> m a
return many a
res