@@ -0,0 +1,46 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE DeriveGeneric #-}
3+{-# LANGUAGE FlexibleContexts #-}
4+{-# LANGUAGE FlexibleInstances #-}
5+{-# LANGUAGE LambdaCase #-}
6+{-# LANGUAGE StandaloneDeriving #-}
7+{-# LANGUAGE UndecidableInstances #-}
8+
9+module Data.Patch.Patchable where
10+
11+import Data.Patch
12+#if !MIN_VERSION_base(4,11,0)
13+import Data.Semigroup (Semigroup (..))
14+#endif
15+import GHC.Generics
16+
17+-- | Like SemiMap/PartialMap but for anything patchable
18+data Patchable p
19+ = Patchable_Patch p
20+ | Patchable_Complete (PatchTarget p)
21+ deriving (Generic)
22+
23+deriving instance (Eq p, Eq (PatchTarget p)) => Eq (Patchable p)
24+deriving instance (Ord p, Ord (PatchTarget p)) => Ord (Patchable p)
25+deriving instance (Show p, Show (PatchTarget p)) => Show (Patchable p)
26+deriving instance (Read p, Read (PatchTarget p)) => Read (Patchable p)
27+
28+completePatchable :: Patchable p -> Maybe (PatchTarget p)
29+completePatchable = \case
30+ Patchable_Complete t -> Just t
31+ Patchable_Patch _ -> Nothing
32+
33+instance ( Monoid p
34+#if !MIN_VERSION_base(4,11,0)
35+ , Semigroup p
36+#endif
37+ , Patch p
38+ ) => Monoid (Patchable p) where
39+ mempty = Patchable_Patch mempty
40+ mappend = (<>)
41+
42+instance (Semigroup p, Patch p) => Semigroup (Patchable p) where
43+ (<>) = curry $ \case
44+ (Patchable_Patch a, Patchable_Patch b) -> Patchable_Patch $ a <> b
45+ (Patchable_Patch a, Patchable_Complete b) -> Patchable_Complete $ applyAlways a b
46+ (Patchable_Complete a, _) -> Patchable_Complete a