{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Pattern reconciliation for normalizing duplicate identities.
--
-- This module provides operations to reconcile patterns by resolving duplicate
-- identities and completing partial references. When patterns are parsed, streamed,
-- or merged from multiple sources, the same identity may appear multiple times
-- with different or evolving content. Reconciliation transforms such patterns into
-- coherent ones where each identity appears exactly once.
--
-- == Problem Statement
--
-- Currently nothing prevents the same identity from appearing multiple times with
-- different content in a @Pattern v@. This can arise from:
--
-- * Parsing gram notation with duplicate node definitions
-- * Streaming pattern updates where identities evolve over time
-- * Merging patterns from different sources
-- * References: atomic patterns pointing to fuller definitions elsewhere
--
-- == Solution Overview
--
-- The 'reconcile' operation normalizes patterns using configurable policies:
--
-- 1. **Collect**: Group all occurrences by identity
-- 2. **Reconcile**: Resolve duplicates according to policy
-- 3. **Rebuild**: Construct normalized pattern with each identity appearing once
--
-- == Quick Start
--
-- >>> import Pattern.Core (Pattern(..), pattern, point)
-- >>> import Pattern.Reconcile
-- >>> import Subject.Core (Subject(..), Symbol(..))
-- >>>
-- >>> -- Reconcile with LastWriteWins policy
-- >>> reconcile LastWriteWins patternWithDuplicates
-- >>>
-- >>> -- Get detailed report
-- >>> let (result, report) = reconcileWithReport LastWriteWins pattern
-- >>> reportDuplicatesFound report  -- Number of duplicate identities
--
-- == Reconciliation Policies
--
-- * 'LastWriteWins' - Keep the last occurrence of each identity. Useful for
--   streaming updates where the most recent value is authoritative.
--
-- * 'FirstWriteWins' - Keep the first occurrence of each identity. Useful when
--   initial definitions are authoritative.
--
-- * @'Merge' elementStrategy valueStrategy@ - Combine all occurrences using configurable
--   strategies for structure (elements) and content (value).
--
-- * 'Strict' - Fail with detailed error if any duplicates have different content.
--   Useful for validation and debugging.

module Pattern.Reconcile
  ( -- * Core Abstractions
    HasIdentity(..)
  , Mergeable(..)
  , Refinable(..)

    -- * Reconciliation Policies
  , ReconciliationPolicy(..)
  , ElementMergeStrategy(..)
  , SubjectMergeStrategy(..)
  , LabelMerge(..)
  , PropertyMerge(..)
  , defaultSubjectMergeStrategy

    -- * Error and Report Types
  , Conflict(..)
  , ReconcileError(..)
  , ReconcileReport(..)
  , Path

    -- * Reconciliation Operations
  , reconcile
  , reconcileWithReport

    -- * Inspection
  , needsReconciliation
  , findConflicts
  , collectByIdentity

    -- * Utilities
  , isReference
  ) where

import GHC.Generics (Generic)
import Data.Kind (Type)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Set (Set)
import qualified Data.Set as Set
import Subject.Core (Subject(Subject, labels, properties), Symbol)
import qualified Subject.Core as Subject
import Pattern.Core (Pattern(..))

-- -----------------------------------------------------------------------------
-- Core Abstractions
-- -----------------------------------------------------------------------------

-- | Allows extracting a unique identifier from a value.
class Ord i => HasIdentity v i | v -> i where
  identity :: v -> i

-- | Allows merging two values according to a strategy.
class Mergeable v where
  -- | Configuration for how to merge this specific type
  type MergeStrategy v :: Type
  
  -- | Merge two values. 
  -- The first value is the "accumulated" or "existing" one, 
  -- the second is the "incoming" one.
  merge :: MergeStrategy v -> v -> v -> v

-- | Allows checking if one value is a "partial" version of another.
class Refinable v where
  -- | Returns True if 'sub' contains a subset of the information in 'sup'.
  -- Used to detect if an atomic pattern is a reference to a full definition.
  isRefinementOf :: v {- sup -} -> v {- sub -} -> Bool

-- -----------------------------------------------------------------------------
-- Reconciliation Policy
-- -----------------------------------------------------------------------------

-- | Policy for resolving duplicate identities during reconciliation.
--
-- When a pattern contains the same identity multiple times (determined by
-- comparing 'identity' values), a reconciliation policy determines how to
-- combine or choose between the duplicate occurrences.
--
-- The type parameter @s@ is the value-specific merge strategy (e.g., 'SubjectMergeStrategy').
data ReconciliationPolicy s
  = LastWriteWins
  -- ^ Keep the last occurrence of each identity.
  -- Useful for streaming updates where the most recent value is authoritative.
  | FirstWriteWins
  -- ^ Keep the first occurrence of each identity.
  -- Useful when initial definitions are authoritative and later ones are ignored.
  | Merge ElementMergeStrategy s
  -- ^ Combine all occurrences using specified strategies for elements and values.
  | Strict
  -- ^ Fail if any duplicate identities have different content.
  deriving (ReconciliationPolicy s -> ReconciliationPolicy s -> Bool
(ReconciliationPolicy s -> ReconciliationPolicy s -> Bool)
-> (ReconciliationPolicy s -> ReconciliationPolicy s -> Bool)
-> Eq (ReconciliationPolicy s)
forall s.
Eq s =>
ReconciliationPolicy s -> ReconciliationPolicy s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall s.
Eq s =>
ReconciliationPolicy s -> ReconciliationPolicy s -> Bool
== :: ReconciliationPolicy s -> ReconciliationPolicy s -> Bool
$c/= :: forall s.
Eq s =>
ReconciliationPolicy s -> ReconciliationPolicy s -> Bool
/= :: ReconciliationPolicy s -> ReconciliationPolicy s -> Bool
Eq, Int -> ReconciliationPolicy s -> ShowS
[ReconciliationPolicy s] -> ShowS
ReconciliationPolicy s -> String
(Int -> ReconciliationPolicy s -> ShowS)
-> (ReconciliationPolicy s -> String)
-> ([ReconciliationPolicy s] -> ShowS)
-> Show (ReconciliationPolicy s)
forall s. Show s => Int -> ReconciliationPolicy s -> ShowS
forall s. Show s => [ReconciliationPolicy s] -> ShowS
forall s. Show s => ReconciliationPolicy s -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall s. Show s => Int -> ReconciliationPolicy s -> ShowS
showsPrec :: Int -> ReconciliationPolicy s -> ShowS
$cshow :: forall s. Show s => ReconciliationPolicy s -> String
show :: ReconciliationPolicy s -> String
$cshowList :: forall s. Show s => [ReconciliationPolicy s] -> ShowS
showList :: [ReconciliationPolicy s] -> ShowS
Show, (forall x.
 ReconciliationPolicy s -> Rep (ReconciliationPolicy s) x)
-> (forall x.
    Rep (ReconciliationPolicy s) x -> ReconciliationPolicy s)
-> Generic (ReconciliationPolicy s)
forall x. Rep (ReconciliationPolicy s) x -> ReconciliationPolicy s
forall x. ReconciliationPolicy s -> Rep (ReconciliationPolicy s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall s x.
Rep (ReconciliationPolicy s) x -> ReconciliationPolicy s
forall s x.
ReconciliationPolicy s -> Rep (ReconciliationPolicy s) x
$cfrom :: forall s x.
ReconciliationPolicy s -> Rep (ReconciliationPolicy s) x
from :: forall x. ReconciliationPolicy s -> Rep (ReconciliationPolicy s) x
$cto :: forall s x.
Rep (ReconciliationPolicy s) x -> ReconciliationPolicy s
to :: forall x. Rep (ReconciliationPolicy s) x -> ReconciliationPolicy s
Generic)

-- | Strategy for merging the children (elements) of a pattern.
data ElementMergeStrategy
  = ReplaceElements
  -- ^ Later element list completely replaces earlier ones.
  | AppendElements
  -- ^ Concatenate all element lists in traversal order.
  | UnionElements
  -- ^ Deduplicate elements by identity.
  deriving (ElementMergeStrategy -> ElementMergeStrategy -> Bool
(ElementMergeStrategy -> ElementMergeStrategy -> Bool)
-> (ElementMergeStrategy -> ElementMergeStrategy -> Bool)
-> Eq ElementMergeStrategy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ElementMergeStrategy -> ElementMergeStrategy -> Bool
== :: ElementMergeStrategy -> ElementMergeStrategy -> Bool
$c/= :: ElementMergeStrategy -> ElementMergeStrategy -> Bool
/= :: ElementMergeStrategy -> ElementMergeStrategy -> Bool
Eq, Int -> ElementMergeStrategy -> ShowS
[ElementMergeStrategy] -> ShowS
ElementMergeStrategy -> String
(Int -> ElementMergeStrategy -> ShowS)
-> (ElementMergeStrategy -> String)
-> ([ElementMergeStrategy] -> ShowS)
-> Show ElementMergeStrategy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ElementMergeStrategy -> ShowS
showsPrec :: Int -> ElementMergeStrategy -> ShowS
$cshow :: ElementMergeStrategy -> String
show :: ElementMergeStrategy -> String
$cshowList :: [ElementMergeStrategy] -> ShowS
showList :: [ElementMergeStrategy] -> ShowS
Show, (forall x. ElementMergeStrategy -> Rep ElementMergeStrategy x)
-> (forall x. Rep ElementMergeStrategy x -> ElementMergeStrategy)
-> Generic ElementMergeStrategy
forall x. Rep ElementMergeStrategy x -> ElementMergeStrategy
forall x. ElementMergeStrategy -> Rep ElementMergeStrategy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ElementMergeStrategy -> Rep ElementMergeStrategy x
from :: forall x. ElementMergeStrategy -> Rep ElementMergeStrategy x
$cto :: forall x. Rep ElementMergeStrategy x -> ElementMergeStrategy
to :: forall x. Rep ElementMergeStrategy x -> ElementMergeStrategy
Generic)

-- -----------------------------------------------------------------------------
-- Subject Implementation
-- -----------------------------------------------------------------------------

instance HasIdentity Subject Symbol where
  identity :: Subject -> Symbol
identity = Subject -> Symbol
Subject.identity

-- | Strategy for merging Subject content.
data SubjectMergeStrategy = SubjectMergeStrategy
  { SubjectMergeStrategy -> LabelMerge
labelMerge    :: LabelMerge
  , SubjectMergeStrategy -> PropertyMerge
propertyMerge :: PropertyMerge
  } deriving (SubjectMergeStrategy -> SubjectMergeStrategy -> Bool
(SubjectMergeStrategy -> SubjectMergeStrategy -> Bool)
-> (SubjectMergeStrategy -> SubjectMergeStrategy -> Bool)
-> Eq SubjectMergeStrategy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SubjectMergeStrategy -> SubjectMergeStrategy -> Bool
== :: SubjectMergeStrategy -> SubjectMergeStrategy -> Bool
$c/= :: SubjectMergeStrategy -> SubjectMergeStrategy -> Bool
/= :: SubjectMergeStrategy -> SubjectMergeStrategy -> Bool
Eq, Int -> SubjectMergeStrategy -> ShowS
[SubjectMergeStrategy] -> ShowS
SubjectMergeStrategy -> String
(Int -> SubjectMergeStrategy -> ShowS)
-> (SubjectMergeStrategy -> String)
-> ([SubjectMergeStrategy] -> ShowS)
-> Show SubjectMergeStrategy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubjectMergeStrategy -> ShowS
showsPrec :: Int -> SubjectMergeStrategy -> ShowS
$cshow :: SubjectMergeStrategy -> String
show :: SubjectMergeStrategy -> String
$cshowList :: [SubjectMergeStrategy] -> ShowS
showList :: [SubjectMergeStrategy] -> ShowS
Show, (forall x. SubjectMergeStrategy -> Rep SubjectMergeStrategy x)
-> (forall x. Rep SubjectMergeStrategy x -> SubjectMergeStrategy)
-> Generic SubjectMergeStrategy
forall x. Rep SubjectMergeStrategy x -> SubjectMergeStrategy
forall x. SubjectMergeStrategy -> Rep SubjectMergeStrategy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SubjectMergeStrategy -> Rep SubjectMergeStrategy x
from :: forall x. SubjectMergeStrategy -> Rep SubjectMergeStrategy x
$cto :: forall x. Rep SubjectMergeStrategy x -> SubjectMergeStrategy
to :: forall x. Rep SubjectMergeStrategy x -> SubjectMergeStrategy
Generic)

data LabelMerge = UnionLabels | IntersectLabels | ReplaceLabels
  deriving (LabelMerge -> LabelMerge -> Bool
(LabelMerge -> LabelMerge -> Bool)
-> (LabelMerge -> LabelMerge -> Bool) -> Eq LabelMerge
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LabelMerge -> LabelMerge -> Bool
== :: LabelMerge -> LabelMerge -> Bool
$c/= :: LabelMerge -> LabelMerge -> Bool
/= :: LabelMerge -> LabelMerge -> Bool
Eq, Int -> LabelMerge -> ShowS
[LabelMerge] -> ShowS
LabelMerge -> String
(Int -> LabelMerge -> ShowS)
-> (LabelMerge -> String)
-> ([LabelMerge] -> ShowS)
-> Show LabelMerge
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LabelMerge -> ShowS
showsPrec :: Int -> LabelMerge -> ShowS
$cshow :: LabelMerge -> String
show :: LabelMerge -> String
$cshowList :: [LabelMerge] -> ShowS
showList :: [LabelMerge] -> ShowS
Show, (forall x. LabelMerge -> Rep LabelMerge x)
-> (forall x. Rep LabelMerge x -> LabelMerge) -> Generic LabelMerge
forall x. Rep LabelMerge x -> LabelMerge
forall x. LabelMerge -> Rep LabelMerge x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LabelMerge -> Rep LabelMerge x
from :: forall x. LabelMerge -> Rep LabelMerge x
$cto :: forall x. Rep LabelMerge x -> LabelMerge
to :: forall x. Rep LabelMerge x -> LabelMerge
Generic)

data PropertyMerge = ReplaceProperties | ShallowMerge | DeepMerge
  deriving (PropertyMerge -> PropertyMerge -> Bool
(PropertyMerge -> PropertyMerge -> Bool)
-> (PropertyMerge -> PropertyMerge -> Bool) -> Eq PropertyMerge
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PropertyMerge -> PropertyMerge -> Bool
== :: PropertyMerge -> PropertyMerge -> Bool
$c/= :: PropertyMerge -> PropertyMerge -> Bool
/= :: PropertyMerge -> PropertyMerge -> Bool
Eq, Int -> PropertyMerge -> ShowS
[PropertyMerge] -> ShowS
PropertyMerge -> String
(Int -> PropertyMerge -> ShowS)
-> (PropertyMerge -> String)
-> ([PropertyMerge] -> ShowS)
-> Show PropertyMerge
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PropertyMerge -> ShowS
showsPrec :: Int -> PropertyMerge -> ShowS
$cshow :: PropertyMerge -> String
show :: PropertyMerge -> String
$cshowList :: [PropertyMerge] -> ShowS
showList :: [PropertyMerge] -> ShowS
Show, (forall x. PropertyMerge -> Rep PropertyMerge x)
-> (forall x. Rep PropertyMerge x -> PropertyMerge)
-> Generic PropertyMerge
forall x. Rep PropertyMerge x -> PropertyMerge
forall x. PropertyMerge -> Rep PropertyMerge x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PropertyMerge -> Rep PropertyMerge x
from :: forall x. PropertyMerge -> Rep PropertyMerge x
$cto :: forall x. Rep PropertyMerge x -> PropertyMerge
to :: forall x. Rep PropertyMerge x -> PropertyMerge
Generic)

instance Mergeable Subject where
  type MergeStrategy Subject = SubjectMergeStrategy
  merge :: MergeStrategy Subject -> Subject -> Subject -> Subject
merge MergeStrategy Subject
strategy Subject
s1 Subject
s2 =
    let mergedLabels :: Set String
mergedLabels = LabelMerge -> Set String -> Set String -> Set String
mergeLabels (SubjectMergeStrategy -> LabelMerge
labelMerge MergeStrategy Subject
SubjectMergeStrategy
strategy) (Subject -> Set String
Subject.labels Subject
s1) (Subject -> Set String
Subject.labels Subject
s2)
        mergedProps :: Map String Value
mergedProps = PropertyMerge
-> Map String Value -> Map String Value -> Map String Value
forall value.
PropertyMerge
-> Map String value -> Map String value -> Map String value
mergeProperties (SubjectMergeStrategy -> PropertyMerge
propertyMerge MergeStrategy Subject
SubjectMergeStrategy
strategy) (Subject -> Map String Value
Subject.properties Subject
s1) (Subject -> Map String Value
Subject.properties Subject
s2)
    in Symbol -> Set String -> Map String Value -> Subject
Subject (Subject -> Symbol
Subject.identity Subject
s1) Set String
mergedLabels Map String Value
mergedProps

instance Refinable Subject where
  isRefinementOf :: Subject -> Subject -> Bool
isRefinementOf Subject
full Subject
partial =
    Subject -> Symbol
Subject.identity Subject
full Symbol -> Symbol -> Bool
forall a. Eq a => a -> a -> Bool
== Subject -> Symbol
Subject.identity Subject
partial
    Bool -> Bool -> Bool
&& Set String -> Set String -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf (Subject -> Set String
Subject.labels Subject
partial) (Subject -> Set String
Subject.labels Subject
full)
    Bool -> Bool -> Bool
&& Map String Value -> Map String Value -> Bool
forall k a. (Ord k, Eq a) => Map k a -> Map k a -> Bool
Map.isSubmapOf (Subject -> Map String Value
Subject.properties Subject
partial) (Subject -> Map String Value
Subject.properties Subject
full)

-- | Default merge strategy for Subjects.
defaultSubjectMergeStrategy :: SubjectMergeStrategy
defaultSubjectMergeStrategy :: SubjectMergeStrategy
defaultSubjectMergeStrategy = LabelMerge -> PropertyMerge -> SubjectMergeStrategy
SubjectMergeStrategy LabelMerge
UnionLabels PropertyMerge
ShallowMerge

-- Helper functions for Subject merging
mergeLabels :: LabelMerge -> Set String -> Set String -> Set String
mergeLabels :: LabelMerge -> Set String -> Set String -> Set String
mergeLabels LabelMerge
UnionLabels Set String
l1 Set String
l2 = Set String -> Set String -> Set String
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set String
l1 Set String
l2
mergeLabels LabelMerge
IntersectLabels Set String
l1 Set String
l2 = Set String -> Set String -> Set String
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set String
l1 Set String
l2
mergeLabels LabelMerge
ReplaceLabels Set String
_ Set String
l2 = Set String
l2

mergeProperties :: PropertyMerge -> Map String value -> Map String value -> Map String value
mergeProperties :: forall value.
PropertyMerge
-> Map String value -> Map String value -> Map String value
mergeProperties PropertyMerge
ReplaceProperties Map String value
_ Map String value
p2 = Map String value
p2
mergeProperties PropertyMerge
ShallowMerge Map String value
p1 Map String value
p2 = Map String value -> Map String value -> Map String value
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map String value
p2 Map String value
p1  -- p2 values win on conflict
mergeProperties PropertyMerge
DeepMerge Map String value
p1 Map String value
p2 = (value -> value -> value)
-> Map String value -> Map String value -> Map String value
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith (\value
_ value
v2 -> value
v2) Map String value
p1 Map String value
p2 -- Placeholder for deep merge

-- -----------------------------------------------------------------------------
-- Error and Report Types
-- -----------------------------------------------------------------------------

type Path = [Int]

data Conflict i v = Conflict
  { forall i v. Conflict i v -> i
conflictId        :: i
  , forall i v. Conflict i v -> v
conflictExisting  :: v
  , forall i v. Conflict i v -> v
conflictIncoming  :: v
  , forall i v. Conflict i v -> [Path]
conflictLocations :: [Path]
  } deriving (Conflict i v -> Conflict i v -> Bool
(Conflict i v -> Conflict i v -> Bool)
-> (Conflict i v -> Conflict i v -> Bool) -> Eq (Conflict i v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall i v. (Eq i, Eq v) => Conflict i v -> Conflict i v -> Bool
$c== :: forall i v. (Eq i, Eq v) => Conflict i v -> Conflict i v -> Bool
== :: Conflict i v -> Conflict i v -> Bool
$c/= :: forall i v. (Eq i, Eq v) => Conflict i v -> Conflict i v -> Bool
/= :: Conflict i v -> Conflict i v -> Bool
Eq, Int -> Conflict i v -> ShowS
[Conflict i v] -> ShowS
Conflict i v -> String
(Int -> Conflict i v -> ShowS)
-> (Conflict i v -> String)
-> ([Conflict i v] -> ShowS)
-> Show (Conflict i v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall i v. (Show i, Show v) => Int -> Conflict i v -> ShowS
forall i v. (Show i, Show v) => [Conflict i v] -> ShowS
forall i v. (Show i, Show v) => Conflict i v -> String
$cshowsPrec :: forall i v. (Show i, Show v) => Int -> Conflict i v -> ShowS
showsPrec :: Int -> Conflict i v -> ShowS
$cshow :: forall i v. (Show i, Show v) => Conflict i v -> String
show :: Conflict i v -> String
$cshowList :: forall i v. (Show i, Show v) => [Conflict i v] -> ShowS
showList :: [Conflict i v] -> ShowS
Show, (forall x. Conflict i v -> Rep (Conflict i v) x)
-> (forall x. Rep (Conflict i v) x -> Conflict i v)
-> Generic (Conflict i v)
forall x. Rep (Conflict i v) x -> Conflict i v
forall x. Conflict i v -> Rep (Conflict i v) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall i v x. Rep (Conflict i v) x -> Conflict i v
forall i v x. Conflict i v -> Rep (Conflict i v) x
$cfrom :: forall i v x. Conflict i v -> Rep (Conflict i v) x
from :: forall x. Conflict i v -> Rep (Conflict i v) x
$cto :: forall i v x. Rep (Conflict i v) x -> Conflict i v
to :: forall x. Rep (Conflict i v) x -> Conflict i v
Generic)

data ReconcileError i v = ReconcileError
  { forall i v. ReconcileError i v -> String
errorMessage  :: String
  , forall i v. ReconcileError i v -> [Conflict i v]
errorConflicts :: [Conflict i v]
  } deriving (ReconcileError i v -> ReconcileError i v -> Bool
(ReconcileError i v -> ReconcileError i v -> Bool)
-> (ReconcileError i v -> ReconcileError i v -> Bool)
-> Eq (ReconcileError i v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall i v.
(Eq i, Eq v) =>
ReconcileError i v -> ReconcileError i v -> Bool
$c== :: forall i v.
(Eq i, Eq v) =>
ReconcileError i v -> ReconcileError i v -> Bool
== :: ReconcileError i v -> ReconcileError i v -> Bool
$c/= :: forall i v.
(Eq i, Eq v) =>
ReconcileError i v -> ReconcileError i v -> Bool
/= :: ReconcileError i v -> ReconcileError i v -> Bool
Eq, Int -> ReconcileError i v -> ShowS
[ReconcileError i v] -> ShowS
ReconcileError i v -> String
(Int -> ReconcileError i v -> ShowS)
-> (ReconcileError i v -> String)
-> ([ReconcileError i v] -> ShowS)
-> Show (ReconcileError i v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall i v. (Show i, Show v) => Int -> ReconcileError i v -> ShowS
forall i v. (Show i, Show v) => [ReconcileError i v] -> ShowS
forall i v. (Show i, Show v) => ReconcileError i v -> String
$cshowsPrec :: forall i v. (Show i, Show v) => Int -> ReconcileError i v -> ShowS
showsPrec :: Int -> ReconcileError i v -> ShowS
$cshow :: forall i v. (Show i, Show v) => ReconcileError i v -> String
show :: ReconcileError i v -> String
$cshowList :: forall i v. (Show i, Show v) => [ReconcileError i v] -> ShowS
showList :: [ReconcileError i v] -> ShowS
Show, (forall x. ReconcileError i v -> Rep (ReconcileError i v) x)
-> (forall x. Rep (ReconcileError i v) x -> ReconcileError i v)
-> Generic (ReconcileError i v)
forall x. Rep (ReconcileError i v) x -> ReconcileError i v
forall x. ReconcileError i v -> Rep (ReconcileError i v) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall i v x. Rep (ReconcileError i v) x -> ReconcileError i v
forall i v x. ReconcileError i v -> Rep (ReconcileError i v) x
$cfrom :: forall i v x. ReconcileError i v -> Rep (ReconcileError i v) x
from :: forall x. ReconcileError i v -> Rep (ReconcileError i v) x
$cto :: forall i v x. Rep (ReconcileError i v) x -> ReconcileError i v
to :: forall x. Rep (ReconcileError i v) x -> ReconcileError i v
Generic)

data ReconcileReport i = ReconcileReport
  { forall i. ReconcileReport i -> Int
reportDuplicatesFound    :: Int
  , forall i. ReconcileReport i -> Int
reportReferencesResolved :: Int
  , forall i. ReconcileReport i -> Int
reportMergesPerformed    :: Int
  , forall i. ReconcileReport i -> Map i Int
reportSubjectCounts      :: Map i Int
  } deriving (ReconcileReport i -> ReconcileReport i -> Bool
(ReconcileReport i -> ReconcileReport i -> Bool)
-> (ReconcileReport i -> ReconcileReport i -> Bool)
-> Eq (ReconcileReport i)
forall i. Eq i => ReconcileReport i -> ReconcileReport i -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall i. Eq i => ReconcileReport i -> ReconcileReport i -> Bool
== :: ReconcileReport i -> ReconcileReport i -> Bool
$c/= :: forall i. Eq i => ReconcileReport i -> ReconcileReport i -> Bool
/= :: ReconcileReport i -> ReconcileReport i -> Bool
Eq, Int -> ReconcileReport i -> ShowS
[ReconcileReport i] -> ShowS
ReconcileReport i -> String
(Int -> ReconcileReport i -> ShowS)
-> (ReconcileReport i -> String)
-> ([ReconcileReport i] -> ShowS)
-> Show (ReconcileReport i)
forall i. Show i => Int -> ReconcileReport i -> ShowS
forall i. Show i => [ReconcileReport i] -> ShowS
forall i. Show i => ReconcileReport i -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall i. Show i => Int -> ReconcileReport i -> ShowS
showsPrec :: Int -> ReconcileReport i -> ShowS
$cshow :: forall i. Show i => ReconcileReport i -> String
show :: ReconcileReport i -> String
$cshowList :: forall i. Show i => [ReconcileReport i] -> ShowS
showList :: [ReconcileReport i] -> ShowS
Show, (forall x. ReconcileReport i -> Rep (ReconcileReport i) x)
-> (forall x. Rep (ReconcileReport i) x -> ReconcileReport i)
-> Generic (ReconcileReport i)
forall x. Rep (ReconcileReport i) x -> ReconcileReport i
forall x. ReconcileReport i -> Rep (ReconcileReport i) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall i x. Rep (ReconcileReport i) x -> ReconcileReport i
forall i x. ReconcileReport i -> Rep (ReconcileReport i) x
$cfrom :: forall i x. ReconcileReport i -> Rep (ReconcileReport i) x
from :: forall x. ReconcileReport i -> Rep (ReconcileReport i) x
$cto :: forall i x. Rep (ReconcileReport i) x -> ReconcileReport i
to :: forall x. Rep (ReconcileReport i) x -> ReconcileReport i
Generic)

-- -----------------------------------------------------------------------------
-- Core Operations
-- -----------------------------------------------------------------------------

{-# INLINABLE reconcile #-}
reconcile 
  :: (HasIdentity v i, Mergeable v, Refinable v, Eq v)
  => ReconciliationPolicy (MergeStrategy v) 
  -> Pattern v 
  -> Either (ReconcileError i v) (Pattern v)
reconcile :: forall v i.
(HasIdentity v i, Mergeable v, Refinable v, Eq v) =>
ReconciliationPolicy (MergeStrategy v)
-> Pattern v -> Either (ReconcileError i v) (Pattern v)
reconcile ReconciliationPolicy (MergeStrategy v)
policy Pattern v
pattern =
  case ReconciliationPolicy (MergeStrategy v)
policy of
    ReconciliationPolicy (MergeStrategy v)
Strict -> Pattern v -> Either (ReconcileError i v) (Pattern v)
forall v i.
(HasIdentity v i, Eq v) =>
Pattern v -> Either (ReconcileError i v) (Pattern v)
reconcileStrict Pattern v
pattern
    ReconciliationPolicy (MergeStrategy v)
_ -> Pattern v -> Either (ReconcileError i v) (Pattern v)
forall a b. b -> Either a b
Right (Pattern v -> Either (ReconcileError i v) (Pattern v))
-> Pattern v -> Either (ReconcileError i v) (Pattern v)
forall a b. (a -> b) -> a -> b
$ ReconciliationPolicy (MergeStrategy v) -> Pattern v -> Pattern v
forall v i.
(HasIdentity v i, Mergeable v, Refinable v) =>
ReconciliationPolicy (MergeStrategy v) -> Pattern v -> Pattern v
reconcileNonStrict ReconciliationPolicy (MergeStrategy v)
policy Pattern v
pattern

{-# INLINABLE reconcileWithReport #-}
reconcileWithReport 
  :: (HasIdentity v i, Mergeable v, Refinable v, Eq v)
  => ReconciliationPolicy (MergeStrategy v) 
  -> Pattern v 
  -> (Either (ReconcileError i v) (Pattern v), ReconcileReport i)
reconcileWithReport :: forall v i.
(HasIdentity v i, Mergeable v, Refinable v, Eq v) =>
ReconciliationPolicy (MergeStrategy v)
-> Pattern v
-> (Either (ReconcileError i v) (Pattern v), ReconcileReport i)
reconcileWithReport ReconciliationPolicy (MergeStrategy v)
policy Pattern v
pattern =
  let occurrenceMap :: Map i [(Pattern v, Path)]
occurrenceMap = Pattern v -> Map i [(Pattern v, Path)]
forall v i.
HasIdentity v i =>
Pattern v -> Map i [(Pattern v, Path)]
collectByIdentity Pattern v
pattern
      subjectCounts :: Map i Int
subjectCounts = ([(Pattern v, Path)] -> Int)
-> Map i [(Pattern v, Path)] -> Map i Int
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map [(Pattern v, Path)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map i [(Pattern v, Path)]
occurrenceMap
      duplicatesFound :: Int
duplicatesFound = Map i Int -> Int
forall k a. Map k a -> Int
Map.size (Map i Int -> Int) -> Map i Int -> Int
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> Map i Int -> Map i Int
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) Map i Int
subjectCounts
      
      -- Count references: atomic patterns that have fuller definitions
      referencesResolved :: Int
referencesResolved = Path -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (Path -> Int) -> Path -> Int
forall a b. (a -> b) -> a -> b
$ ([(Pattern v, Path)] -> Int) -> [[(Pattern v, Path)]] -> Path
forall a b. (a -> b) -> [a] -> [b]
map [(Pattern v, Path)] -> Int
forall {v} {b}. Refinable v => [(Pattern v, b)] -> Int
countReferences (Map i [(Pattern v, Path)] -> [[(Pattern v, Path)]]
forall k a. Map k a -> [a]
Map.elems Map i [(Pattern v, Path)]
occurrenceMap)

      result :: Either (ReconcileError i v) (Pattern v)
result = ReconciliationPolicy (MergeStrategy v)
-> Pattern v -> Either (ReconcileError i v) (Pattern v)
forall v i.
(HasIdentity v i, Mergeable v, Refinable v, Eq v) =>
ReconciliationPolicy (MergeStrategy v)
-> Pattern v -> Either (ReconcileError i v) (Pattern v)
reconcile ReconciliationPolicy (MergeStrategy v)
policy Pattern v
pattern
      report :: ReconcileReport i
report = ReconcileReport
        { reportDuplicatesFound :: Int
reportDuplicatesFound = Int
duplicatesFound
        , reportReferencesResolved :: Int
reportReferencesResolved = Int
referencesResolved
        , reportMergesPerformed :: Int
reportMergesPerformed = if ReconciliationPolicy (MergeStrategy v) -> Bool
forall {s}. ReconciliationPolicy s -> Bool
isMergePolicy ReconciliationPolicy (MergeStrategy v)
policy then Int
duplicatesFound else Int
0
        , reportSubjectCounts :: Map i Int
reportSubjectCounts = Map i Int
subjectCounts
        }
  in (Either (ReconcileError i v) (Pattern v)
result, ReconcileReport i
report)
  where
    isMergePolicy :: ReconciliationPolicy s -> Bool
isMergePolicy (Merge ElementMergeStrategy
_ s
_) = Bool
True
    isMergePolicy ReconciliationPolicy s
_ = Bool
False

    countReferences :: [(Pattern v, b)] -> Int
countReferences [(Pattern v, b)]
occurrences =
      let patterns :: [Pattern v]
patterns = ((Pattern v, b) -> Pattern v) -> [(Pattern v, b)] -> [Pattern v]
forall a b. (a -> b) -> [a] -> [b]
map (Pattern v, b) -> Pattern v
forall a b. (a, b) -> a
fst [(Pattern v, b)]
occurrences
          isActualReference :: Pattern v -> Bool
isActualReference (Pattern v
val [Pattern v]
elems) =
            [Pattern v] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Pattern v]
elems Bool -> Bool -> Bool
&& (Pattern v -> Bool) -> [Pattern v] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Pattern v
other -> Pattern v -> v
forall v. Pattern v -> v
value Pattern v
other v -> v -> Bool
forall v. Refinable v => v -> v -> Bool
`isRefinementOf` v
val Bool -> Bool -> Bool
&&
                                         (Bool -> Bool
not ([Pattern v] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Pattern v -> [Pattern v]
forall v. Pattern v -> [Pattern v]
elements Pattern v
other)) Bool -> Bool -> Bool
|| Bool -> Bool
not (v
val v -> v -> Bool
forall v. Refinable v => v -> v -> Bool
`isRefinementOf` Pattern v -> v
forall v. Pattern v -> v
value Pattern v
other)))
                              [Pattern v]
patterns
      in [Pattern v] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Pattern v] -> Int) -> [Pattern v] -> Int
forall a b. (a -> b) -> a -> b
$ (Pattern v -> Bool) -> [Pattern v] -> [Pattern v]
forall a. (a -> Bool) -> [a] -> [a]
filter Pattern v -> Bool
isActualReference [Pattern v]
patterns

-- -----------------------------------------------------------------------------
-- Internal Implementation
-- -----------------------------------------------------------------------------

reconcileNonStrict 
  :: (HasIdentity v i, Mergeable v, Refinable v)
  => ReconciliationPolicy (MergeStrategy v) 
  -> Pattern v 
  -> Pattern v
reconcileNonStrict :: forall v i.
(HasIdentity v i, Mergeable v, Refinable v) =>
ReconciliationPolicy (MergeStrategy v) -> Pattern v -> Pattern v
reconcileNonStrict ReconciliationPolicy (MergeStrategy v)
policy Pattern v
pattern =
  let occurrenceMap :: Map i [(Pattern v, Path)]
occurrenceMap = Pattern v -> Map i [(Pattern v, Path)]
forall v i.
HasIdentity v i =>
Pattern v -> Map i [(Pattern v, Path)]
collectByIdentity Pattern v
pattern
      canonicalMap :: Map i (Pattern v)
canonicalMap = ([(Pattern v, Path)] -> Pattern v)
-> Map i [(Pattern v, Path)] -> Map i (Pattern v)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (ReconciliationPolicy (MergeStrategy v)
-> [(Pattern v, Path)] -> Pattern v
forall v i.
(HasIdentity v i, Mergeable v) =>
ReconciliationPolicy (MergeStrategy v)
-> [(Pattern v, Path)] -> Pattern v
reconcileOccurrences ReconciliationPolicy (MergeStrategy v)
policy) Map i [(Pattern v, Path)]
occurrenceMap
  in (Pattern v, Set i) -> Pattern v
forall a b. (a, b) -> a
fst ((Pattern v, Set i) -> Pattern v)
-> (Pattern v, Set i) -> Pattern v
forall a b. (a -> b) -> a -> b
$ Set i -> Map i (Pattern v) -> Pattern v -> (Pattern v, Set i)
forall v i.
HasIdentity v i =>
Set i -> Map i (Pattern v) -> Pattern v -> (Pattern v, Set i)
rebuildPattern Set i
forall a. Set a
Set.empty Map i (Pattern v)
canonicalMap Pattern v
pattern

reconcileOccurrences 
  :: (HasIdentity v i, Mergeable v)
  => ReconciliationPolicy (MergeStrategy v) 
  -> [(Pattern v, Path)] 
  -> Pattern v
reconcileOccurrences :: forall v i.
(HasIdentity v i, Mergeable v) =>
ReconciliationPolicy (MergeStrategy v)
-> [(Pattern v, Path)] -> Pattern v
reconcileOccurrences ReconciliationPolicy (MergeStrategy v)
LastWriteWins [(Pattern v, Path)]
occurrences =
  case ((Pattern v, Path) -> Pattern v)
-> [(Pattern v, Path)] -> [Pattern v]
forall a b. (a -> b) -> [a] -> [b]
map (Pattern v, Path) -> Pattern v
forall a b. (a, b) -> a
fst [(Pattern v, Path)]
occurrences of
    [] -> String -> Pattern v
forall a. HasCallStack => String -> a
error String
"reconcileOccurrences: empty occurrences"
    [Pattern v]
patterns -> 
      let v :: v
v = Pattern v -> v
forall v. Pattern v -> v
value ([Pattern v] -> Pattern v
forall a. HasCallStack => [a] -> a
last [Pattern v]
patterns)
          allElements :: [Pattern v]
allElements = ElementMergeStrategy -> [[Pattern v]] -> [Pattern v]
forall v i.
(HasIdentity v i, Mergeable v) =>
ElementMergeStrategy -> [[Pattern v]] -> [Pattern v]
mergeElements ElementMergeStrategy
UnionElements ((Pattern v -> [Pattern v]) -> [Pattern v] -> [[Pattern v]]
forall a b. (a -> b) -> [a] -> [b]
map Pattern v -> [Pattern v]
forall v. Pattern v -> [Pattern v]
elements [Pattern v]
patterns)
      in v -> [Pattern v] -> Pattern v
forall v. v -> [Pattern v] -> Pattern v
Pattern v
v [Pattern v]
allElements
reconcileOccurrences ReconciliationPolicy (MergeStrategy v)
FirstWriteWins [(Pattern v, Path)]
occurrences =
  case ((Pattern v, Path) -> Pattern v)
-> [(Pattern v, Path)] -> [Pattern v]
forall a b. (a -> b) -> [a] -> [b]
map (Pattern v, Path) -> Pattern v
forall a b. (a, b) -> a
fst [(Pattern v, Path)]
occurrences of
    [] -> String -> Pattern v
forall a. HasCallStack => String -> a
error String
"reconcileOccurrences: empty occurrences"
    patterns :: [Pattern v]
patterns@(Pattern v
p:[Pattern v]
_) ->
      let v :: v
v = Pattern v -> v
forall v. Pattern v -> v
value Pattern v
p
          allElements :: [Pattern v]
allElements = ElementMergeStrategy -> [[Pattern v]] -> [Pattern v]
forall v i.
(HasIdentity v i, Mergeable v) =>
ElementMergeStrategy -> [[Pattern v]] -> [Pattern v]
mergeElements ElementMergeStrategy
UnionElements ((Pattern v -> [Pattern v]) -> [Pattern v] -> [[Pattern v]]
forall a b. (a -> b) -> [a] -> [b]
map Pattern v -> [Pattern v]
forall v. Pattern v -> [Pattern v]
elements [Pattern v]
patterns)
      in v -> [Pattern v] -> Pattern v
forall v. v -> [Pattern v] -> Pattern v
Pattern v
v [Pattern v]
allElements
reconcileOccurrences (Merge ElementMergeStrategy
elemStrat MergeStrategy v
valStrat) [(Pattern v, Path)]
occurrences =
  let patterns :: [Pattern v]
patterns = ((Pattern v, Path) -> Pattern v)
-> [(Pattern v, Path)] -> [Pattern v]
forall a b. (a -> b) -> [a] -> [b]
map (Pattern v, Path) -> Pattern v
forall a b. (a, b) -> a
fst [(Pattern v, Path)]
occurrences
      vals :: [v]
vals = (Pattern v -> v) -> [Pattern v] -> [v]
forall a b. (a -> b) -> [a] -> [b]
map Pattern v -> v
forall v. Pattern v -> v
value [Pattern v]
patterns
      mergedVal :: v
mergedVal = (v -> v -> v) -> [v] -> v
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (MergeStrategy v -> v -> v -> v
forall v. Mergeable v => MergeStrategy v -> v -> v -> v
merge MergeStrategy v
valStrat) [v]
vals
      mergedElements :: [Pattern v]
mergedElements = ElementMergeStrategy -> [[Pattern v]] -> [Pattern v]
forall v i.
(HasIdentity v i, Mergeable v) =>
ElementMergeStrategy -> [[Pattern v]] -> [Pattern v]
mergeElements ElementMergeStrategy
elemStrat ((Pattern v -> [Pattern v]) -> [Pattern v] -> [[Pattern v]]
forall a b. (a -> b) -> [a] -> [b]
map Pattern v -> [Pattern v]
forall v. Pattern v -> [Pattern v]
elements [Pattern v]
patterns)
  in v -> [Pattern v] -> Pattern v
forall v. v -> [Pattern v] -> Pattern v
Pattern v
mergedVal [Pattern v]
mergedElements
reconcileOccurrences ReconciliationPolicy (MergeStrategy v)
Strict [(Pattern v, Path)]
_ = String -> Pattern v
forall a. HasCallStack => String -> a
error String
"Strict policy handled separately"

mergeElements 
  :: (HasIdentity v i, Mergeable v) 
  => ElementMergeStrategy 
  -> [[Pattern v]] 
  -> [Pattern v]
mergeElements :: forall v i.
(HasIdentity v i, Mergeable v) =>
ElementMergeStrategy -> [[Pattern v]] -> [Pattern v]
mergeElements ElementMergeStrategy
ReplaceElements [[Pattern v]]
elemLists = 
  case [[Pattern v]] -> [[Pattern v]]
forall a. [a] -> [a]
reverse [[Pattern v]]
elemLists of
    [] -> []
    ([Pattern v]
latest:[[Pattern v]]
_) -> [Pattern v]
latest
mergeElements ElementMergeStrategy
AppendElements [[Pattern v]]
elemLists = [[Pattern v]] -> [Pattern v]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Pattern v]]
elemLists
mergeElements ElementMergeStrategy
UnionElements [[Pattern v]]
elemLists =
  let allElements :: [Pattern v]
allElements = [[Pattern v]] -> [Pattern v]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Pattern v]]
elemLists
      elementMap :: Map i (Pattern v)
elementMap = (Pattern v -> Map i (Pattern v) -> Map i (Pattern v))
-> Map i (Pattern v) -> [Pattern v] -> Map i (Pattern v)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Pattern v -> Map i (Pattern v) -> Map i (Pattern v)
forall {v} {k}.
HasIdentity v k =>
Pattern v -> Map k (Pattern v) -> Map k (Pattern v)
insertElement Map i (Pattern v)
forall k a. Map k a
Map.empty [Pattern v]
allElements
  in Map i (Pattern v) -> [Pattern v]
forall k a. Map k a -> [a]
Map.elems Map i (Pattern v)
elementMap
  where
    insertElement :: Pattern v -> Map k (Pattern v) -> Map k (Pattern v)
insertElement Pattern v
p Map k (Pattern v)
m =
      let elemId :: k
elemId = v -> k
forall v i. HasIdentity v i => v -> i
identity (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
p)
      in (Pattern v -> Pattern v -> Pattern v)
-> k -> Pattern v -> Map k (Pattern v) -> Map k (Pattern v)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (\Pattern v
_ Pattern v
old -> Pattern v
old) k
elemId Pattern v
p Map k (Pattern v)
m -- Keep first encountered

reconcileStrict 
  :: (HasIdentity v i, Eq v) 
  => Pattern v 
  -> Either (ReconcileError i v) (Pattern v)
reconcileStrict :: forall v i.
(HasIdentity v i, Eq v) =>
Pattern v -> Either (ReconcileError i v) (Pattern v)
reconcileStrict Pattern v
pattern =
  let conflicts :: [Conflict i v]
conflicts = Pattern v -> [Conflict i v]
forall v i. (HasIdentity v i, Eq v) => Pattern v -> [Conflict i v]
findConflicts Pattern v
pattern
  in if [Conflict i v] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Conflict i v]
conflicts
       then Pattern v -> Either (ReconcileError i v) (Pattern v)
forall a b. b -> Either a b
Right Pattern v
pattern
       else ReconcileError i v -> Either (ReconcileError i v) (Pattern v)
forall a b. a -> Either a b
Left (ReconcileError i v -> Either (ReconcileError i v) (Pattern v))
-> ReconcileError i v -> Either (ReconcileError i v) (Pattern v)
forall a b. (a -> b) -> a -> b
$ String -> [Conflict i v] -> ReconcileError i v
forall i v. String -> [Conflict i v] -> ReconcileError i v
ReconcileError String
"Duplicate identities with different content" [Conflict i v]
conflicts

rebuildPattern 
  :: (HasIdentity v i)
  => Set i 
  -> Map i (Pattern v) 
  -> Pattern v 
  -> (Pattern v, Set i)
rebuildPattern :: forall v i.
HasIdentity v i =>
Set i -> Map i (Pattern v) -> Pattern v -> (Pattern v, Set i)
rebuildPattern Set i
visited Map i (Pattern v)
canonicalMap (Pattern v
val [Pattern v]
elems) =
  let vId :: i
vId = v -> i
forall v i. HasIdentity v i => v -> i
identity v
val
      canonical :: (Pattern v, Set i)
canonical = case i -> Map i (Pattern v) -> Maybe (Pattern v)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup i
vId Map i (Pattern v)
canonicalMap of
        Just (Pattern v
canonVal [Pattern v]
canonElems) ->
          let visited' :: Set i
visited' = i -> Set i -> Set i
forall a. Ord a => a -> Set a -> Set a
Set.insert i
vId Set i
visited
              ([Pattern v]
rebuiltCanonElems, Set i
finalVisited) = (([Pattern v], Set i) -> Pattern v -> ([Pattern v], Set i))
-> ([Pattern v], Set i) -> [Pattern v] -> ([Pattern v], Set i)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ([Pattern v], Set i) -> Pattern v -> ([Pattern v], Set i)
rebuildElem ([], Set i
visited') [Pattern v]
canonElems
          in (v -> [Pattern v] -> Pattern v
forall v. v -> [Pattern v] -> Pattern v
Pattern v
canonVal ([Pattern v] -> [Pattern v]
forall a. [a] -> [a]
reverse [Pattern v]
rebuiltCanonElems), Set i
finalVisited)
        Maybe (Pattern v)
Nothing ->
          let visited' :: Set i
visited' = i -> Set i -> Set i
forall a. Ord a => a -> Set a -> Set a
Set.insert i
vId Set i
visited
              ([Pattern v]
rebuiltElems, Set i
finalVisited) = (([Pattern v], Set i) -> Pattern v -> ([Pattern v], Set i))
-> ([Pattern v], Set i) -> [Pattern v] -> ([Pattern v], Set i)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ([Pattern v], Set i) -> Pattern v -> ([Pattern v], Set i)
rebuildElem ([], Set i
visited') [Pattern v]
elems
          in (v -> [Pattern v] -> Pattern v
forall v. v -> [Pattern v] -> Pattern v
Pattern v
val ([Pattern v] -> [Pattern v]
forall a. [a] -> [a]
reverse [Pattern v]
rebuiltElems), Set i
finalVisited)
  in (Pattern v, Set i)
canonical
  where
    rebuildElem :: ([Pattern v], Set i) -> Pattern v -> ([Pattern v], Set i)
rebuildElem ([Pattern v]
acc, Set i
vis) Pattern v
elem =
      let elemId :: i
elemId = v -> i
forall v i. HasIdentity v i => v -> i
identity (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
elem)
      in if i -> Set i -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member i
elemId Set i
vis
           then ([Pattern v]
acc, Set i
vis)
           else let (Pattern v
rebuilt, Set i
vis') = Set i -> Map i (Pattern v) -> Pattern v -> (Pattern v, Set i)
forall v i.
HasIdentity v i =>
Set i -> Map i (Pattern v) -> Pattern v -> (Pattern v, Set i)
rebuildPattern Set i
vis Map i (Pattern v)
canonicalMap Pattern v
elem
                in (Pattern v
rebuilt Pattern v -> [Pattern v] -> [Pattern v]
forall a. a -> [a] -> [a]
: [Pattern v]
acc, Set i
vis')

collectByIdentity 
  :: (HasIdentity v i) 
  => Pattern v 
  -> Map i [(Pattern v, Path)]
collectByIdentity :: forall v i.
HasIdentity v i =>
Pattern v -> Map i [(Pattern v, Path)]
collectByIdentity Pattern v
pattern =
  let occurrences :: [(Pattern v, Path)]
occurrences = Path -> Pattern v -> [(Pattern v, Path)]
forall {a} {v}.
(Num a, Enum a) =>
[a] -> Pattern v -> [(Pattern v, [a])]
collectWithPath [] Pattern v
pattern
  in ((Pattern v, Path)
 -> Map i [(Pattern v, Path)] -> Map i [(Pattern v, Path)])
-> Map i [(Pattern v, Path)]
-> [(Pattern v, Path)]
-> Map i [(Pattern v, Path)]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Pattern v, Path)
-> Map i [(Pattern v, Path)] -> Map i [(Pattern v, Path)]
forall {k} {v} {b}.
HasIdentity v k =>
(Pattern v, b) -> Map k [(Pattern v, b)] -> Map k [(Pattern v, b)]
insertOccurrence Map i [(Pattern v, Path)]
forall k a. Map k a
Map.empty [(Pattern v, Path)]
occurrences
  where
    collectWithPath :: [a] -> Pattern v -> [(Pattern v, [a])]
collectWithPath [a]
path pat :: Pattern v
pat@(Pattern v
_ [Pattern v]
elems) =
      (Pattern v
pat, [a]
path) (Pattern v, [a]) -> [(Pattern v, [a])] -> [(Pattern v, [a])]
forall a. a -> [a] -> [a]
: ((a, Pattern v) -> [(Pattern v, [a])])
-> [(a, Pattern v)] -> [(Pattern v, [a])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(a
idx, Pattern v
elem) -> [a] -> Pattern v -> [(Pattern v, [a])]
collectWithPath ([a]
path [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
idx]) Pattern v
elem) ([a] -> [Pattern v] -> [(a, Pattern v)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a
0..] [Pattern v]
elems)
    insertOccurrence :: (Pattern v, b) -> Map k [(Pattern v, b)] -> Map k [(Pattern v, b)]
insertOccurrence (Pattern v
pat, b
path) =
      ([(Pattern v, b)] -> [(Pattern v, b)] -> [(Pattern v, b)])
-> k
-> [(Pattern v, b)]
-> Map k [(Pattern v, b)]
-> Map k [(Pattern v, b)]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith [(Pattern v, b)] -> [(Pattern v, b)] -> [(Pattern v, b)]
forall a. [a] -> [a] -> [a]
(++) (v -> k
forall v i. HasIdentity v i => v -> i
identity (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
pat)) [(Pattern v
pat, b
path)]

findConflicts 
  :: (HasIdentity v i, Eq v) 
  => Pattern v 
  -> [Conflict i v]
findConflicts :: forall v i. (HasIdentity v i, Eq v) => Pattern v -> [Conflict i v]
findConflicts Pattern v
pattern =
  let occurrenceMap :: Map i [(Pattern v, Path)]
occurrenceMap = Pattern v -> Map i [(Pattern v, Path)]
forall v i.
HasIdentity v i =>
Pattern v -> Map i [(Pattern v, Path)]
collectByIdentity Pattern v
pattern
  in ((i, [(Pattern v, Path)]) -> [Conflict i v])
-> [(i, [(Pattern v, Path)])] -> [Conflict i v]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (i, [(Pattern v, Path)]) -> [Conflict i v]
forall {v} {i}. Eq v => (i, [(Pattern v, Path)]) -> [Conflict i v]
checkIdentity (Map i [(Pattern v, Path)] -> [(i, [(Pattern v, Path)])]
forall k a. Map k a -> [(k, a)]
Map.toList Map i [(Pattern v, Path)]
occurrenceMap)
  where
    checkIdentity :: (i, [(Pattern v, Path)]) -> [Conflict i v]
checkIdentity (i
_, [(Pattern v
_, Path
_)]) = []
    checkIdentity (i
id, occurrences :: [(Pattern v, Path)]
occurrences@((Pattern v
first [Pattern v]
_, Path
firstPath):[(Pattern v, Path)]
rest)) =
      [ i -> v -> v -> [Path] -> Conflict i v
forall i v. i -> v -> v -> [Path] -> Conflict i v
Conflict i
id v
first (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
incoming) [Path
firstPath, Path
incomingPath]
      | (Pattern v
incoming, Path
incomingPath) <- [(Pattern v, Path)]
rest
      , Pattern v -> v
forall v. Pattern v -> v
value Pattern v
incoming v -> v -> Bool
forall a. Eq a => a -> a -> Bool
/= v
first
      ]
    checkIdentity (i, [(Pattern v, Path)])
_ = []

needsReconciliation 
  :: (HasIdentity v i) 
  => Pattern v 
  -> Bool
needsReconciliation :: forall v i. HasIdentity v i => Pattern v -> Bool
needsReconciliation Pattern v
pattern =
  ([(Pattern v, Path)] -> Bool) -> [[(Pattern v, Path)]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\[(Pattern v, Path)]
xs -> [(Pattern v, Path)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Pattern v, Path)]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (Map i [(Pattern v, Path)] -> [[(Pattern v, Path)]]
forall k a. Map k a -> [a]
Map.elems (Map i [(Pattern v, Path)] -> [[(Pattern v, Path)]])
-> Map i [(Pattern v, Path)] -> [[(Pattern v, Path)]]
forall a b. (a -> b) -> a -> b
$ Pattern v -> Map i [(Pattern v, Path)]
forall v i.
HasIdentity v i =>
Pattern v -> Map i [(Pattern v, Path)]
collectByIdentity Pattern v
pattern)

isReference 
  :: (HasIdentity v i, Refinable v)
  => Pattern v 
  -> Map i (Pattern v) 
  -> Bool
isReference :: forall v i.
(HasIdentity v i, Refinable v) =>
Pattern v -> Map i (Pattern v) -> Bool
isReference (Pattern v
val []) Map i (Pattern v)
fullerMap =
  case i -> Map i (Pattern v) -> Maybe (Pattern v)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (v -> i
forall v i. HasIdentity v i => v -> i
identity v
val) Map i (Pattern v)
fullerMap of
    Maybe (Pattern v)
Nothing -> Bool
False
    Just (Pattern v
fuller [Pattern v]
_) -> v -> v -> Bool
forall v. Refinable v => v -> v -> Bool
isRefinementOf v
fuller v
val
isReference Pattern v
_ Map i (Pattern v)
_ = Bool
False