-- | This module contains a utility for diffing two records.
--
-- @since 0.0.1.0
module Prairie.Diff
  ( module Prairie.Diff
  , module Prairie.Update
  ) where

import Prairie.Update
import Prairie.Class

-- | Given two 'Record's, this function produces a list of 'Update's that
-- can be performed on the first record such that it will equal the second.
--
-- @
-- 'updateRecord' ('diffRecord' old new) old == new
-- @
--
-- A @['Update' rec]@ can be serialized with 'ToJSON', sent over the wire, and
-- parsed with 'FromJSON', so you can efficiently and easily represent
-- patches to 'Record's.
--
-- @since 0.0.1.0
diffRecord
  :: (Record rec, FieldDict Eq rec)
  => rec
  -- ^ The old record.
  -> rec
  -- ^ The new record.
  -> [Update rec]
diffRecord :: forall rec.
(Record rec, FieldDict Eq rec) =>
rec -> rec -> [Update rec]
diffRecord rec
old rec
new = (SomeField rec -> [Update rec]) -> [SomeField rec] -> [Update rec]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: Type -> Type) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap SomeField rec -> [Update rec]
go [SomeField rec]
forall rec. Record rec => [SomeField rec]
allFields
  where
    go :: SomeField rec -> [Update rec]
go (SomeField Field rec a
f) =
      forall (c :: Type -> Constraint) rec a r.
FieldDict c rec =>
Field rec a -> (c a => r) -> r
withFieldDict @Eq Field rec a
f ((Eq a => [Update rec]) -> [Update rec])
-> (Eq a => [Update rec]) -> [Update rec]
forall a b. (a -> b) -> a -> b
$
        let
          newVal :: a
newVal = Field rec a -> rec -> a
forall rec ty. Record rec => Field rec ty -> rec -> ty
getRecordField Field rec a
f rec
new
         in
          if Field rec a -> rec -> a
forall rec ty. Record rec => Field rec ty -> rec -> ty
getRecordField Field rec a
f rec
old a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
newVal
            then [Field rec a -> a -> Update rec
forall rec a. Field rec a -> a -> Update rec
SetField Field rec a
f a
newVal]
            else []