src/Data/Patch/Patchable.hs · patch

on patchable help sign in

patch/src/Data/Patch/Patchable.hs

46 lines 1.4 kB history raw

1{-# LANGUAGE CPP #-}

2{-# LANGUAGE DeriveGeneric #-}

3{-# LANGUAGE FlexibleContexts #-}

4{-# LANGUAGE FlexibleInstances #-}

5{-# LANGUAGE LambdaCase #-}

6{-# LANGUAGE StandaloneDeriving #-}

7{-# LANGUAGE UndecidableInstances #-}

9module Data.Patch.Patchable where

11import Data.Patch

12#if !MIN_VERSION_base(4,11,0)

13import Data.Semigroup (Semigroup (..))

14#endif

15import GHC.Generics

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

18data Patchable p

19 = Patchable_Patch p

20 | Patchable_Complete (PatchTarget p)

21 deriving (Generic)

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

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

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

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

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

29completePatchable = \case

30 Patchable_Complete t -> Just t

31 Patchable_Patch _ -> Nothing

33instance ( 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 = (<>)

42instance (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