{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
-- | The interface for types which represent changes made to other types
module Data.Patch.Class where

import Data.Functor.Identity
import Data.Kind (Type)
import Data.Maybe
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup (Semigroup(..))
#endif
import Data.Proxy

-- | A 'Patch' type represents a kind of change made to a datastructure.
--
-- If an instance of 'Patch' is also an instance of 'Semigroup', it should obey
-- the law that @applyAlways (f <> g) == applyAlways f . applyAlways g@.
class Patch p where
  type PatchTarget p :: Type
  -- | Apply the patch @p a@ to the value @a@.  If no change is needed, return
  -- 'Nothing'.
  apply :: p -> PatchTarget p -> Maybe (PatchTarget p)

-- | Apply a 'Patch'; if it does nothing, return the original value
applyAlways :: Patch p => p -> PatchTarget p -> PatchTarget p
applyAlways :: p -> PatchTarget p -> PatchTarget p
applyAlways p
p PatchTarget p
t = PatchTarget p -> Maybe (PatchTarget p) -> PatchTarget p
forall a. a -> Maybe a -> a
fromMaybe PatchTarget p
t (Maybe (PatchTarget p) -> PatchTarget p)
-> Maybe (PatchTarget p) -> PatchTarget p
forall a b. (a -> b) -> a -> b
$ p -> PatchTarget p -> Maybe (PatchTarget p)
forall p. Patch p => p -> PatchTarget p -> Maybe (PatchTarget p)
apply p
p PatchTarget p
t

-- | 'Identity' can be used as a 'Patch' that always fully replaces the value
instance Patch (Identity a) where
  type PatchTarget (Identity a) = a
  apply :: Identity a
-> PatchTarget (Identity a) -> Maybe (PatchTarget (Identity a))
apply (Identity a
a) PatchTarget (Identity a)
_ = a -> Maybe a
forall a. a -> Maybe a
Just a
a

-- | 'Proxy' can be used as a 'Patch' that does nothing.
instance forall (a :: Type). Patch (Proxy a) where
  type PatchTarget (Proxy a) = a
  apply :: Proxy a -> PatchTarget (Proxy a) -> Maybe (PatchTarget (Proxy a))
apply ~Proxy a
Proxy PatchTarget (Proxy a)
_ = Maybe (PatchTarget (Proxy a))
forall a. Maybe a
Nothing

-- | Like '(.)', but composes functions that return patches rather than
-- functions that return new values.  The Semigroup instance for patches must
-- apply patches right-to-left, like '(.)'.
composePatchFunctions :: (Patch p, Semigroup p) => (PatchTarget p -> p) -> (PatchTarget p -> p) -> PatchTarget p -> p
composePatchFunctions :: (PatchTarget p -> p) -> (PatchTarget p -> p) -> PatchTarget p -> p
composePatchFunctions PatchTarget p -> p
g PatchTarget p -> p
f PatchTarget p
a =
  let fp :: p
fp = PatchTarget p -> p
f PatchTarget p
a
  in PatchTarget p -> p
g (p -> PatchTarget p -> PatchTarget p
forall p. Patch p => p -> PatchTarget p -> PatchTarget p
applyAlways p
fp PatchTarget p
a) p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
fp