{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

{-|
Copyright   : © 2022-2023 IOHK, 2023-2025 Cardano Foundation
License     : Apache-2.0
Description : Computations that produce a delta and a result.

'Update' represents a computation which produces a delta and a result.

Similar to the 'Control.Monad.Trans.State.State' monad,
but involves a 'Delta' type.

Useful for composing updates to a 'DBVar', via 'onDBVar'.

Note: This module is preliminary.
-}
module Data.Delta.Update (
    -- * Update
    -- ** Type
      Update
    -- ** View
    , runUpdate
    , applyUpdate
    , onDBVar
    -- ** Combinators
    , nop
    , update
    , updateWithResult
    -- ** Helpers
    , updateWithError
    , updateWithResultAndError
    , updateMany
    , updateField
    ) where

import Prelude

import Data.DBVar
    ( DBVar
    , modifyDBMaybe
    )
import Data.Delta
    ( Delta (..)
    )

{-------------------------------------------------------------------------------
    Update
    Type, View
-------------------------------------------------------------------------------}
-- | A computation which inspects a value @a ~ Base da@
-- and produces a delta @da@ and a result of type @r@.
--
-- Related to the 'Control.Monad.Trans.State.State' monad:
-- The type @'Update' ('Data.Delta.Core.Replace' s) r@ is essentially equivalent to
-- @'Control.Monad.Trans.State.State' s r@.
newtype Update da r = Update { forall da r. Update da r -> Base da -> (Maybe da, r)
runUpdate_ :: Base da -> (Maybe da, r) }

-- | Run the 'Update' computation.
runUpdate :: (a ~ Base da) => Update da r -> a -> (Maybe da, r)
runUpdate :: forall a da r. (a ~ Base da) => Update da r -> a -> (Maybe da, r)
runUpdate = Update da r -> a -> (Maybe da, r)
Update da r -> Base da -> (Maybe da, r)
forall da r. Update da r -> Base da -> (Maybe da, r)
runUpdate_

-- | Semantics.
applyUpdate
    :: (Delta da, a ~ Base da)
    => Update da r -> a -> (a,r)
applyUpdate :: forall da a r.
(Delta da, a ~ Base da) =>
Update da r -> a -> (a, r)
applyUpdate (Update Base da -> (Maybe da, r)
g) a
a =
    case Base da -> (Maybe da, r)
g a
Base da
a of
        (Maybe da
da, r
r) -> (Maybe da
da Maybe da -> Base (Maybe da) -> Base (Maybe da)
forall delta. Delta delta => delta -> Base delta -> Base delta
`apply` a
Base (Maybe da)
a, r
r)

-- | Apply an 'Update' to a 'DBVar'.
onDBVar
    :: (Monad m, Delta da)
    => DBVar m da -> Update da r -> m r
onDBVar :: forall (m :: * -> *) da r.
(Monad m, Delta da) =>
DBVar m da -> Update da r -> m r
onDBVar DBVar m da
dbvar = DBVar m da -> forall b. (Base da -> (Maybe da, b)) -> m b
forall da (m :: * -> *) a.
(Delta da, Monad m, a ~ Base da) =>
DBVar m da -> forall b. (a -> (Maybe da, b)) -> m b
modifyDBMaybe DBVar m da
dbvar ((Base da -> (Maybe da, r)) -> m r)
-> (Update da r -> Base da -> (Maybe da, r)) -> Update da r -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Update da r -> Base da -> (Maybe da, r)
forall a da r. (a ~ Base da) => Update da r -> a -> (Maybe da, r)
runUpdate

{-------------------------------------------------------------------------------
    Combinators
-------------------------------------------------------------------------------}
-- | Map results.
instance Functor (Update da) where
    fmap :: forall a b. (a -> b) -> Update da a -> Update da b
fmap a -> b
f (Update Base da -> (Maybe da, a)
g) = (Base da -> (Maybe da, b)) -> Update da b
forall da r. (Base da -> (Maybe da, r)) -> Update da r
Update ((Base da -> (Maybe da, b)) -> Update da b)
-> (Base da -> (Maybe da, b)) -> Update da b
forall a b. (a -> b) -> a -> b
$ \Base da
a ->
        case Base da -> (Maybe da, a)
g Base da
a of
            (Maybe da
da, a
r) -> (Maybe da
da, a -> b
f a
r)

-- | No operation.
--
-- Use the 'Functor' instance, specifically '(<$)'
-- to add results other than '()'.
nop :: Update da ()
nop :: forall da. Update da ()
nop = (Base da -> (Maybe da, ())) -> Update da ()
forall da r. (Base da -> (Maybe da, r)) -> Update da r
Update ((Base da -> (Maybe da, ())) -> Update da ())
-> (Base da -> (Maybe da, ())) -> Update da ()
forall a b. (a -> b) -> a -> b
$ (Maybe da, ()) -> Base da -> (Maybe da, ())
forall a b. a -> b -> a
const (Maybe da
forall a. Maybe a
Nothing, ())

-- | Compute a delta.
update :: (a ~ Base da) => (a -> da) -> Update da ()
update :: forall a da. (a ~ Base da) => (a -> da) -> Update da ()
update a -> da
f = (Base da -> (Maybe da, ())) -> Update da ()
forall da r. (Base da -> (Maybe da, r)) -> Update da r
Update ((Base da -> (Maybe da, ())) -> Update da ())
-> (Base da -> (Maybe da, ())) -> Update da ()
forall a b. (a -> b) -> a -> b
$ \Base da
a -> (da -> Maybe da
forall a. a -> Maybe a
Just (a -> da
f a
Base da
a), ())

-- | Compute a delta with result.
updateWithResult
    :: (a ~ Base da)
    => (a -> (da, r)) -- Delta with result.
    -> Update da r
updateWithResult :: forall a da r. (a ~ Base da) => (a -> (da, r)) -> Update da r
updateWithResult a -> (da, r)
f = (Base da -> (Maybe da, r)) -> Update da r
forall da r. (Base da -> (Maybe da, r)) -> Update da r
Update ((Base da -> (Maybe da, r)) -> Update da r)
-> (Base da -> (Maybe da, r)) -> Update da r
forall a b. (a -> b) -> a -> b
$ \Base da
a ->
    case a -> (da, r)
f a
Base da
a of
        (da
da, r
r) -> (da -> Maybe da
forall a. a -> Maybe a
Just da
da, r
r)

-- | Compute a delta or fail.
updateWithError
    :: (a ~ Base da)
    => (a -> Either e da)
    -> Update da (Either e ())
updateWithError :: forall a da e.
(a ~ Base da) =>
(a -> Either e da) -> Update da (Either e ())
updateWithError a -> Either e da
f = (Base da -> (Maybe da, Either e ())) -> Update da (Either e ())
forall da r. (Base da -> (Maybe da, r)) -> Update da r
Update ((Base da -> (Maybe da, Either e ())) -> Update da (Either e ()))
-> (Base da -> (Maybe da, Either e ())) -> Update da (Either e ())
forall a b. (a -> b) -> a -> b
$ \Base da
a ->
    case a -> Either e da
f a
Base da
a of
        Left e
e -> (Maybe da
forall a. Maybe a
Nothing, e -> Either e ()
forall a b. a -> Either a b
Left e
e)
        Right da
da -> (da -> Maybe da
forall a. a -> Maybe a
Just da
da, () -> Either e ()
forall a b. b -> Either a b
Right ())

-- | Compute a delta with result or fail.
updateWithResultAndError
    :: (a ~ Base da)
    => (a -> Either e (da, r))
    -> Update da (Either e r)
updateWithResultAndError :: forall a da e r.
(a ~ Base da) =>
(a -> Either e (da, r)) -> Update da (Either e r)
updateWithResultAndError a -> Either e (da, r)
f = (Base da -> (Maybe da, Either e r)) -> Update da (Either e r)
forall da r. (Base da -> (Maybe da, r)) -> Update da r
Update ((Base da -> (Maybe da, Either e r)) -> Update da (Either e r))
-> (Base da -> (Maybe da, Either e r)) -> Update da (Either e r)
forall a b. (a -> b) -> a -> b
$ \Base da
a ->
    case a -> Either e (da, r)
f a
Base da
a of
        Left e
e -> (Maybe da
forall a. Maybe a
Nothing, e -> Either e r
forall a b. a -> Either a b
Left e
e)
        Right (da
da,r
r) -> (da -> Maybe da
forall a. a -> Maybe a
Just da
da, r -> Either e r
forall a b. b -> Either a b
Right r
r)

-- | Lift an update for a single delta to a list of deltas.
updateMany
    :: Update da r
    -> Update [da] r
updateMany :: forall da r. Update da r -> Update [da] r
updateMany (Update Base da -> (Maybe da, r)
g) = (Base [da] -> (Maybe [da], r)) -> Update [da] r
forall da r. (Base da -> (Maybe da, r)) -> Update da r
Update ((Base [da] -> (Maybe [da], r)) -> Update [da] r)
-> (Base [da] -> (Maybe [da], r)) -> Update [da] r
forall a b. (a -> b) -> a -> b
$ \Base [da]
a ->
    case Base da -> (Maybe da, r)
g Base da
Base [da]
a of
        (Maybe da
Nothing, r
r) -> (Maybe [da]
forall a. Maybe a
Nothing, r
r)
        (Just da
da, r
r) -> ([da] -> Maybe [da]
forall a. a -> Maybe a
Just [da
da], r
r)

{- | Helper function for lifting the 'Update' from a
record field to the record.

Example:

@
data Pair a b = Pair a b
first :: Pair a b -> a

data DeltaPair da db
    = UpdateFirst da
    | UpdateSecond db

updateField first UpdateFirst
    :: (a -> Update da r)
    -> (Pair a b -> Update (DeltaPair da db) r)
@
-}
updateField
    :: (a ~ Base da, b ~ Base db)
    => (b -> a)
        -- ^ View field.
    -> (da -> db)
        -- ^ Lift delta to
    -> Update da r
    -> Update db r
updateField :: forall a da b db r.
(a ~ Base da, b ~ Base db) =>
(b -> a) -> (da -> db) -> Update da r -> Update db r
updateField b -> a
view da -> db
embed (Update Base da -> (Maybe da, r)
g) =
    (Base db -> (Maybe db, r)) -> Update db r
forall da r. (Base da -> (Maybe da, r)) -> Update da r
Update ((Base db -> (Maybe db, r)) -> Update db r)
-> (Base db -> (Maybe db, r)) -> Update db r
forall a b. (a -> b) -> a -> b
$ (Maybe da, r) -> (Maybe db, r)
lift ((Maybe da, r) -> (Maybe db, r))
-> (b -> (Maybe da, r)) -> b -> (Maybe db, r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (Maybe da, r)
Base da -> (Maybe da, r)
g (a -> (Maybe da, r)) -> (b -> a) -> b -> (Maybe da, r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
view
  where
    lift :: (Maybe da, r) -> (Maybe db, r)
lift (Maybe da
mda, r
r) = (da -> db
embed (da -> db) -> Maybe da -> Maybe db
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe da
mda, r
r)