{-# LANGUAGE Safe, DefaultSignatures, GADTs, UndecidableInstances, BangPatterns #-}
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}

{- |
    License     :  BSD-style
    Module      :  Data.Property
    Copyright   :  (c) Andrey Mulik 2020
    Maintainer  :  work.a.mulik@gmail.com
    
    @Data.Property@ provides property type 'Prop' for record-style operations.
-}
module Data.Property
(
  -- * Property
  Prop (..), get, set, setProp,
  
  -- ** Get
  GetProp (..),
  
  -- ** Set
  SetProp (..),
  
  -- ** Modify
  ModifyProp (..), InsertProp (..), DeleteProp (..), SwitchProp (..)
)
where

import Data.Functor

default ()

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

-- | Property representation
data Prop m field record
  where
    -- | Increase property value (switch flag, increment, etc.).
    Incr :: (Monad m, SwitchProp field a) =>
      field m record a -> Prop m field record
    
    -- | Decrease property value (switch flag, decrement, etc.).
    Decr :: (Monad m, SwitchProp field a) =>
      field m record a -> Prop m field record
    
    -- | Increase/decrease value many times.
    Switch :: (Monad m, SwitchProp field a) =>
      field m record a -> Int -> Prop m field record
    
    -- | @field ':=' val@ sets new value @val@ to record.
    (:=)  :: (Monad m, SetProp field record) =>
      field m record a -> a -> Prop m field record
    
    -- | @field '::=' upd@ - updates value using @upd@.
    (::=) :: (Monad m, SetProp field record) =>
      field m record a -> (record -> a) -> Prop m field record
    
    -- | @field ':~' upd@ updates value using @upd@.
    (:~)  :: (Monad m, ModifyProp field record) =>
      field m record a -> (a -> a) -> Prop m field record
    
    -- | @field '::=' upd@ - updates value using @upd@.
    (::~) :: (Monad m, ModifyProp field record) =>
      field m record a -> (record -> a -> a) -> Prop m field record
    
    -- | @field ':=+' val@ appends @val@ to @record@ value.
    (:=+) :: (Monad m, InsertProp field record many) =>
      field m record (many a) -> a -> Prop m field record
    
    -- | @val ':=+' field@ prepends @val@ to @record@ value.
    (:+=) :: (Monad m, InsertProp field record many) =>
      a -> field m record (many a) -> Prop m field record
    
    -- | @field ':~=' val@ removes @val@ from @record@ value
    (:~=) :: (Monad m, DeleteProp field record many, Eq a) =>
      field m record (many a) -> a -> Prop m field record

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

-- | 'getRecord' shortcut.
get :: (Monad m, GetProp field record) => field m record a -> record -> m a
get :: field m record a -> record -> m a
get =  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

-- | 'setProp' shortcut.
set :: (Monad m) => record -> [Prop m field record] -> m ()
set :: record -> [Prop m field record] -> m ()
set =  record -> [Prop m field record] -> m ()
forall (m :: * -> *) record (field :: (* -> *) -> * -> * -> *).
Monad m =>
record -> [Prop m field record] -> m ()
setProp

-- | @setRecord record props@ changes @record@ value using @props@ properties.
setProp :: (Monad m) => record -> [Prop m field record] -> m ()
setProp :: record -> [Prop m field record] -> m ()
setProp record
record = (Prop m field record -> m ()) -> [Prop m field record] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Prop m field record -> m ()) -> [Prop m field record] -> m ())
-> (Prop m field record -> m ()) -> [Prop m field record] -> m ()
forall a b. (a -> b) -> a -> b
$ \ Prop m field record
prop -> case Prop m field record
prop of
  Incr    field m record a
field   -> field m record a -> record -> m ()
forall (field :: (* -> *) -> * -> * -> *) a (m :: * -> *) record.
(SwitchProp field a, Monad m) =>
field m record a -> record -> m ()
incRecord    field m record a
field record
record
  Decr    field m record a
field   -> field m record a -> record -> m ()
forall (field :: (* -> *) -> * -> * -> *) a (m :: * -> *) record.
(SwitchProp field a, Monad m) =>
field m record a -> record -> m ()
decRecord    field m record a
field record
record
  Switch  field m record a
field Int
n -> 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 field m record a
field record
record Int
n
  
  field m record a
field ::=   record -> a
upd -> 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 field m record a
field record
record (record -> a
upd record
record)
  field m record a
field :=    a
val -> 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 field m record a
field record
record a
val
  field m record a
field ::~   record -> a -> a
upd -> m a -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m a -> m ()) -> m a -> m ()
forall a b. (a -> b) -> a -> b
$ 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
field record
record (record -> a -> a
upd record
record)
  field m record a
field :~    a -> a
upd -> m a -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m a -> m ()) -> m a -> m ()
forall a b. (a -> b) -> a -> b
$ 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
field record
record a -> a
upd
  
  field m record (many a)
field :=+   a
val -> m (many a) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (many a) -> m ()) -> m (many a) -> m ()
forall a b. (a -> b) -> a -> b
$ 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
val field m record (many a)
field record
record
  a
val   :+= field m record (many a)
field -> m (many a) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (many a) -> m ()) -> m (many a) -> m ()
forall a b. (a -> b) -> a -> b
$ 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
val field m record (many a)
field record
record
  field m record (many a)
field :~=   a
val -> m (many a) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (many a) -> m ()) -> m (many a) -> m ()
forall a b. (a -> b) -> a -> b
$ 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
val field m record (many a)
field record
record

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

-- | Property getter.
class GetProp field record
  where
    -- | @'getRecord' field record@ return @record@'s value using @field@.
    getRecord :: (Monad m) => field m record a -> record -> m a

-- | Property setter.
class SetProp field record
  where
    -- | @'setRecord' field record value@ sets new @record@ @value@.
    setRecord :: (Monad m) => field m record a -> record -> a -> m ()

-- | Property modifier.
class ModifyProp field record
  where
    -- | @'modifyRecord' field record upd@ modifies @record@ @field@ using @upd@.
    default modifyRecord :: (Monad m, GetProp field record, SetProp field record) =>
      field m record a -> record -> (a -> a) -> m a
    modifyRecord :: (Monad m) => field m record a -> record -> (a -> a) -> m a
    modifyRecord field m record a
field record
record a -> a
f = do
      a
old <- field m record a -> record -> m a
forall (m :: * -> *) (field :: (* -> *) -> * -> * -> *) record a.
(Monad m, GetProp field record) =>
field m record a -> record -> m a
get field m record a
field record
record
      let new :: a
new = a -> a
f a
old
      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 field m record a
field record
record a
new
      a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
new

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

-- | Switch property modifier.
class SwitchProp field a
  where
    -- | Generalized increment, same as @switchRecord@.
    incRecord :: (Monad m) => field m record a -> record -> m ()
    
    -- | Generalized decrement.
    decRecord :: (Monad m) => field m record a -> record -> m ()
    
    {- |
      Increment/decrement many times.
      
      > decRecord field record = switchRecord field record (-1)
      > incRecord field record = switchRecord field record 1
    -}
    switchRecord :: (Monad m) => field m record a -> record -> Int -> m ()

-- | Prepend/append modifier.
class InsertProp field record many
  where
    -- | Prepends new element to existing value.
    prependRecord :: (Monad m) => a -> field m record (many a) -> record -> m (many a)
    
    -- | Appends new element to existing value.
    appendRecord :: (Monad m) => a -> field m record (many a) -> record -> m (many a)

-- | Delete modifier.
class DeleteProp field record many
  where
    -- | Delete element from value (if any).
    deleteRecord :: (Monad m, Eq a) => a -> field m record (many a) -> record -> m (many a)