{-# LANGUAGE UndecidableSuperClasses, MultiParamTypeClasses, FlexibleInstances #-}
{-# LANGUAGE Trustworthy, TypeFamilies, FlexibleContexts, PatternSynonyms #-}

{- |
    License     :  BSD-style
    Module      :  Data.Field
    Copyright   :  (c) Andrey Mulik 2020-2021
    Maintainer  :  work.a.mulik@gmail.com
    
    @Data.Field@ provides immutable field type for record-style operations.
-}
module Data.Field
(
  -- * Field
  Field (..), sfield,
  GetterFor, SetterFor, ModifierFor, ModifierMFor,
  
  -- * IsMVar and MonadVar
  IsMVar (..), MonadVar (..)
)
where

import Prelude hiding ( (.), id )
import Data.Property
import Data.Typeable
import Data.Functor
import Data.IORef
import Data.STRef
import Data.Kind

import GHC.Conc

import Control.Concurrent.MVar
import Control.Category
import Control.Monad.ST
import Control.Monad

default ()

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

{- |
  Normal field, which contain getter, setter and modifier.
  
  Since @fmr-0.2@, you can also combine fmr fields using @('.')@ and @'id'@ from
  the 'Category' class:
  
  @
    outer :: (Monad m) => Field m outer inner
    inner :: (Monad m) => Field m inner value
    
    field :: (Monad m) => Field m outer value
    field =  outer.inner
  @
-}
data Field m record a = Field
  {
    -- | Field getter
    Field m record a -> GetterFor m record a
getField :: !(GetterFor m record a),
    -- | Field setter
    Field m record a -> SetterFor m record a
setField :: !(SetterFor m record a),
    -- | Field modifier
    Field m record a -> ModifierFor m record a
modifyField :: !(ModifierFor m record a),
    -- | Monadic field modifier
    Field m record a -> ModifierMFor m record a
modifyFieldM :: !(ModifierMFor m record a)
  } deriving ( Typeable )

-- | Getter type.
type GetterFor m record a = record -> m a

-- | Setter type.
type SetterFor m record a = record -> a -> m ()

-- | Modifier type.
type ModifierFor  m record a = record -> (a -> a) -> m a

-- | Monadic modifier type.
type ModifierMFor m record a = record -> (a -> m a) -> m a

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

-- | 'sfield' creates new field from given getter and setter.
sfield :: (Monad m) => GetterFor m record a -> SetterFor m record a -> Field m record a
sfield :: GetterFor m record a -> SetterFor m record a -> Field m record a
sfield GetterFor m record a
g SetterFor m record a
s = GetterFor m record a
-> SetterFor m record a
-> ModifierFor m record a
-> ModifierMFor m record a
-> Field m record a
forall (m :: * -> *) record a.
GetterFor m record a
-> SetterFor m record a
-> ModifierFor m record a
-> ModifierMFor m record a
-> Field m record a
Field GetterFor m record a
g SetterFor m record a
s (\ record
record  a -> a
f -> do a
res <-  a -> a
f (a -> a) -> m a -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetterFor m record a
g record
record; SetterFor m record a
s record
record a
res; a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res)
                       (\ record
record a -> m a
go -> do a
res <- a -> m a
go (a -> m a) -> m a -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GetterFor m record a
g record
record; SetterFor m record a
s record
record a
res; a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res)

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

instance (Monad m) => Category (Field m)
  where
    Field GetterFor m b c
g1 SetterFor m b c
s1 ModifierFor m b c
m1 ModifierMFor m b c
mm1 . :: Field m b c -> Field m a b -> Field m a c
. Field GetterFor m a b
g2 SetterFor m a b
_ ModifierFor m a b
_ ModifierMFor m a b
_ = GetterFor m a c
-> SetterFor m a c
-> ModifierFor m a c
-> ModifierMFor m a c
-> Field m a c
forall (m :: * -> *) record a.
GetterFor m record a
-> SetterFor m record a
-> ModifierFor m record a
-> ModifierMFor m record a
-> Field m record a
Field (GetterFor m b c
g1 GetterFor m b c -> GetterFor m a b -> GetterFor m a c
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< GetterFor m a b
g2) SetterFor m a c
s3 ModifierFor m a c
m3 ModifierMFor m a c
mm3
      where
        mm3 :: ModifierMFor m a c
mm3 a
record   c -> m c
go  = ModifierMFor m b c -> (c -> m c) -> GetterFor m b c
forall a b c. (a -> b -> c) -> b -> a -> c
flip ModifierMFor m b c
mm1  c -> m c
go  GetterFor m b c -> m b -> m c
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GetterFor m a b
g2 a
record
        m3 :: ModifierFor m a c
m3  a
record   c -> c
f   = ModifierFor m b c -> (c -> c) -> GetterFor m b c
forall a b c. (a -> b -> c) -> b -> a -> c
flip ModifierFor m b c
m1   c -> c
f   GetterFor m b c -> m b -> m c
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GetterFor m a b
g2 a
record
        s3 :: SetterFor m a c
s3  a
record c
value = SetterFor m b c -> c -> b -> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip SetterFor m b c
s1 c
value (b -> m ()) -> m b -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GetterFor m a b
g2 a
record
    
    id :: Field m a a
id = GetterFor m a a
-> SetterFor m a a
-> ModifierFor m a a
-> ModifierMFor m a a
-> Field m a a
forall (m :: * -> *) record a.
GetterFor m record a
-> SetterFor m record a
-> ModifierFor m record a
-> ModifierMFor m record a
-> Field m record a
Field GetterFor m a a
forall (m :: * -> *) a. Monad m => a -> m a
return (\ a
_ a
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (\ a
x a -> a
f -> GetterFor m a a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> a
f a
x)) ((GetterFor m a a -> GetterFor m a a) -> ModifierMFor m a a
forall a b c. (a -> b -> c) -> b -> a -> c
flip GetterFor m a a -> GetterFor m a a
forall a b. (a -> b) -> a -> b
($))

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

instance FieldGet    Field 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 -> GetterFor m record a
getField
instance FieldSet    Field 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 -> SetterFor m record a
setField
instance FieldModify Field 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 -> ModifierFor m record a
modifyField
instance FieldSwitch Field
  where
    switchRecord :: Field m record a -> record -> Int -> m ()
switchRecord Field m record a
field record
record = m a -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m a -> m ()) -> (Int -> m a) -> Int -> m ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      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 Field m record a
field record
record ((a -> a) -> m a) -> (Int -> a -> a) -> Int -> m a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> a -> a
forall switch. IsSwitch switch => Int -> switch -> switch
toggle

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

{- |
  The 'IsMVar' class provides 'this' field for entire record access.
  
  Please note that you cannot create 'IsMVar' and 'MonadVar' instances for some
  monad separately.
-}
class (Monad m, MonadVar m) => IsMVar m var
  where
    -- | 'this' is common variable access field.
    this :: Field m (var a) a
    
    -- | Create and initialize new mutable variable.
    var :: a -> m (var a)

instance IsMVar (ST s) (STRef s)
  where
    var :: a -> ST s (STRef s a)
var  = a -> ST s (STRef s a)
forall a s. a -> ST s (STRef s a)
newSTRef
    this :: Field (ST s) (STRef s a) a
this = GetterFor (ST s) (STRef s a) a
-> SetterFor (ST s) (STRef s a) a
-> ModifierFor (ST s) (STRef s a) a
-> ModifierMFor (ST s) (STRef s a) a
-> Field (ST s) (STRef s a) a
forall (m :: * -> *) record a.
GetterFor m record a
-> SetterFor m record a
-> ModifierFor m record a
-> ModifierMFor m record a
-> Field m record a
Field GetterFor (ST s) (STRef s a) a
forall s a. STRef s a -> ST s a
readSTRef SetterFor (ST s) (STRef s a) a
forall s a. STRef s a -> a -> ST s ()
writeSTRef ModifierFor (ST s) (STRef s a) a
forall s b. STRef s b -> (b -> b) -> ST s b
modify' ModifierMFor (ST s) (STRef s a) a
forall s b. STRef s b -> (b -> ST s b) -> ST s b
modifyM'
      where
        modifyM' :: STRef s b -> (b -> ST s b) -> ST s b
modifyM' STRef s b
ref b -> ST s b
f = do b
res <- b -> ST s b
f (b -> ST s b) -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< STRef s b -> ST s b
forall s a. STRef s a -> ST s a
readSTRef STRef s b
ref; b
res b -> ST s () -> ST s b
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ STRef s b -> b -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s b
ref b
res
        modify' :: STRef s b -> (b -> b) -> ST s b
modify'  STRef s b
ref b -> b
f = do b
res <- b -> b
f (b -> b) -> ST s b -> ST s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STRef s b -> ST s b
forall s a. STRef s a -> ST s a
readSTRef STRef s b
ref; b
res b -> ST s () -> ST s b
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ STRef s b -> b -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s b
ref b
res

instance IsMVar IO IORef
  where
    var :: a -> IO (IORef a)
var  = a -> IO (IORef a)
forall a. a -> IO (IORef a)
newIORef
    this :: Field IO (IORef a) a
this = GetterFor IO (IORef a) a
-> SetterFor IO (IORef a) a
-> ModifierFor IO (IORef a) a
-> ModifierMFor IO (IORef a) a
-> Field IO (IORef a) a
forall (m :: * -> *) record a.
GetterFor m record a
-> SetterFor m record a
-> ModifierFor m record a
-> ModifierMFor m record a
-> Field m record a
Field GetterFor IO (IORef a) a
forall a. IORef a -> IO a
readIORef SetterFor IO (IORef a) a
forall a. IORef a -> a -> IO ()
writeIORef ModifierFor IO (IORef a) a
forall b. IORef b -> (b -> b) -> IO b
modify' ModifierMFor IO (IORef a) a
forall b. IORef b -> (b -> IO b) -> IO b
modifyM'
      where
        modifyM' :: IORef b -> (b -> IO b) -> IO b
modifyM' IORef b
ref b -> IO b
f = do b
val <- b -> IO b
f (b -> IO b) -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef b -> IO b
forall a. IORef a -> IO a
readIORef IORef b
ref; IORef b -> b -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef b
ref b
val; b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return b
val
        modify' :: IORef b -> (b -> b) -> IO b
modify'  IORef b
ref b -> b
f = IORef b -> (b -> (b, b)) -> IO b
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef b
ref (\ b
a -> let b :: b
b = b -> b
f b
a in (b
b, b
b))

instance IsMVar IO MVar
  where
    var :: a -> IO (MVar a)
var  = a -> IO (MVar a)
forall a. a -> IO (MVar a)
newMVar
    this :: Field IO (MVar a) a
this = GetterFor IO (MVar a) a
-> SetterFor IO (MVar a) a
-> ModifierFor IO (MVar a) a
-> ModifierMFor IO (MVar a) a
-> Field IO (MVar a) a
forall (m :: * -> *) record a.
GetterFor m record a
-> SetterFor m record a
-> ModifierFor m record a
-> ModifierMFor m record a
-> Field m record a
Field GetterFor IO (MVar a) a
forall a. MVar a -> IO a
readMVar SetterFor IO (MVar a) a
forall a. MVar a -> a -> IO ()
putMVar ModifierFor IO (MVar a) a
forall b. MVar b -> (b -> b) -> IO b
modify' ModifierMFor IO (MVar a) a
forall b. MVar b -> (b -> IO b) -> IO b
modifyM'
      where
        modifyM' :: MVar b -> (b -> IO b) -> IO b
modifyM' MVar b
mvar b -> IO b
f = MVar b
mvar MVar b -> (b -> IO (b, b)) -> IO b
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
`modifyMVarMasked` \ b
a -> do b
b <- b -> IO b
f b
a; (b, b) -> IO (b, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, b
b)
        modify' :: MVar b -> (b -> b) -> IO b
modify'  MVar b
mvar b -> b
f = MVar b
mvar MVar b -> (b -> IO (b, b)) -> IO b
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
`modifyMVar` \ b
a -> let b :: b
b = b -> b
f b
a in (b, b) -> IO (b, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, b
b)

instance IsMVar STM TVar
  where
    var :: a -> STM (TVar a)
var  = a -> STM (TVar a)
forall a. a -> STM (TVar a)
newTVar
    this :: Field STM (TVar a) a
this = GetterFor STM (TVar a) a
-> SetterFor STM (TVar a) a
-> ModifierFor STM (TVar a) a
-> ModifierMFor STM (TVar a) a
-> Field STM (TVar a) a
forall (m :: * -> *) record a.
GetterFor m record a
-> SetterFor m record a
-> ModifierFor m record a
-> ModifierMFor m record a
-> Field m record a
Field GetterFor STM (TVar a) a
forall a. TVar a -> STM a
readTVar SetterFor STM (TVar a) a
forall a. TVar a -> a -> STM ()
writeTVar ModifierFor STM (TVar a) a
forall b. TVar b -> (b -> b) -> STM b
modifyTVar ModifierMFor STM (TVar a) a
forall b. TVar b -> (b -> STM b) -> STM b
modifyMTVar
      where
        modifyMTVar :: TVar b -> (b -> STM b) -> STM b
modifyMTVar TVar b
tvar b -> STM b
f = do b
res <- b -> STM b
f (b -> STM b) -> STM b -> STM b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TVar b -> STM b
forall a. TVar a -> STM a
readTVar TVar b
tvar; b
res b -> STM () -> STM b
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ TVar b -> b -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar b
tvar b
res
        modifyTVar :: TVar b -> (b -> b) -> STM b
modifyTVar  TVar b
tvar b -> b
f = do b
res <- b -> b
f (b -> b) -> STM b -> STM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar b -> STM b
forall a. TVar a -> STM a
readTVar TVar b
tvar; b
res b -> STM () -> STM b
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ TVar b -> b -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar b
tvar b
res

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

{- |
  'MonadVar' is a class of monads for which defined at least one type of mutable
  variable.
  
  Note that a variable of type @(Var m)@ should be as simple possible for a
  given monad. I only has to implement the basic operations triad: read,
  write and update (which don't have to be atomic).
-}
class (Monad m, IsMVar m (Var m)) => MonadVar m
  where
    -- | @('Var' m)@ is type of mutable variable in monad @m@.
    type Var m :: Type -> Type

instance MonadVar (ST s) where type Var (ST s) = STRef s
instance MonadVar IO     where type Var IO     = IORef
instance MonadVar STM    where type Var STM    = TVar