{-# LANGUAGE UndecidableInstances #-}

module Diff where

import Control.Monad (guard)
import Data.Function (on)
import Data.Void
import GHC.Generics
import Util ((∘∘))
import qualified Util.Enum as Util

import Data.Functor.Compose
import Data.Functor.Const
import Data.Functor.Identity
import Data.Functor.Product
import Data.Functor.Sum
import Data.Int
import Data.List.NonEmpty (NonEmpty (..))
import Data.Proxy (Proxy (..))
import Data.Semigroup (Arg (..))
import Data.Monoid (Alt (..))
import Data.Version
import Data.Word
import Numeric.Natural (Natural)

class Different a where
    type Diff a
    type Diff a = Diff (Rep a ())

    diff :: a -> a -> Diff a
    default diff :: (Generic a, Different (Rep a ()), Diff a ~ Diff (Rep a ())) => a -> a -> Diff a
    diff = Rep a () -> Rep a () -> Diff (Rep a ())
forall a. Different a => a -> a -> Diff a
diff (Rep a () -> Rep a () -> Diff (Rep a ()))
-> (a -> Rep a ()) -> a -> a -> Diff (Rep a ())
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (a -> Rep a ()
forall a x. Generic a => a -> Rep a x
from :: a -> Rep a ())

    patch :: Diff a -> a -> Maybe a
    default patch :: (Generic a, Different (Rep a ()), Diff a ~ Diff (Rep a ())) => Diff a -> a -> Maybe a
    patch δ :: Diff a
δ = (Rep a () -> a) -> Maybe (Rep a ()) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rep a () -> a
forall a x. Generic a => Rep a x -> a
to (Maybe (Rep a ()) -> Maybe a)
-> (a -> Maybe (Rep a ())) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Diff (Rep a ()) -> Rep a () -> Maybe (Rep a ())
forall a. Different a => Diff a -> a -> Maybe a
patch Diff a
Diff (Rep a ())
δ (Rep a () -> Maybe (Rep a ()))
-> (a -> Rep a ()) -> a -> Maybe (Rep a ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Rep a ()
forall a x. Generic a => a -> Rep a x
from :: a -> Rep a ())

instance Different (V1 a) where
    type Diff (V1 a) = Void
    diff :: V1 a -> V1 a -> Diff (V1 a)
diff = \ case
    patch :: Diff (V1 a) -> V1 a -> Maybe (V1 a)
patch = \ case

instance Different (U1 a) where
    type Diff (U1 a) = ()
    diff :: U1 a -> U1 a -> Diff (U1 a)
diff U1 U1 = ()
    patch :: Diff (U1 a) -> U1 a -> Maybe (U1 a)
patch () = U1 a -> Maybe (U1 a)
forall a. a -> Maybe a
Just

deriving newtype instance Different a => Different (Par1 a)
deriving newtype instance Different (f a) => Different (Rec1 f a)
deriving newtype instance Different c => Different (K1 i c a)
deriving newtype instance Different (f a) => Different (M1 i c f a)

instance (Different (f a), Eq (f a),
          Different (g a), Eq (g a)) => Different ((f :+: g) a) where
    type Diff ((f :+: g) a) = SumDiff (f a) (g a)
    diff :: (:+:) f g a -> (:+:) f g a -> Diff ((:+:) f g a)
diff (L1 a :: f a
a) (L1 b :: f a
b) = Diff (f a) -> SumDiff (f a) (g a)
forall a b. Diff a -> SumDiff a b
DiffL (f a -> f a -> Diff (f a)
forall a. Different a => a -> a -> Diff a
diff f a
a f a
b)
    diff (R1 a :: g a
a) (R1 b :: g a
b) = Diff (g a) -> SumDiff (f a) (g a)
forall a b. Diff b -> SumDiff a b
DiffR (g a -> g a -> Diff (g a)
forall a. Different a => a -> a -> Diff a
diff g a
a g a
b)
    diff (L1 a :: f a
a) (R1 b :: g a
b) = f a -> g a -> SumDiff (f a) (g a)
forall a b. a -> b -> SumDiff a b
LR f a
a g a
b
    diff (R1 a :: g a
a) (L1 b :: f a
b) = g a -> f a -> SumDiff (f a) (g a)
forall a b. b -> a -> SumDiff a b
RL g a
a f a
b
    patch :: Diff ((:+:) f g a) -> (:+:) f g a -> Maybe ((:+:) f g a)
patch (DiffL δ) (L1 a :: f a
a) = f a -> (:+:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (f a -> (:+:) f g a) -> Maybe (f a) -> Maybe ((:+:) f g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Diff (f a) -> f a -> Maybe (f a)
forall a. Different a => Diff a -> a -> Maybe a
patch Diff (f a)
δ f a
a
    patch (DiffR δ) (R1 a :: g a
a) = g a -> (:+:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (g a -> (:+:) f g a) -> Maybe (g a) -> Maybe ((:+:) f g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Diff (g a) -> g a -> Maybe (g a)
forall a. Different a => Diff a -> a -> Maybe a
patch Diff (g a)
δ g a
a
    patch (LR a b) (L1 a' :: f a
a') | f a
a f a -> f a -> Bool
forall a. Eq a => a -> a -> Bool
== f a
a' = (:+:) f g a -> Maybe ((:+:) f g a)
forall a. a -> Maybe a
Just (g a -> (:+:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 g a
b)
    patch (RL a b) (R1 a' :: g a
a') | g a
a g a -> g a -> Bool
forall a. Eq a => a -> a -> Bool
== g a
a' = (:+:) f g a -> Maybe ((:+:) f g a)
forall a. a -> Maybe a
Just (f a -> (:+:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 f a
b)
    patch _ _ = Maybe ((:+:) f g a)
forall a. Maybe a
Nothing

instance (Different (f a), Different (g a)) => Different ((f :*: g) a) where
    type Diff ((f :*: g) a) = (Diff (f a), Diff (g a))
    diff :: (:*:) f g a -> (:*:) f g a -> Diff ((:*:) f g a)
diff (a₁ :: f a
a₁ :*: a₂ :: g a
a₂) (b₁ :: f a
b₁ :*: b₂ :: g a
b₂) = (f a -> f a -> Diff (f a)
forall a. Different a => a -> a -> Diff a
diff f a
a₁ f a
b₁, g a -> g a -> Diff (g a)
forall a. Different a => a -> a -> Diff a
diff g a
a₂ g a
b₂)
    patch :: Diff ((:*:) f g a) -> (:*:) f g a -> Maybe ((:*:) f g a)
patch (δ₁, δ₂) (a₁ :: f a
a₁ :*: a₂ :: g a
a₂) = f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (f a -> g a -> (:*:) f g a)
-> Maybe (f a) -> Maybe (g a -> (:*:) f g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Diff (f a) -> f a -> Maybe (f a)
forall a. Different a => Diff a -> a -> Maybe a
patch Diff (f a)
δ₁ f a
a₁ Maybe (g a -> (:*:) f g a) -> Maybe (g a) -> Maybe ((:*:) f g a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Diff (g a) -> g a -> Maybe (g a)
forall a. Different a => Diff a -> a -> Maybe a
patch Diff (g a)
δ₂ g a
a₂

deriving newtype instance (Different (f (g a))) => Different ((f :.: g) a)

data SumDiff a b = DiffL (Diff a)
                 | DiffR (Diff b)
                 | LR a b
                 | RL b a

deriving instance (Eq a, Eq b, Eq (Diff a), Eq (Diff b)) => Eq (SumDiff a b)
deriving instance (Read a, Read b, Read (Diff a), Read (Diff b)) => Read (SumDiff a b)
deriving instance (Show a, Show b, Show (Diff a), Show (Diff b)) => Show (SumDiff a b)

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

deriving instance Different Void
deriving instance Different Bool
deriving instance Different Ordering

instance Different Integer where
    type Diff Integer = Integer
    diff :: Integer -> Integer -> Diff Integer
diff = (Integer -> Integer -> Integer) -> Integer -> Integer -> Integer
forall a b c. (a -> b -> c) -> b -> a -> c
flip (-)
    patch :: Diff Integer -> Integer -> Maybe Integer
patch = Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer)
-> (Integer -> Integer -> Integer)
-> Integer
-> Integer
-> Maybe Integer
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
∘∘ Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+)

instance Different Natural where
    type Diff Natural = Integer
    diff :: Natural -> Natural -> Diff Natural
diff = (Integer -> Integer -> Integer) -> Integer -> Integer -> Integer
forall a b c. (a -> b -> c) -> b -> a -> c
flip (-) (Integer -> Integer -> Integer)
-> (Natural -> Integer) -> Natural -> Natural -> Integer
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    patch :: Diff Natural -> Natural -> Maybe Natural
patch δ :: Diff Natural
δ a :: Natural
a = Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
b Natural -> Maybe () -> Maybe Natural
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Integer
b Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= 0)
      where b :: Integer
b = Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
Diff Natural
δ

instance Different Int where
    type Diff Int = Int
    diff :: Int -> Int -> Diff Int
diff = (Int -> Int -> Int) -> Int -> Int -> Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip (-)
    patch :: Diff Int -> Int -> Maybe Int
patch = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int)
-> (Int -> Int -> Int) -> Int -> Int -> Maybe Int
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
∘∘ Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)

instance Different Word where
    type Diff Word = Word
    diff :: Word -> Word -> Diff Word
diff = (Word -> Word -> Word) -> Word -> Word -> Word
forall a b c. (a -> b -> c) -> b -> a -> c
flip (-)
    patch :: Diff Word -> Word -> Maybe Word
patch = Word -> Maybe Word
forall a. a -> Maybe a
Just (Word -> Maybe Word)
-> (Word -> Word -> Word) -> Word -> Word -> Maybe Word
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
∘∘ Word -> Word -> Word
forall a. Num a => a -> a -> a
(+)

instance Different Int8 where
    type Diff Int8 = Int8
    diff :: Int8 -> Int8 -> Diff Int8
diff = (Int8 -> Int8 -> Int8) -> Int8 -> Int8 -> Int8
forall a b c. (a -> b -> c) -> b -> a -> c
flip (-)
    patch :: Diff Int8 -> Int8 -> Maybe Int8
patch = Int8 -> Maybe Int8
forall a. a -> Maybe a
Just (Int8 -> Maybe Int8)
-> (Int8 -> Int8 -> Int8) -> Int8 -> Int8 -> Maybe Int8
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
∘∘ Int8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
(+)

instance Different Word8 where
    type Diff Word8 = Word8
    diff :: Word8 -> Word8 -> Diff Word8
diff = (Word8 -> Word8 -> Word8) -> Word8 -> Word8 -> Word8
forall a b c. (a -> b -> c) -> b -> a -> c
flip (-)
    patch :: Diff Word8 -> Word8 -> Maybe Word8
patch = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (Word8 -> Maybe Word8)
-> (Word8 -> Word8 -> Word8) -> Word8 -> Word8 -> Maybe Word8
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
∘∘ Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
(+)

instance Different Int16 where
    type Diff Int16 = Int16
    diff :: Int16 -> Int16 -> Diff Int16
diff = (Int16 -> Int16 -> Int16) -> Int16 -> Int16 -> Int16
forall a b c. (a -> b -> c) -> b -> a -> c
flip (-)
    patch :: Diff Int16 -> Int16 -> Maybe Int16
patch = Int16 -> Maybe Int16
forall a. a -> Maybe a
Just (Int16 -> Maybe Int16)
-> (Int16 -> Int16 -> Int16) -> Int16 -> Int16 -> Maybe Int16
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
∘∘ Int16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
(+)

instance Different Word16 where
    type Diff Word16 = Word16
    diff :: Word16 -> Word16 -> Diff Word16
diff = (Word16 -> Word16 -> Word16) -> Word16 -> Word16 -> Word16
forall a b c. (a -> b -> c) -> b -> a -> c
flip (-)
    patch :: Diff Word16 -> Word16 -> Maybe Word16
patch = Word16 -> Maybe Word16
forall a. a -> Maybe a
Just (Word16 -> Maybe Word16)
-> (Word16 -> Word16 -> Word16) -> Word16 -> Word16 -> Maybe Word16
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
∘∘ Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
(+)

instance Different Int32 where
    type Diff Int32 = Int32
    diff :: Int32 -> Int32 -> Diff Int32
diff = (Int32 -> Int32 -> Int32) -> Int32 -> Int32 -> Int32
forall a b c. (a -> b -> c) -> b -> a -> c
flip (-)
    patch :: Diff Int32 -> Int32 -> Maybe Int32
patch = Int32 -> Maybe Int32
forall a. a -> Maybe a
Just (Int32 -> Maybe Int32)
-> (Int32 -> Int32 -> Int32) -> Int32 -> Int32 -> Maybe Int32
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
∘∘ Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
(+)

instance Different Word32 where
    type Diff Word32 = Word32
    diff :: Word32 -> Word32 -> Diff Word32
diff = (Word32 -> Word32 -> Word32) -> Word32 -> Word32 -> Word32
forall a b c. (a -> b -> c) -> b -> a -> c
flip (-)
    patch :: Diff Word32 -> Word32 -> Maybe Word32
patch = Word32 -> Maybe Word32
forall a. a -> Maybe a
Just (Word32 -> Maybe Word32)
-> (Word32 -> Word32 -> Word32) -> Word32 -> Word32 -> Maybe Word32
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
∘∘ Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
(+)

instance Different Int64 where
    type Diff Int64 = Int64
    diff :: Int64 -> Int64 -> Diff Int64
diff = (Int64 -> Int64 -> Int64) -> Int64 -> Int64 -> Int64
forall a b c. (a -> b -> c) -> b -> a -> c
flip (-)
    patch :: Diff Int64 -> Int64 -> Maybe Int64
patch = Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (Int64 -> Maybe Int64)
-> (Int64 -> Int64 -> Int64) -> Int64 -> Int64 -> Maybe Int64
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
∘∘ Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
(+)

instance Different Word64 where
    type Diff Word64 = Word64
    diff :: Word64 -> Word64 -> Diff Word64
diff = (Word64 -> Word64 -> Word64) -> Word64 -> Word64 -> Word64
forall a b c. (a -> b -> c) -> b -> a -> c
flip (-)
    patch :: Diff Word64 -> Word64 -> Maybe Word64
patch = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Word64 -> Maybe Word64)
-> (Word64 -> Word64 -> Word64) -> Word64 -> Word64 -> Maybe Word64
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
∘∘ Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
(+)

instance Different Char where
    type Diff Char = Int
    diff :: Char -> Char -> Diff Char
diff = (Int -> Int -> Int) -> Int -> Int -> Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip (-) (Int -> Int -> Int) -> (Char -> Int) -> Char -> Char -> Int
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Char -> Int
forall a. Enum a => a -> Int
fromEnum
    patch :: Diff Char -> Char -> Maybe Char
patch δ :: Diff Char
δ x :: Char
x = Integer -> Maybe Char
forall a. Enum a => Integer -> Maybe a
Util.toEnumMay (Integer -> Maybe Char) -> (Int -> Integer) -> Int -> Maybe Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Maybe Char) -> Int -> Maybe Char
forall a b. (a -> b) -> a -> b
$ Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
Diff Char
δ

deriving instance Different Version

deriving instance Different a => Different (Identity a)
deriving instance (Eq a, Different a) => Different (Maybe a)
deriving instance (Eq a, Different a) => Different [a]
deriving instance (Eq a, Different a) => Different (NonEmpty a)

deriving instance (Eq a, Different a, Eq b, Different b) => Different (Either a b)

deriving instance Different ()
deriving instance (Different a, Different b) => Different (a, b)
deriving instance (Different a, Different b, Different c) => Different (a, b, c)
deriving instance (Different a, Different b, Different c, Different d) => Different (a, b, c, d)
deriving instance (Different a, Different b, Different c, Different d, Different e) => Different (a, b, c, d, e)
deriving instance (Different a, Different b, Different c, Different d, Different e, Different f) => Different (a, b, c, d, e, f)
deriving instance (Different a, Different b, Different c, Different d, Different e, Different f, Different g) => Different (a, b, c, d, e, f, g)

deriving instance (Different (f a)) => Different (Alt f a)
deriving instance (Different a, Different b) => Different (Arg a b)

deriving instance Different (Proxy a)
deriving instance Different a => Different (Const a b)

deriving instance Different (f (g a)) => Different (Compose f g a)
deriving instance (Different (f a), Different (g a)) => Different (Product f g a)
deriving instance (Different (f a), Eq (f a), Different (g a), Eq (g a)) => Different (Sum f g a)