{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances #-}
{-# LANGUAGE Safe, GADTs, DefaultSignatures, KindSignatures, DataKinds, CPP #-}
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}

-- For [ghc-8.0 .. ghc-8.4) support.
#if __GLASGOW_HASKELL__ < 840
{-# LANGUAGE TypeInType #-}
#endif

{- |
    License     :  BSD-style
    Module      :  Data.Property
    Copyright   :  (c) Andrey Mulik 2020
    Maintainer  :  work.a.mulik@gmail.com
    
    @Data.Property@ new-style properties.
-}
module Data.Property
(
  -- * Generalized properties
  IsProp (..), PropertyKind, FieldKind, Prop (..),
  
  -- ** Basic properties
  FieldGet (..), get, gets',
  FieldSet (..), set, sets',
  
  -- *** Set properties
  pattern (:=), pattern (::=), pattern (:=$), pattern (::=$),
  
  -- *** Monadic set properties
  pattern (:<=), pattern (:<=$), pattern (:=<), pattern (:=<$),
  
  -- ** Modify properties
  FieldModify (..),
  
  -- *** Modify properties
  pattern (:~), pattern (:~$), pattern (::~), pattern (::~$),
  
  -- *** Monadic modify properties
  pattern (:<~), pattern (:<~$), pattern (:~<), pattern (:~<$),
  
  -- ** Switch properties
  IsSwitch (..), FieldSwitch (..), switch, incr, decr
)
where

import Data.Typeable
import Data.Kind

import Control.Monad

default ()

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

{- Generalized property. -}

{- |
  @since 0.2
  'Prop' is new, generalized and extensible property type (existential), which
  may contain any 'IsProp' value.
-}
data Prop m field record
  where
    Prop :: (Monad m, IsProp prop) => prop m field record -> Prop m field record
  deriving ( Typeable )

{- |
  @since 0.2
  'IsProp' is a property class that allows you to extend @fmr@ syntax. Now you
  can create new property types and use it with existing in 'set' list of
  actions.
-}
class IsProp (prop :: PropertyKind)
  where
    -- | @performProp record prop @ performs an action on @record@ using @prop@.
    performProp :: (Monad m) => record -> prop m field record -> m ()

instance IsProp SetProp
  where
    performProp :: record -> SetProp m field record -> m ()
performProp record
record (SetRecordPropM [field m record a]
field   record -> m a
kl) = [field m record a] -> record -> a -> m ()
forall (m :: * -> *) (field :: FieldKind) record a.
(Monad m, FieldSet field) =>
[field m record a] -> record -> a -> m ()
setRecords [field m record a]
field record
record (a -> m ()) -> m a -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< record -> m a
kl record
record
    performProp record
record (SetRecordProp  [field m record a]
field    record -> a
f) = [field m record a] -> record -> a -> m ()
forall (m :: * -> *) (field :: FieldKind) record a.
(Monad m, FieldSet field) =>
[field m record a] -> record -> a -> m ()
setRecords [field m record a]
field record
record (record -> a
f record
record)
    performProp record
record (SetPropM       [field m record a]
field m a
mval) = [field m record a] -> record -> a -> m ()
forall (m :: * -> *) (field :: FieldKind) record a.
(Monad m, FieldSet field) =>
[field m record a] -> record -> a -> m ()
setRecords [field m record a]
field record
record (a -> m ()) -> m a -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m a
mval
    performProp record
record (SetProp        [field m record a]
field  a
val) = [field m record a] -> record -> a -> m ()
forall (m :: * -> *) (field :: FieldKind) record a.
(Monad m, FieldSet field) =>
[field m record a] -> record -> a -> m ()
setRecords [field m record a]
field record
record a
val

setRecords :: (Monad m, FieldSet field) => [field m record a] -> record -> a -> m ()
setRecords :: [field m record a] -> record -> a -> m ()
setRecords [field m record a]
fields record
record a
val = [field m record a] -> (field m record a -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [field m record a]
fields ((field m record a -> m ()) -> m ())
-> (field m record a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \ field m record a
field -> field m record a -> record -> a -> m ()
forall (field :: FieldKind) (m :: * -> *) record a.
(FieldSet field, Monad m) =>
field m record a -> record -> a -> m ()
setRecord field m record a
field record
record a
val

instance IsProp ModifyProp
  where
    performProp :: record -> ModifyProp m field record -> m ()
performProp record
record (Modify      [field m record a]
field record -> a -> a
f) = () () -> m () -> m ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [field m record a] -> record -> (a -> a) -> m ()
forall (m :: * -> *) (field :: FieldKind) record b.
(Monad m, FieldModify field) =>
[field m record b] -> record -> (b -> b) -> m ()
modifyRecords  [field m record a]
field record
record (record -> a -> a
f record
record)
    performProp record
record (ModifyM     [field m record a]
field record -> a -> m a
f) = () () -> m () -> m ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [field m record a] -> record -> (a -> m a) -> m ()
forall (m :: * -> *) (field :: FieldKind) record b.
(Monad m, FieldModify field, FieldGet field) =>
[field m record b] -> record -> (b -> m b) -> m ()
modifyRecordsM [field m record a]
field record
record (record -> a -> m a
f record
record)
    performProp record
record (ModifyProp  [field m record a]
field a -> a
f) = () () -> m () -> m ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [field m record a] -> record -> (a -> a) -> m ()
forall (m :: * -> *) (field :: FieldKind) record b.
(Monad m, FieldModify field) =>
[field m record b] -> record -> (b -> b) -> m ()
modifyRecords  [field m record a]
field record
record a -> a
f
    performProp record
record (ModifyPropM [field m record a]
field a -> m a
f) = () () -> m () -> m ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [field m record a] -> record -> (a -> m a) -> m ()
forall (m :: * -> *) (field :: FieldKind) record b.
(Monad m, FieldModify field, FieldGet field) =>
[field m record b] -> record -> (b -> m b) -> m ()
modifyRecordsM [field m record a]
field record
record a -> m a
f

modifyRecords :: (Monad m, FieldModify field) =>
  [field m record b] -> record -> (b -> b) -> m ()
modifyRecords :: [field m record b] -> record -> (b -> b) -> m ()
modifyRecords [field m record b]
fields record
record b -> b
f = [field m record b]
fields [field m record b] -> (field m record b -> m b) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
`forM_` \ field m record b
field -> field m record b -> record -> (b -> b) -> m b
forall (field :: FieldKind) (m :: * -> *) record a.
(FieldModify field, Monad m) =>
field m record a -> record -> (a -> a) -> m a
modifyRecord field m record b
field record
record b -> b
f

modifyRecordsM :: (Monad m, FieldModify field, FieldGet field) =>
  [field m record b] -> record -> (b -> m b) -> m ()
modifyRecordsM :: [field m record b] -> record -> (b -> m b) -> m ()
modifyRecordsM [field m record b]
fields record
record b -> m b
f = [field m record b]
fields [field m record b] -> (field m record b -> m b) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
`forM_` \ field m record b
field -> field m record b -> record -> (b -> m b) -> m b
forall (field :: FieldKind) (m :: * -> *) record a.
(FieldModify field, Monad m, FieldGet field) =>
field m record a -> record -> (a -> m a) -> m a
modifyRecordM field m record b
field record
record b -> m b
f

instance IsProp SwitchProp
  where
    performProp :: record -> SwitchProp m field record -> m ()
performProp record
record (SwitchProp Int
n field m record a
field) = field m record a -> record -> Int -> m ()
forall (field :: FieldKind) (m :: * -> *) a record.
(FieldSwitch field, Monad m, IsSwitch a) =>
field m record a -> record -> Int -> m ()
switchRecord field m record a
field record
record Int
n

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

-- | @since 0.2 Service kind synonym.
type FieldKind = (Type -> Type) -> Type -> Type -> Type

-- | @since 0.2 Service kind synonym.
type PropertyKind = (Type -> Type) -> FieldKind -> Type -> Type

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

{- fmr classes. -}

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

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

{- |
  @since 0.2
  Property modifier class.
  
  Note that 'FieldModifier' doesn't go well with write-only fields, because
  'modifyRecord' returns new value, and 'modifyRecordM' also assumes the
  possibility of old value \"leaking\" (hence the 'FieldGet' constraint is
  imposed on it).
-}
class (FieldSet field) => FieldModify field
  where
    {- |
      @'modifyRecord' field record upd@ modifies @record@ @field@ using @upd@.
      Returns new value.
    -}
    default modifyRecord :: (Monad m, FieldGet field) =>
      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
val <- a -> a
f (a -> a) -> m a -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> field m record a -> record -> m a
forall (m :: * -> *) (field :: FieldKind) record a.
(Monad m, FieldGet field) =>
field m record a -> record -> m a
get field m record a
field record
record
      field m record a -> record -> a -> m ()
forall (field :: FieldKind) (m :: * -> *) record a.
(FieldSet field, Monad m) =>
field m record a -> record -> a -> m ()
setRecord field m record a
field record
record a
val
      a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
val
    
    {- |
      @'modifyRecordM' field record upd@ modifies @record@ @field@ using @upd@.
      Note that assumes the possibility of old value \"leaking\", e.g.:
      
      @
        -- get value using 'modifyRecordM'
        getLeak = do
          -- Some read-only fields
          x <- newWriteOnly
          y <- 'var' Nothing
          -- write current value to y and do not modify.
          modifyRecordM this x (\ val -> do set [this := Just val]; return val)
          -- leaking: return current value of "write-only" record
          get this y
      @
      
      So you cannot use it for write-only fields.
    -}
    modifyRecordM :: (Monad m, FieldGet field) =>
      field m record a -> record -> (a -> m a) -> m a
    modifyRecordM field m record a
field record
record a -> m a
f = do
      a
val <- a -> m a
f (a -> m a) -> m a -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< field m record a -> record -> m a
forall (m :: * -> *) (field :: FieldKind) record a.
(Monad m, FieldGet field) =>
field m record a -> record -> m a
get field m record a
field record
record
      field m record a -> record -> a -> m ()
forall (field :: FieldKind) (m :: * -> *) record a.
(FieldSet field, Monad m) =>
field m record a -> record -> a -> m ()
setRecord field m record a
field record
record a
val
      a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
val

{- |
  Switch property modifier.
  
  Note that 'FieldSwitch' is designed for deterministic switches with a
  pre-known set of states and order of transitions between them, without
  branches. If you need more complex behavior, use 'FieldModify'.
-}
class FieldSwitch field
  where
    -- | Repeated increment or decrement.
    switchRecord :: (Monad m, IsSwitch a) => field m record a -> record -> Int -> m ()

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

{- fmr properties. -}

{- |
  @since 0.2
  'SetProp' is a service type used to set field values.
  See @(':=')@, @(':=$')@, @('::=')@, @('::=$')@, @(':<=')@, @(':<=$')@,
  @(':=<')@ and @(':=<$')@ patterns.
-}
data SetProp m field record
  where
    -- | 'SetProp' corresponds to @(':=$')@ and @(':=')@.
    SetProp :: (FieldSet field) =>
      [field m record a] -> a -> SetProp m field record
    
    -- | 'SetPropM' corresponds to @('::=$')@ and @('::=')@.
    SetPropM :: (FieldSet field) =>
      [field m record a] -> m a -> SetProp m field record
    
    -- | 'SetRecordProp' corresponds to @(':<=$')@ and @(':<=')@.
    SetRecordProp :: (FieldSet field) =>
      [field m record a] -> (record -> a) -> SetProp m field record
    
    -- | 'SetRecordPropM' corresponds to @(':=<$')@ and @(':=<')@.
    SetRecordPropM :: (FieldSet field) =>
      [field m record a] -> (record -> m a) -> SetProp m field record
  deriving ( Typeable )

{- |
  @since 0.2
  'ModifyProp' is a service type used to modify field values.
  See @(':~')@, @(':~$')@, @(':<~')@, @(':<~$')@, @('::~')@, @('::~$')@,
  @(':~<')@, @(':~<$')@ patterns.
-}
data ModifyProp m field record
  where
    -- | 'FieldModify' constructor corresponds to @(':~$')@ and @(':~')@.
    ModifyProp :: (FieldModify field) =>
      [field m record a] -> (a -> a) -> ModifyProp m field record
    
    -- | 'FieldModify' constructor corresponds to @(':<~$')@ and @(':<~')@.
    ModifyPropM :: (FieldModify field, FieldGet field) =>
      [field m record a] -> (a -> m a) -> ModifyProp m field record
    
    -- | 'Modify' constructor corresponds to @('::~$')@ and @('::~')@.
    Modify :: (FieldModify field) =>
      [field m record a] -> (record -> a -> a) -> ModifyProp m field record
    
    -- | 'ModifyM' constructor corresponds to @(':~<$')@ and @(':~<')@.
    ModifyM :: (FieldModify field, FieldGet field) =>
      [field m record a] -> (record -> a -> m a) -> ModifyProp m field record
  deriving ( Typeable )

{- |
  @since 0.2
  'SwitchProp' is a service type used to update record values, see 'switch',
  'incr' and 'decr'.
-}
data SwitchProp m field record
  where
    -- | Switch field, see 'switch', 'incr' and 'decr'.
    SwitchProp :: (Monad m, FieldSwitch field, IsSwitch a) =>
      Int -> field m record a -> SwitchProp m field record
  deriving ( Typeable )

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

{- fmr pure setters. -}

{- |
  Pure value setter. @set record [field := value]@ set @value@ to @record@'s
  @field@.
-}
pattern (:=) ::
  (
    Typeable m, Typeable field, Typeable record,
    Monad m, FieldSet field
  ) => field m record a -> a -> Prop m field record
pattern field $b:= :: field m record a -> a -> Prop m field record
$m:= :: forall r (m :: * -> *) (field :: FieldKind) record.
(Typeable m, Typeable field, Typeable record, Monad m,
 FieldSet field) =>
Prop m field record
-> (forall a. field m record a -> a -> r) -> (Void# -> r) -> r
:= val = [field] :=$ val

{- |
  Pure value setter with @record@. @set record [field ::= f]@ set @f record@ to
  @record@'s @field@.
  
  @
    set record [field ::= const val] === set record [field := val]
  @
-}
pattern (::=) ::
  (
    Typeable m, Typeable field, Typeable record,
    Monad m, FieldSet field
  ) => field m record a -> (record -> a) -> Prop m field record
pattern field $b::= :: field m record a -> (record -> a) -> Prop m field record
$m::= :: forall r (m :: * -> *) (field :: FieldKind) record.
(Typeable m, Typeable field, Typeable record, Monad m,
 FieldSet field) =>
Prop m field record
-> (forall a. field m record a -> (record -> a) -> r)
-> (Void# -> r)
-> r
::= f = [field] ::=$ f

{- |
  @since 0.2
  Pure group setter. @set record [fields :=$ value]@ set @value@ to @record@'s
  some @fields@.
  
  @
    set record [[field] :=$ value] === set record [field := value]
  @
-}
pattern (:=$) ::
  (
    Typeable m, Typeable field, Typeable record,
    Monad m, FieldSet field
  ) => [field m record a] -> a -> Prop m field record
pattern field $b:=$ :: [field m record a] -> a -> Prop m field record
$m:=$ :: forall r (m :: * -> *) (field :: FieldKind) record.
(Typeable m, Typeable field, Typeable record, Monad m,
 FieldSet field) =>
Prop m field record
-> (forall a. [field m record a] -> a -> r) -> (Void# -> r) -> r
:=$ val <- (cast -> Just (SetProp field val))
  where
    (:=$) = SetProp m field record -> Prop m field record
forall (m :: * -> *) (prop :: PropertyKind) (field :: FieldKind)
       record.
(Monad m, IsProp prop) =>
prop m field record -> Prop m field record
Prop (SetProp m field record -> Prop m field record)
-> ([field m record a] -> a -> SetProp m field record)
-> [field m record a]
-> a
-> Prop m field record
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... [field m record a] -> a -> SetProp m field record
forall (field :: FieldKind) (m :: * -> *) record a.
FieldSet field =>
[field m record a] -> a -> SetProp m field record
SetProp

{- |
  @since 0.2
  Pure group setter with @record@. @set record [fields ::=$ f]@ set @f record@
  to @record@'s some @fields@.
  
  @
    set record [[field] ::=$ f] === set record [field ::= f]
    set record [fields ::=$ const val] === set record [fields :=$ val]
  @
-}
pattern (::=$) ::
  (
    Typeable m, Typeable field, Typeable record, Monad m, FieldSet field
  ) => [field m record a] -> (record -> a) -> Prop m field record
pattern field $b::=$ :: [field m record a] -> (record -> a) -> Prop m field record
$m::=$ :: forall r (m :: * -> *) (field :: FieldKind) record.
(Typeable m, Typeable field, Typeable record, Monad m,
 FieldSet field) =>
Prop m field record
-> (forall a. [field m record a] -> (record -> a) -> r)
-> (Void# -> r)
-> r
::=$ f <- (cast -> Just (SetRecordProp field f))
  where
    (::=$) = SetProp m field record -> Prop m field record
forall (m :: * -> *) (prop :: PropertyKind) (field :: FieldKind)
       record.
(Monad m, IsProp prop) =>
prop m field record -> Prop m field record
Prop (SetProp m field record -> Prop m field record)
-> ([field m record a] -> (record -> a) -> SetProp m field record)
-> [field m record a]
-> (record -> a)
-> Prop m field record
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... [field m record a] -> (record -> a) -> SetProp m field record
forall (field :: FieldKind) (m :: * -> *) record a.
FieldSet field =>
[field m record a] -> (record -> a) -> SetProp m field record
SetRecordProp

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

{- fmr pure updaters. -}

{- |
  Pure value modifier. @set record [field :~ f]@ modify value of @record@'s
  @field@ using @f@ function.
  
  @
    set record [field :~ const val] === set record [field := val]
  @
-}
pattern (:~) ::
  (
    Typeable m, Typeable field, Typeable record,
    Monad m, FieldModify field
  ) => field m record a -> (a -> a) -> Prop m field record
pattern field $b:~ :: field m record a -> (a -> a) -> Prop m field record
$m:~ :: forall r (m :: * -> *) (field :: FieldKind) record.
(Typeable m, Typeable field, Typeable record, Monad m,
 FieldModify field) =>
Prop m field record
-> (forall a. field m record a -> (a -> a) -> r)
-> (Void# -> r)
-> r
:~ f = [field] :~$ f

{- |
  Pure value modifier with @record@. @set record [field ::~ f]@ modify value of
  @record@'s @field@ using @f record@ function.
  
  @
    set record [field ::~ const f] === set record [field :~ f]
  @
-}
pattern (::~) ::
  (
    Typeable m, Typeable field, Typeable record,
    Monad m, FieldModify field
  ) => field m record a -> (record -> a -> a) -> Prop m field record
pattern field $b::~ :: field m record a -> (record -> a -> a) -> Prop m field record
$m::~ :: forall r (m :: * -> *) (field :: FieldKind) record.
(Typeable m, Typeable field, Typeable record, Monad m,
 FieldModify field) =>
Prop m field record
-> (forall a. field m record a -> (record -> a -> a) -> r)
-> (Void# -> r)
-> r
::~ f = [field] ::~$ f

{- |
  @since 0.2
  Pure group modifier. @set record [fields :~$ f]@ modify values of @record@'s
  @fields@ using @f@ function.
  
  @
    set record [[field] :~$ val] === set record [field :~ val]
    set record [fields :~$ const val] === set record [field :=$ val]
  @
-}
pattern (:~$) ::
  (
    Typeable m, Typeable field, Typeable record,
    Monad m, FieldModify field
  ) => [field m record a] -> (a -> a) -> Prop m field record
pattern field $b:~$ :: [field m record a] -> (a -> a) -> Prop m field record
$m:~$ :: forall r (m :: * -> *) (field :: FieldKind) record.
(Typeable m, Typeable field, Typeable record, Monad m,
 FieldModify field) =>
Prop m field record
-> (forall a. [field m record a] -> (a -> a) -> r)
-> (Void# -> r)
-> r
:~$ f <- (cast -> Just (ModifyProp field f))
  where
    (:~$) = ModifyProp m field record -> Prop m field record
forall (m :: * -> *) (prop :: PropertyKind) (field :: FieldKind)
       record.
(Monad m, IsProp prop) =>
prop m field record -> Prop m field record
Prop (ModifyProp m field record -> Prop m field record)
-> ([field m record a] -> (a -> a) -> ModifyProp m field record)
-> [field m record a]
-> (a -> a)
-> Prop m field record
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... [field m record a] -> (a -> a) -> ModifyProp m field record
forall (field :: FieldKind) (m :: * -> *) record a.
FieldModify field =>
[field m record a] -> (a -> a) -> ModifyProp m field record
ModifyProp

{- |
  @since 0.2
  Pure group modifier with @record@.
  @set record [fields ::~$ f]@ modify values of @record@'s @fields@ using
  @f record@ function.
  
  @
    set record [[field] ::~$ f] === set record [field ::~ f]
    set record [fields ::~$ const f] === set record [field :~$ f]
  @
-}
pattern (::~$) ::
  (
    Typeable m, Typeable field, Typeable record,
    Monad m, FieldModify field
  ) => [field m record a] -> (record -> a -> a) -> Prop m field record
pattern field $b::~$ :: [field m record a] -> (record -> a -> a) -> Prop m field record
$m::~$ :: forall r (m :: * -> *) (field :: FieldKind) record.
(Typeable m, Typeable field, Typeable record, Monad m,
 FieldModify field) =>
Prop m field record
-> (forall a. [field m record a] -> (record -> a -> a) -> r)
-> (Void# -> r)
-> r
::~$ f <- (cast -> Just (Modify field f))
  where
    (::~$) = ModifyProp m field record -> Prop m field record
forall (m :: * -> *) (prop :: PropertyKind) (field :: FieldKind)
       record.
(Monad m, IsProp prop) =>
prop m field record -> Prop m field record
Prop (ModifyProp m field record -> Prop m field record)
-> ([field m record a]
    -> (record -> a -> a) -> ModifyProp m field record)
-> [field m record a]
-> (record -> a -> a)
-> Prop m field record
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... [field m record a]
-> (record -> a -> a) -> ModifyProp m field record
forall (field :: FieldKind) (m :: * -> *) record a.
FieldModify field =>
[field m record a]
-> (record -> a -> a) -> ModifyProp m field record
Modify

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

{- fmr monadic setters. -}

{- |
  @since 0.2
  Monadic value setter. @set record [field :<= mvalue]@ set result of @mvalue@
  to @record@'s @field@. Note that the @mvalue@ is evaluated every time a
  @field@ value is assigned.
  
  @
    set record [field :<= return val] === set record [field := val]
    set record [field :<= mval] === do val <- mval; set record [field :<= val]
  @
-}
pattern (:<=) ::
  (
    Typeable m, Typeable field, Typeable record,
    Monad m, FieldSet field
  ) => field m record a -> m a -> Prop m field record
pattern field $b:<= :: field m record a -> m a -> Prop m field record
$m:<= :: forall r (m :: * -> *) (field :: FieldKind) record.
(Typeable m, Typeable field, Typeable record, Monad m,
 FieldSet field) =>
Prop m field record
-> (forall a. field m record a -> m a -> r) -> (Void# -> r) -> r
:<= mval = [field] :<=$ mval

{- |
  @since 0.2
  Monadic value setter with @record@. @set record [field :=< mvalue]@ set result
  of @mvalue record@ to @record@'s @field@. Note that the @mvalue@ is evaluated
  every time a @field@ value is assigned.
  
  @
    set record [field :=< const val] === set record [field :<= val]
    set record [field :=< f] === do val <- f record; set record [field := val]
  @
-}
pattern (:=<) ::
  (
    Typeable m, Typeable field, Typeable record,
    Monad m, FieldSet field
  ) => field m record a -> (record -> m a) -> Prop m field record
pattern field $b:=< :: field m record a -> (record -> m a) -> Prop m field record
$m:=< :: forall r (m :: * -> *) (field :: FieldKind) record.
(Typeable m, Typeable field, Typeable record, Monad m,
 FieldSet field) =>
Prop m field record
-> (forall a. field m record a -> (record -> m a) -> r)
-> (Void# -> r)
-> r
:=< f = [field] :=<$ f

{- |
  @since 0.2
  Monadic group setter. @set record [fields :<=$ mvalue]@ set result of @mvalue@
  to @record@'s @fields@. Note that @mvalue@ is evaluated only once, on the
  first assignment. Thus, the values of all the listed fields will be identical.
  
  @
    set record [[field] :<=$ const f] === set record [field :<= val]
    set record [fields :<=$ mval] === do val <- mval; set record [fields :<=$ val]
  @
-}
pattern (:<=$) ::
  (
    Typeable m, Typeable field, Typeable record,
    Monad m, FieldSet field
  ) => [field m record a] -> m a -> Prop m field record
pattern field $b:<=$ :: [field m record a] -> m a -> Prop m field record
$m:<=$ :: forall r (m :: * -> *) (field :: FieldKind) record.
(Typeable m, Typeable field, Typeable record, Monad m,
 FieldSet field) =>
Prop m field record
-> (forall a. [field m record a] -> m a -> r) -> (Void# -> r) -> r
:<=$ mval <- (cast -> Just (SetPropM field mval))
  where
    (:<=$) = SetProp m field record -> Prop m field record
forall (m :: * -> *) (prop :: PropertyKind) (field :: FieldKind)
       record.
(Monad m, IsProp prop) =>
prop m field record -> Prop m field record
Prop (SetProp m field record -> Prop m field record)
-> ([field m record a] -> m a -> SetProp m field record)
-> [field m record a]
-> m a
-> Prop m field record
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... [field m record a] -> m a -> SetProp m field record
forall (field :: FieldKind) (m :: * -> *) record a.
FieldSet field =>
[field m record a] -> m a -> SetProp m field record
SetPropM

{- |
  @since 0.2
  Monadic group setter with @record@. @set record [fields :=<$ f]@ set result of
  @f record@ to @record@'s @fields@. Note that @f record@ is evaluated only
  once, on the first assignment. Thus, the values of all the listed fields will
  be identical.
  
  @
    set record [[field] :=<$ f] === set record [field :=< val]
    set record [fields :=<$ const val] = set record [fields :=$ val]
    set record [fields :=<$ f] === do val <- f record; set record [fields :=$ val]
  @
-}
pattern (:=<$) ::
  (
    Typeable m, Typeable field, Typeable record,
    Monad m, FieldSet field
  ) => [field m record a] -> (record -> m a) -> Prop m field record
pattern field $b:=<$ :: [field m record a] -> (record -> m a) -> Prop m field record
$m:=<$ :: forall r (m :: * -> *) (field :: FieldKind) record.
(Typeable m, Typeable field, Typeable record, Monad m,
 FieldSet field) =>
Prop m field record
-> (forall a. [field m record a] -> (record -> m a) -> r)
-> (Void# -> r)
-> r
:=<$ f <- (cast -> Just (SetRecordPropM field f))
  where
    (:=<$) = SetProp m field record -> Prop m field record
forall (m :: * -> *) (prop :: PropertyKind) (field :: FieldKind)
       record.
(Monad m, IsProp prop) =>
prop m field record -> Prop m field record
Prop (SetProp m field record -> Prop m field record)
-> ([field m record a]
    -> (record -> m a) -> SetProp m field record)
-> [field m record a]
-> (record -> m a)
-> Prop m field record
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... [field m record a] -> (record -> m a) -> SetProp m field record
forall (field :: FieldKind) (m :: * -> *) record a.
FieldSet field =>
[field m record a] -> (record -> m a) -> SetProp m field record
SetRecordPropM

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

{- fmr monadic updaters. -}

{- |
  @since 0.2
  Monadic value modifier. @set record [field :<~ f]@ modifies value of
  @record@'s @field@ using @f@ procedure. Note that the @mvalue@ is called every
  time a @field@ value is assigned.
  
  @
    set record [field :<~ return val] === set record [fields := val]
  @
-}
pattern (:<~) ::
  (
    Typeable m, Typeable field, Typeable record, Monad m,
    FieldModify field, FieldGet field
  ) => field m record a -> (a -> m a) -> Prop m field record
pattern field $b:<~ :: field m record a -> (a -> m a) -> Prop m field record
$m:<~ :: forall r (m :: * -> *) (field :: FieldKind) record.
(Typeable m, Typeable field, Typeable record, Monad m,
 FieldModify field, FieldGet field) =>
Prop m field record
-> (forall a. field m record a -> (a -> m a) -> r)
-> (Void# -> r)
-> r
:<~ f = [field] :<~$ f

{- |
  @since 0.2
  Monadic value modifier with @record@. @set record [field :<~ f]@ modifies
  value of @record@'s @field@ using @f record@ procedure. Note that the
  @f record@ is called every time a @field@ value is assigned.
  
  @
    set record [field :~< const f] === set record [fields :<~ f]
  @
-}
pattern (:~<) ::
  (
    Typeable m, Typeable field, Typeable record,
    Monad m, FieldModify field, FieldGet field
  ) => field m record a -> (record -> a -> m a) -> Prop m field record
pattern field $b:~< :: field m record a -> (record -> a -> m a) -> Prop m field record
$m:~< :: forall r (m :: * -> *) (field :: FieldKind) record.
(Typeable m, Typeable field, Typeable record, Monad m,
 FieldModify field, FieldGet field) =>
Prop m field record
-> (forall a. field m record a -> (record -> a -> m a) -> r)
-> (Void# -> r)
-> r
:~< f = [field] :~<$ f

{- |
  @since 0.2
  Monadic group modifier. @set record [fields :<~$ f]@ modifies values of
  @record@'s @fields@ using @f@ procedure.
  
  @
    set record [[field] :<~$ f] === set record [field :<~ f]
    set record [fields :<~$ const mval] === set record [field :<=$ mval]
  @
-}
pattern (:<~$) ::
  (
    Typeable m, Typeable field, Typeable record,
    Monad m, FieldModify field, FieldGet field
  ) => [field m record a] -> (a -> m a) -> Prop m field record
pattern field $b:<~$ :: [field m record a] -> (a -> m a) -> Prop m field record
$m:<~$ :: forall r (m :: * -> *) (field :: FieldKind) record.
(Typeable m, Typeable field, Typeable record, Monad m,
 FieldModify field, FieldGet field) =>
Prop m field record
-> (forall a. [field m record a] -> (a -> m a) -> r)
-> (Void# -> r)
-> r
:<~$ f <- (cast -> Just (ModifyPropM field f))
  where
    (:<~$) = ModifyProp m field record -> Prop m field record
forall (m :: * -> *) (prop :: PropertyKind) (field :: FieldKind)
       record.
(Monad m, IsProp prop) =>
prop m field record -> Prop m field record
Prop (ModifyProp m field record -> Prop m field record)
-> ([field m record a] -> (a -> m a) -> ModifyProp m field record)
-> [field m record a]
-> (a -> m a)
-> Prop m field record
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... [field m record a] -> (a -> m a) -> ModifyProp m field record
forall (field :: FieldKind) (m :: * -> *) record a.
(FieldModify field, FieldGet field) =>
[field m record a] -> (a -> m a) -> ModifyProp m field record
ModifyPropM

{- |
  @since 0.2
  Monadic group modifier with @record@. @set record [fields :~<$ f]@ modifies
  values of @record@'s @fields@ using @f record@ procedure. Note that the
  @f record@ is called every time a @field@ value is assigned.
  
  @
    set record [field :~<$ const f] === set record [fields :<~$ f]
  @
-}
pattern (:~<$) ::
  (
    Typeable m, Typeable field, Typeable record,
    Monad m, FieldModify field, FieldGet field
  ) => [field m record a] -> (record -> a -> m a) -> Prop m field record
pattern field $b:~<$ :: [field m record a] -> (record -> a -> m a) -> Prop m field record
$m:~<$ :: forall r (m :: * -> *) (field :: FieldKind) record.
(Typeable m, Typeable field, Typeable record, Monad m,
 FieldModify field, FieldGet field) =>
Prop m field record
-> (forall a. [field m record a] -> (record -> a -> m a) -> r)
-> (Void# -> r)
-> r
:~<$ f <- (cast -> Just (ModifyM field f))
  where
    (:~<$) = ModifyProp m field record -> Prop m field record
forall (m :: * -> *) (prop :: PropertyKind) (field :: FieldKind)
       record.
(Monad m, IsProp prop) =>
prop m field record -> Prop m field record
Prop (ModifyProp m field record -> Prop m field record)
-> ([field m record a]
    -> (record -> a -> m a) -> ModifyProp m field record)
-> [field m record a]
-> (record -> a -> m a)
-> Prop m field record
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... [field m record a]
-> (record -> a -> m a) -> ModifyProp m field record
forall (field :: FieldKind) (m :: * -> *) record a.
(FieldModify field, FieldGet field) =>
[field m record a]
-> (record -> a -> m a) -> ModifyProp m field record
ModifyM

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

-- | Service class for switchable types.
class IsSwitch switch
  where
    {- |
      @'toggle' s n@ "toggles" the state represented by the value @s@ by @n@
      positions, for example:
      
      @
        toggle n False = even n
        toggle n  True = odd  n
        toggle n  1234 = 1239 + n
      @
    -}
    toggle :: Int -> switch -> switch

instance IsSwitch Bool
  where
    toggle :: Int -> Bool -> Bool
toggle Int
n Bool
False = Int -> Bool
forall a. Integral a => a -> Bool
even Int
n
    toggle Int
n  Bool
True = Int -> Bool
forall a. Integral a => a -> Bool
odd  Int
n

instance (Integral i) => IsSwitch i where toggle :: Int -> i -> i
toggle Int
n i
i = Int -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n i -> i -> i
forall a. Num a => a -> a -> a
+ i
i

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

-- | The 'get' function reads current value of a field.
get :: (Monad m, FieldGet field) => 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 :: FieldKind) (m :: * -> *) record a.
(FieldGet field, Monad m) =>
field m record a -> record -> m a
getRecord

-- | @'gets'' fields record@ returns list of @record@ @fields@ values.
gets' :: (Monad m, FieldGet field) => record -> [field m record a] -> m [a]
gets' :: record -> [field m record a] -> m [a]
gets' =  (field m record a -> m a) -> [field m record a] -> m [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((field m record a -> m a) -> [field m record a] -> m [a])
-> (record -> field m record a -> m a)
-> record
-> [field m record a]
-> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (field m record a -> record -> m a)
-> record -> field m record a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip field m record a -> record -> m a
forall (field :: FieldKind) (m :: * -> *) record a.
(FieldGet field, Monad m) =>
field m record a -> record -> m a
getRecord

{- |
  'set' is the main function in @fmr@, which allows you to describe changing the
  value of a record as a sequence of operations on its fields, e.g.
-}
set :: (Monad m) => record -> [Prop m field record] -> m ()
set :: record -> [Prop m field record] -> m ()
set 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 prop m field record
prop) -> record -> prop m field record -> m ()
forall (prop :: PropertyKind) (m :: * -> *) record
       (field :: FieldKind).
(IsProp prop, Monad m) =>
record -> prop m field record -> m ()
performProp record
record prop m field record
prop

-- | Just synonym for 'set'.
sets' :: (Monad m) => record -> [Prop m field record] -> m ()
sets' :: record -> [Prop m field record] -> m ()
sets' =  record -> [Prop m field record] -> m ()
forall (m :: * -> *) record (field :: FieldKind).
Monad m =>
record -> [Prop m field record] -> m ()
set

-- | 'switch' changes the value by n steps.
switch :: (Monad m, FieldSwitch field, IsSwitch a) =>
  field m record a -> Int -> Prop m field record
switch :: field m record a -> Int -> Prop m field record
switch field m record a
field Int
n = SwitchProp m field record -> Prop m field record
forall (m :: * -> *) (prop :: PropertyKind) (field :: FieldKind)
       record.
(Monad m, IsProp prop) =>
prop m field record -> Prop m field record
Prop (Int -> field m record a -> SwitchProp m field record
forall (m :: * -> *) (field :: FieldKind) a record.
(Monad m, FieldSwitch field, IsSwitch a) =>
Int -> field m record a -> SwitchProp m field record
SwitchProp Int
n field m record a
field)

-- | @'incr' field@ is same as @switch field 1@.
incr :: (Monad m, FieldSwitch field, IsSwitch a) =>
  field m record a -> Prop m field record
incr :: field m record a -> Prop m field record
incr =  SwitchProp m field record -> Prop m field record
forall (m :: * -> *) (prop :: PropertyKind) (field :: FieldKind)
       record.
(Monad m, IsProp prop) =>
prop m field record -> Prop m field record
Prop (SwitchProp m field record -> Prop m field record)
-> (field m record a -> SwitchProp m field record)
-> field m record a
-> Prop m field record
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> field m record a -> SwitchProp m field record
forall (m :: * -> *) (field :: FieldKind) a record.
(Monad m, FieldSwitch field, IsSwitch a) =>
Int -> field m record a -> SwitchProp m field record
SwitchProp Int
1

-- | @'decr' field@ is same as @switch field (-1)@.
decr :: (Monad m, FieldSwitch field, IsSwitch a) =>
  field m record a -> Prop m field record
decr :: field m record a -> Prop m field record
decr =  SwitchProp m field record -> Prop m field record
forall (m :: * -> *) (prop :: PropertyKind) (field :: FieldKind)
       record.
(Monad m, IsProp prop) =>
prop m field record -> Prop m field record
Prop (SwitchProp m field record -> Prop m field record)
-> (field m record a -> SwitchProp m field record)
-> field m record a
-> Prop m field record
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> field m record a -> SwitchProp m field record
forall (m :: * -> *) (field :: FieldKind) a record.
(Monad m, FieldSwitch field, IsSwitch a) =>
Int -> field m record a -> SwitchProp m field record
SwitchProp (-Int
1)

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

-- | @sdp@ @(.)@-like combinator.
(...) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
... :: (c -> d) -> (a -> b -> c) -> a -> b -> d
(...) =  ((b -> c) -> b -> d) -> (a -> b -> c) -> a -> b -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) (((b -> c) -> b -> d) -> (a -> b -> c) -> a -> b -> d)
-> ((c -> d) -> (b -> c) -> b -> d)
-> (c -> d)
-> (a -> b -> c)
-> a
-> b
-> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> d) -> (b -> c) -> b -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)