{-# OPTIONS_GHC -Wno-orphans #-}

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

We make the choice to prioritise speed over exhaustiveness: in other words we stop when we find
one difference between the two input maps. 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.
-}
module Generics.Diff.Special.Map
  ( MapDiffError (..)
  )
where

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

-- | For 'Map's, we only pick out (maximum) one difference between the two inputs. There are three possibilities:
data MapDiffError k v
  = -- | A key is found in both maps, but they have different values.
    DiffAtKey k (DiffError v)
  | -- | 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 -> MapDiffError k v -> ShowS
[MapDiffError k v] -> ShowS
MapDiffError k v -> String
(Int -> MapDiffError k v -> ShowS)
-> (MapDiffError k v -> String)
-> ([MapDiffError k v] -> ShowS)
-> Show (MapDiffError k v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k v. Show k => Int -> MapDiffError k v -> ShowS
forall k v. Show k => [MapDiffError k v] -> ShowS
forall k v. Show k => MapDiffError k v -> String
$cshowsPrec :: forall k v. Show k => Int -> MapDiffError k v -> ShowS
showsPrec :: Int -> MapDiffError k v -> ShowS
$cshow :: forall k v. Show k => MapDiffError k v -> String
show :: MapDiffError k v -> String
$cshowList :: forall k v. Show k => [MapDiffError k v] -> ShowS
showList :: [MapDiffError k v] -> ShowS
Show, MapDiffError k v -> MapDiffError k v -> Bool
(MapDiffError k v -> MapDiffError k v -> Bool)
-> (MapDiffError k v -> MapDiffError k v -> Bool)
-> Eq (MapDiffError k v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k v. Eq k => MapDiffError k v -> MapDiffError k v -> Bool
$c== :: forall k v. Eq k => MapDiffError k v -> MapDiffError k v -> Bool
== :: MapDiffError k v -> MapDiffError k v -> Bool
$c/= :: forall k v. Eq k => MapDiffError k v -> MapDiffError k v -> Bool
/= :: MapDiffError k v -> MapDiffError k v -> Bool
Eq)

{- | Render a 'MapDiffError'. This is a top-level function because we'll use it in the implementations
of 'renderSpecialDiffError' for both 'Map' and 'Data.IntMap.IntMap'.
-}
mapDiffErrorDoc :: (Show k) => MapDiffError k v -> Doc
mapDiffErrorDoc :: forall k v. Show k => MapDiffError k v -> Doc
mapDiffErrorDoc = \case
  -- Since we have a nested 'DiffError' on the value, we use 'makeDoc'.
  DiffAtKey k
k DiffError v
err ->
    let lns :: NonEmpty Builder
lns = Builder -> NonEmpty Builder
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder
"Both maps contain 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 values differ:")
    in  NonEmpty Builder -> DiffError v -> Doc
forall a. NonEmpty Builder -> DiffError a -> Doc
makeDoc NonEmpty Builder
lns DiffError v
err
  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 map 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 map 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"

instance (Show k, Ord k, Diff v) => SpecialDiff (Map k v) where
  type SpecialDiffError (Map k v) = MapDiffError k v

  -- base cases
  specialDiff :: Map k v -> Map k v -> Maybe (SpecialDiffError (Map k v))
specialDiff Map k v
Map.Tip Map k v
Map.Tip = Maybe (SpecialDiffError (Map k v))
Maybe (MapDiffError k v)
forall a. Maybe a
Nothing
  specialDiff Map k v
Map.Tip (Map.Bin Int
_ k
k v
_ Map k v
_ Map k v
_) = SpecialDiffError (Map k v) -> Maybe (SpecialDiffError (Map k v))
forall a. a -> Maybe a
Just (SpecialDiffError (Map k v) -> Maybe (SpecialDiffError (Map k v)))
-> SpecialDiffError (Map k v) -> Maybe (SpecialDiffError (Map k v))
forall a b. (a -> b) -> a -> b
$ k -> MapDiffError k v
forall k v. k -> MapDiffError k v
LeftMissingKey k
k
  specialDiff (Map.Bin Int
_ k
k v
_ Map k v
_ Map k v
_) Map k v
Map.Tip = SpecialDiffError (Map k v) -> Maybe (SpecialDiffError (Map k v))
forall a. a -> Maybe a
Just (SpecialDiffError (Map k v) -> Maybe (SpecialDiffError (Map k v)))
-> SpecialDiffError (Map k v) -> Maybe (SpecialDiffError (Map k v))
forall a b. (a -> b) -> a -> b
$ k -> MapDiffError k v
forall k v. k -> MapDiffError k v
RightMissingKey k
k
  -- recursive set, using Map.split
  specialDiff (Map.Bin Int
_ k
k v
lVal Map k v
left Map k v
right) Map k v
r = case k -> Map k v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map k v
r of
    Maybe v
Nothing -> SpecialDiffError (Map k v) -> Maybe (SpecialDiffError (Map k v))
forall a. a -> Maybe a
Just (SpecialDiffError (Map k v) -> Maybe (SpecialDiffError (Map k v)))
-> SpecialDiffError (Map k v) -> Maybe (SpecialDiffError (Map k v))
forall a b. (a -> b) -> a -> b
$ k -> MapDiffError k v
forall k v. k -> MapDiffError k v
RightMissingKey k
k
    Just v
rVal ->
      -- first we check if the values are different (using the 'Diff' instance on v)
      case v -> v -> DiffResult v
forall a. Diff a => a -> a -> DiffResult a
diff v
lVal v
rVal of
        Error DiffError v
err -> SpecialDiffError (Map k v) -> Maybe (SpecialDiffError (Map k v))
forall a. a -> Maybe a
Just (SpecialDiffError (Map k v) -> Maybe (SpecialDiffError (Map k v)))
-> SpecialDiffError (Map k v) -> Maybe (SpecialDiffError (Map k v))
forall a b. (a -> b) -> a -> b
$ k -> DiffError v -> MapDiffError k v
forall k v. k -> DiffError v -> MapDiffError k v
DiffAtKey k
k DiffError v
err
        DiffResult v
Equal ->
          -- otherwise, split and recurse
          let (Map k v
less, Map k v
more) = k -> Map k v -> (Map k v, Map k v)
forall k a. Ord k => k -> Map k a -> (Map k a, Map k a)
Map.split k
k Map k v
r
          in  Map k v -> Map k v -> Maybe (SpecialDiffError (Map k v))
forall a. SpecialDiff a => a -> a -> Maybe (SpecialDiffError a)
specialDiff Map k v
left Map k v
less Maybe (MapDiffError k v)
-> Maybe (MapDiffError k v) -> Maybe (MapDiffError k v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Map k v -> Map k v -> Maybe (SpecialDiffError (Map k v))
forall a. SpecialDiff a => a -> a -> Maybe (SpecialDiffError a)
specialDiff Map k v
right Map k v
more

  renderSpecialDiffError :: SpecialDiffError (Map k v) -> Doc
renderSpecialDiffError = SpecialDiffError (Map k v) -> Doc
MapDiffError k v -> Doc
forall k v. Show k => MapDiffError k v -> Doc
mapDiffErrorDoc

instance (Show k, Ord k, Diff v) => Diff (Map k v) where
  diff :: Map k v -> Map k v -> DiffResult (Map k v)
diff = Map k v -> Map k v -> DiffResult (Map k v)
forall a. SpecialDiff a => a -> a -> DiffResult a
diffWithSpecial