{-# OPTIONS_GHC -Wno-orphans #-}

{- | A worked example of implementing 'SpecialDiff' (and thereby 'Diff') for 'Set's.

We make the choice to prioritise speed over exhaustiveness: in other words we stop when we find
one difference between the two input sets. Alternatively, we could have gone the other way and
enumerated all the difference between the inputs, using some kind of intersection test. This is left
as an exercise for the reader.

Note that the implementation for maps in "Generics.Diff.Special.Map" is very similar; this is since a
@'Set' k@ can be seen as equivalent to @Map k ()@.
-}
module Generics.Diff.Special.Set
  ( SetDiffError (..)
  )
where

import Control.Applicative ((<|>))
import Data.Set (Set)
import qualified Data.Set.Internal as Set
import Generics.Diff
import Generics.Diff.Render
import Generics.Diff.Special

-- | For 'Set's, we only pick out (maximum) one difference between the two inputs. There are two possibilities:
data SetDiffError k
  = -- | The right set contains an element that isn't found in the left set
    LeftMissingKey k
  | -- | The left set contains an element that isn't found in the right set
    RightMissingKey k
  deriving (Int -> SetDiffError k -> ShowS
[SetDiffError k] -> ShowS
SetDiffError k -> String
(Int -> SetDiffError k -> ShowS)
-> (SetDiffError k -> String)
-> ([SetDiffError k] -> ShowS)
-> Show (SetDiffError k)
forall k. Show k => Int -> SetDiffError k -> ShowS
forall k. Show k => [SetDiffError k] -> ShowS
forall k. Show k => SetDiffError k -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall k. Show k => Int -> SetDiffError k -> ShowS
showsPrec :: Int -> SetDiffError k -> ShowS
$cshow :: forall k. Show k => SetDiffError k -> String
show :: SetDiffError k -> String
$cshowList :: forall k. Show k => [SetDiffError k] -> ShowS
showList :: [SetDiffError k] -> ShowS
Show, SetDiffError k -> SetDiffError k -> Bool
(SetDiffError k -> SetDiffError k -> Bool)
-> (SetDiffError k -> SetDiffError k -> Bool)
-> Eq (SetDiffError k)
forall k. Eq k => SetDiffError k -> SetDiffError k -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall k. Eq k => SetDiffError k -> SetDiffError k -> Bool
== :: SetDiffError k -> SetDiffError k -> Bool
$c/= :: forall k. Eq k => SetDiffError k -> SetDiffError k -> Bool
/= :: SetDiffError k -> SetDiffError k -> Bool
Eq)

{- | Render a 'SetDiffError'. This is a top-level function because we'll use it in the implementations
of 'renderSpecialDiffError' for both 'Set' and 'Data.IntSet.IntSet'.

There are no nested 'DiffError's here, so we use 'linesDoc'.
-}
setDiffErrorDoc :: (Show k) => SetDiffError k -> Doc
setDiffErrorDoc :: forall k. Show k => SetDiffError k -> Doc
setDiffErrorDoc = \case
  LeftMissingKey k
k ->
    NonEmpty Builder -> Doc
linesDoc (NonEmpty Builder -> Doc) -> NonEmpty Builder -> Doc
forall a b. (a -> b) -> a -> b
$ Builder -> NonEmpty Builder
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> NonEmpty Builder) -> Builder -> NonEmpty Builder
forall a b. (a -> b) -> a -> b
$ Builder
"The right set contains key " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> k -> Builder
forall a. Show a => a -> Builder
showB k
k Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" but the left doesn't"
  RightMissingKey k
k ->
    NonEmpty Builder -> Doc
linesDoc (NonEmpty Builder -> Doc) -> NonEmpty Builder -> Doc
forall a b. (a -> b) -> a -> b
$ Builder -> NonEmpty Builder
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> NonEmpty Builder) -> Builder -> NonEmpty Builder
forall a b. (a -> b) -> a -> b
$ Builder
"The left set contains key " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> k -> Builder
forall a. Show a => a -> Builder
showB k
k Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" but the right doesn't"

-- First we define an instance of 'SpecialDiff'. We need 'Show' and 'Eq' so that 'SetDiffError'
-- also has these instances; we need 'Ord' to compare elements of the set.
instance (Show k, Eq k, Ord k) => SpecialDiff (Set k) where
  type SpecialDiffError (Set k) = SetDiffError k

  -- base cases
  specialDiff :: Set k -> Set k -> Maybe (SpecialDiffError (Set k))
specialDiff Set k
Set.Tip Set k
Set.Tip = Maybe (SpecialDiffError (Set k))
Maybe (SetDiffError k)
forall a. Maybe a
Nothing
  specialDiff Set k
Set.Tip (Set.Bin Int
_ k
k Set k
_ Set k
_) = SpecialDiffError (Set k) -> Maybe (SpecialDiffError (Set k))
forall a. a -> Maybe a
Just (SpecialDiffError (Set k) -> Maybe (SpecialDiffError (Set k)))
-> SpecialDiffError (Set k) -> Maybe (SpecialDiffError (Set k))
forall a b. (a -> b) -> a -> b
$ k -> SetDiffError k
forall k. k -> SetDiffError k
LeftMissingKey k
k
  specialDiff (Set.Bin Int
_ k
k Set k
_ Set k
_) Set k
Set.Tip = SpecialDiffError (Set k) -> Maybe (SpecialDiffError (Set k))
forall a. a -> Maybe a
Just (SpecialDiffError (Set k) -> Maybe (SpecialDiffError (Set k)))
-> SpecialDiffError (Set k) -> Maybe (SpecialDiffError (Set k))
forall a b. (a -> b) -> a -> b
$ k -> SetDiffError k
forall k. k -> SetDiffError k
RightMissingKey k
k
  -- recursive step, using Set.split
  specialDiff (Set.Bin Int
_ k
k Set k
left Set k
right) Set k
r =
    if k -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember k
k Set k
r
      then SpecialDiffError (Set k) -> Maybe (SpecialDiffError (Set k))
forall a. a -> Maybe a
Just (SpecialDiffError (Set k) -> Maybe (SpecialDiffError (Set k)))
-> SpecialDiffError (Set k) -> Maybe (SpecialDiffError (Set k))
forall a b. (a -> b) -> a -> b
$ k -> SetDiffError k
forall k. k -> SetDiffError k
RightMissingKey k
k
      else
        let (Set k
less, Set k
more) = k -> Set k -> (Set k, Set k)
forall a. Ord a => a -> Set a -> (Set a, Set a)
Set.split k
k Set k
r
        in  Set k -> Set k -> Maybe (SpecialDiffError (Set k))
forall a. SpecialDiff a => a -> a -> Maybe (SpecialDiffError a)
specialDiff Set k
left Set k
less Maybe (SetDiffError k)
-> Maybe (SetDiffError k) -> Maybe (SetDiffError k)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Set k -> Set k -> Maybe (SpecialDiffError (Set k))
forall a. SpecialDiff a => a -> a -> Maybe (SpecialDiffError a)
specialDiff Set k
right Set k
more

  renderSpecialDiffError :: SpecialDiffError (Set k) -> Doc
renderSpecialDiffError = SpecialDiffError (Set k) -> Doc
SetDiffError k -> Doc
forall k. Show k => SetDiffError k -> Doc
setDiffErrorDoc

-- Now we can implement 'Diff' using 'diffWithSpecial'.
instance (Show k, Ord k) => Diff (Set k) where
  diff :: Set k -> Set k -> DiffResult (Set k)
diff = Set k -> Set k -> DiffResult (Set k)
forall a. SpecialDiff a => a -> a -> DiffResult a
diffWithSpecial