src/Data/Patch/Patchable.hs · patch

on patch-dmap-reset help sign in

patch/src/Data/Patch/Patchable.hs

45 lines 1.6 kB history raw

1{-# LANGUAGE DeriveGeneric #-}

2{-# LANGUAGE FlexibleContexts #-}

3{-# LANGUAGE LambdaCase #-}

4{-# LANGUAGE StandaloneDeriving #-}

5{-# LANGUAGE TypeFamilies #-}

7-- The derived instances are undecidable in the case of a pathological instance like

8-- instance Patch x where

9-- type PatchTarget x = Patchable x

10{-# LANGUAGE UndecidableInstances #-}

12module Data.Patch.Patchable where

14-- import Data.Aeson

15import GHC.Generics

17import Data.Patch

19-- | Like SemiMap/PartialMap but for anything patchable

20data Patchable p

21 = Patchable_Patch p

22 | Patchable_Complete (PatchTarget p)

23 deriving (Generic)

25completePatchable :: Patchable p -> Maybe (PatchTarget p)

26completePatchable = \case

27 Patchable_Complete t -> Just t

28 Patchable_Patch _ -> Nothing

30deriving instance (Eq p, Eq (PatchTarget p)) => Eq (Patchable p)

31deriving instance (Ord p, Ord (PatchTarget p)) => Ord (Patchable p)

32deriving instance (Show p, Show (PatchTarget p)) => Show (Patchable p)

33deriving instance (Read p, Read (PatchTarget p)) => Read (Patchable p)

34-- instance (ToJSON p, ToJSON (PatchTarget p)) => ToJSON (Patchable p)

35-- instance (FromJSON p, FromJSON (PatchTarget p)) => FromJSON (Patchable p)

37instance (Monoid p, Patch p) => Monoid (Patchable p) where

38 mempty = Patchable_Patch mempty

39 mappend = (<>)

41instance (Semigroup p, Patch p) => Semigroup (Patchable p) where

42 (<>) = curry $ \case

43 (Patchable_Patch a, Patchable_Patch b) -> Patchable_Patch $ a <> b

44 (Patchable_Patch a, Patchable_Complete b) -> Patchable_Complete $ applyAlways a b

45 (Patchable_Complete a, _) -> Patchable_Complete a