-
Notifications
You must be signed in to change notification settings - Fork 0
/
GDiffable.hs
67 lines (54 loc) · 2.37 KB
/
GDiffable.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Apie.Diff.GDiffable (Diffable, apply, diff) where
import RIO hiding (to)
import Data.Kind (Type)
import GHC.Generics
import Apie.Diff.Types (Diff(..))
class Diffable (t :: (Type -> Type) -> Type) where
diff :: t Identity -> t Identity -> t Diff
default diff :: ( Generic (t Identity)
, Generic (t Diff)
, GDiffable (Rep (t Identity)) (Rep (t Diff)))
=> t Identity -> t Identity -> t Diff
diff a b = to $ genericDiff (from a) (from b)
apply :: t Identity -> t Diff -> t Identity
default apply :: ( Generic (t Identity)
, Generic (t Diff)
, GDiffable (Rep (t Identity)) (Rep (t Diff)))
=> t Identity -> t Diff -> t Identity
apply a b = to $ genericApply (from a) (from b)
class GDiffable f g where
genericDiff :: f (t Identity) -> f (t Identity) -> g (t Diff)
genericApply :: f (t Identity) -> g (t Diff) -> f (t Identity)
instance GDiffable U1 U1 where
genericDiff _ _ = U1
genericApply _ _ = U1
instance GDiffable f g => GDiffable (D1 c f) (D1 c g) where
genericDiff (M1 a) (M1 b) = M1 (genericDiff a b)
genericApply (M1 a) (M1 b) = M1 (genericApply a b)
instance GDiffable f g => GDiffable (C1 c f) (C1 c g) where
genericDiff (M1 a) (M1 b) = M1 (genericDiff a b)
genericApply (M1 a) (M1 b) = M1 (genericApply a b)
instance GDiffable f g => GDiffable (S1 s f) (S1 s g) where
genericDiff (M1 a) (M1 b) = M1 (genericDiff a b)
genericApply (M1 a) (M1 b) = M1 (genericApply a b)
instance (GDiffable f1 g1, GDiffable f2 g2) => GDiffable (f1 :*: f2) (g1 :*: g2) where
genericDiff (a1 :*: a2) (b1 :*: b2) =
genericDiff a1 b1 :*: genericDiff a2 b2
genericApply (a1 :*: a2) (b1 :*: b2) =
genericApply a1 b1 :*: genericApply a2 b2
instance Eq a => GDiffable (K1 i a) (K1 i (Diff a)) where
genericDiff (K1 a) (K1 b)
| a == b = K1 Unchanged
| otherwise = K1 (Changed b)
genericApply (K1 x) (K1 Unchanged) = K1 x
genericApply (K1 _) (K1 (Changed x)) = K1 x
instance GDiffable (K1 i a) (K1 i a) where
genericDiff (K1 _) (K1 x) = K1 x
genericApply (K1 _) (K1 x) = K1 x