{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

{-|
Description: A 'Patch' combinator type for patching or replacing with a separate new value.
-}
module Data.Patch.PatchOrReplacement
  ( PatchOrReplacement (..)
  , _PatchOrReplacement_Patch
  , _PatchOrReplacement_Replacement
  , traversePatchOrReplacement
  ) where

import Control.Lens.TH (makePrisms)
import Data.Patch
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup (Semigroup (..))
#endif
import GHC.Generics

-- | Either a patch or a replacement value.
--
-- A good patch type will describe small changes very efficiently, but
-- that often comes at the cost of describing large change rather
-- inefficiently. 'PatchOrReplacement' can be used as an escape hatch:
-- when the change as a patch would be too big, just provide a new value
-- to replace the old one with instead.
--
-- @since 0.0.6
data PatchOrReplacement p
  = PatchOrReplacement_Patch p
  | PatchOrReplacement_Replacement (PatchTarget p)
  deriving ((forall x. PatchOrReplacement p -> Rep (PatchOrReplacement p) x)
-> (forall x. Rep (PatchOrReplacement p) x -> PatchOrReplacement p)
-> Generic (PatchOrReplacement p)
forall x. Rep (PatchOrReplacement p) x -> PatchOrReplacement p
forall x. PatchOrReplacement p -> Rep (PatchOrReplacement p) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall p x. Rep (PatchOrReplacement p) x -> PatchOrReplacement p
forall p x. PatchOrReplacement p -> Rep (PatchOrReplacement p) x
$cto :: forall p x. Rep (PatchOrReplacement p) x -> PatchOrReplacement p
$cfrom :: forall p x. PatchOrReplacement p -> Rep (PatchOrReplacement p) x
Generic)

deriving instance (Eq p, Eq (PatchTarget p)) => Eq (PatchOrReplacement p)
deriving instance (Ord p, Ord (PatchTarget p)) => Ord (PatchOrReplacement p)
deriving instance (Show p, Show (PatchTarget p)) => Show (PatchOrReplacement p)
deriving instance (Read p, Read (PatchTarget p)) => Read (PatchOrReplacement p)

-- | Traverse a 'PatchOrReplacement' with a function for each case
traversePatchOrReplacement
  :: Functor f
  => (a -> f b)
  -> (PatchTarget a -> f (PatchTarget b))
  -> PatchOrReplacement a -> f (PatchOrReplacement b)
traversePatchOrReplacement :: (a -> f b)
-> (PatchTarget a -> f (PatchTarget b))
-> PatchOrReplacement a
-> f (PatchOrReplacement b)
traversePatchOrReplacement a -> f b
f PatchTarget a -> f (PatchTarget b)
g = \case
  PatchOrReplacement_Patch a
p -> b -> PatchOrReplacement b
forall p. p -> PatchOrReplacement p
PatchOrReplacement_Patch (b -> PatchOrReplacement b) -> f b -> f (PatchOrReplacement b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
p
  PatchOrReplacement_Replacement PatchTarget a
p -> PatchTarget b -> PatchOrReplacement b
forall p. PatchTarget p -> PatchOrReplacement p
PatchOrReplacement_Replacement (PatchTarget b -> PatchOrReplacement b)
-> f (PatchTarget b) -> f (PatchOrReplacement b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PatchTarget a -> f (PatchTarget b)
g PatchTarget a
p

-- | To apply a @'PatchOrReplacement' p@ apply the the underlying @p@ or
-- substitute the replacement @'PatchTarget' p@.
instance Patch p => Patch (PatchOrReplacement p) where
  type PatchTarget (PatchOrReplacement p) = PatchTarget p
  apply :: PatchOrReplacement p
-> PatchTarget (PatchOrReplacement p)
-> Maybe (PatchTarget (PatchOrReplacement p))
apply = \case
    PatchOrReplacement_Patch p
p -> p -> PatchTarget p -> Maybe (PatchTarget p)
forall p. Patch p => p -> PatchTarget p -> Maybe (PatchTarget p)
apply p
p
    PatchOrReplacement_Replacement PatchTarget p
v -> \PatchTarget (PatchOrReplacement p)
_ -> PatchTarget p -> Maybe (PatchTarget p)
forall a. a -> Maybe a
Just PatchTarget p
v

instance ( Monoid p
#if !MIN_VERSION_base(4,11,0)
         , Semigroup p
#endif
         , Patch p
         ) => Monoid (PatchOrReplacement p) where
  mempty :: PatchOrReplacement p
mempty = p -> PatchOrReplacement p
forall p. p -> PatchOrReplacement p
PatchOrReplacement_Patch p
forall a. Monoid a => a
mempty
  mappend :: PatchOrReplacement p
-> PatchOrReplacement p -> PatchOrReplacement p
mappend = PatchOrReplacement p
-> PatchOrReplacement p -> PatchOrReplacement p
forall a. Semigroup a => a -> a -> a
(<>)

instance (Semigroup p, Patch p) => Semigroup (PatchOrReplacement p) where
  <> :: PatchOrReplacement p
-> PatchOrReplacement p -> PatchOrReplacement p
(<>) = ((PatchOrReplacement p, PatchOrReplacement p)
 -> PatchOrReplacement p)
-> PatchOrReplacement p
-> PatchOrReplacement p
-> PatchOrReplacement p
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((PatchOrReplacement p, PatchOrReplacement p)
  -> PatchOrReplacement p)
 -> PatchOrReplacement p
 -> PatchOrReplacement p
 -> PatchOrReplacement p)
-> ((PatchOrReplacement p, PatchOrReplacement p)
    -> PatchOrReplacement p)
-> PatchOrReplacement p
-> PatchOrReplacement p
-> PatchOrReplacement p
forall a b. (a -> b) -> a -> b
$ \case
    (PatchOrReplacement_Patch p
a, PatchOrReplacement_Patch p
b) -> p -> PatchOrReplacement p
forall p. p -> PatchOrReplacement p
PatchOrReplacement_Patch (p -> PatchOrReplacement p) -> p -> PatchOrReplacement p
forall a b. (a -> b) -> a -> b
$ p
a p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
b
    (PatchOrReplacement_Patch p
a, PatchOrReplacement_Replacement PatchTarget p
b) -> PatchTarget p -> PatchOrReplacement p
forall p. PatchTarget p -> PatchOrReplacement p
PatchOrReplacement_Replacement (PatchTarget p -> PatchOrReplacement p)
-> PatchTarget p -> PatchOrReplacement p
forall a b. (a -> b) -> a -> b
$ p -> PatchTarget p -> PatchTarget p
forall p. Patch p => p -> PatchTarget p -> PatchTarget p
applyAlways p
a PatchTarget p
b
    (PatchOrReplacement_Replacement PatchTarget p
a, PatchOrReplacement p
_) -> PatchTarget p -> PatchOrReplacement p
forall p. PatchTarget p -> PatchOrReplacement p
PatchOrReplacement_Replacement PatchTarget p
a

makePrisms ''PatchOrReplacement