-- | PatternGraph: container for nodes, relationships, walks, and annotations
-- backed by Pattern v, with merge-on-insert semantics.
--
-- Unrecognized patterns are routed to 'pgOther' by the 'GraphClassifier'.
-- Patterns that fail reconciliation are preserved in 'pgConflicts'.
-- See specs/033-pattern-graph/ for design and data model.
--
-- Round-trip with gram: parse (e.g. 'Gram.Parse.fromGram') → 'fromPatterns' → modify
-- (e.g. 'merge') → serialize by flattening 'pgNodes', 'pgRelationships', 'pgWalks',
-- 'pgAnnotations' and calling 'Gram.Serialize.toGram'. See quickstart.md and
-- libs/gram/tests/Spec/Gram/RoundtripSpec.hs (PatternGraph round-trip test).
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Pattern.PatternGraph
  ( -- * Graph container
    PatternGraph(..)

    -- * Classification
  , GraphValue(..)

    -- * Merge and construction
  , merge
  , mergeWithPolicy
  , fromPatterns
  , fromPatternsWithPolicy
  , empty

    -- * Conversion to GraphQuery
  , fromPatternGraph

    -- * GraphView construction and materialization
  , toGraphView
  , materialize
  ) where

import Data.List (foldl')
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Pattern.Core (Pattern(..))
import Pattern.Graph.GraphClassifier (GraphClass(..), GraphClassifier(..), GraphValue(..))
import Pattern.Graph.GraphQuery (GraphQuery(..))
import Pattern.Graph.Types (GraphView(..))
import qualified Pattern.Reconcile as Reconcile
import Subject.Core (Subject(..), Symbol)
import qualified Subject.Core as Subj

-- ============================================================================
-- Types
-- ============================================================================

-- | Container holding four categories of graph elements, each keyed by identity.
-- All stored elements are 'Pattern v'; classification is via 'GraphValue'.
data PatternGraph extra v = PatternGraph
  { forall extra v. PatternGraph extra v -> Map (Id v) (Pattern v)
pgNodes         :: Map (Id v) (Pattern v)
  , forall extra v. PatternGraph extra v -> Map (Id v) (Pattern v)
pgRelationships :: Map (Id v) (Pattern v)
  , forall extra v. PatternGraph extra v -> Map (Id v) (Pattern v)
pgWalks         :: Map (Id v) (Pattern v)
  , forall extra v. PatternGraph extra v -> Map (Id v) (Pattern v)
pgAnnotations   :: Map (Id v) (Pattern v)
  , forall extra v.
PatternGraph extra v -> Map (Id v) (extra, Pattern v)
pgOther         :: Map (Id v) (extra, Pattern v)
  , forall extra v. PatternGraph extra v -> Map (Id v) [Pattern v]
pgConflicts     :: Map (Id v) [Pattern v]
  }

deriving instance (Eq (Id v), Eq v, Eq extra) => Eq (PatternGraph extra v)
deriving instance (Show (Id v), Show v, Show extra) => Show (PatternGraph extra v)

-- ============================================================================
-- GraphValue Subject
-- ============================================================================

instance GraphValue Subject where
  type Id Subject = Symbol
  identify :: Subject -> Id Subject
identify = Subject -> Symbol
Subject -> Id Subject
Subj.identity

-- ============================================================================
-- Empty and merge (default policy: LastWriteWins)
-- ============================================================================

-- | Empty graph (all five maps empty).
empty :: GraphValue v => PatternGraph extra v
empty :: forall v extra. GraphValue v => PatternGraph extra v
empty = Map (Id v) (Pattern v)
-> Map (Id v) (Pattern v)
-> Map (Id v) (Pattern v)
-> Map (Id v) (Pattern v)
-> Map (Id v) (extra, Pattern v)
-> Map (Id v) [Pattern v]
-> PatternGraph extra v
forall extra v.
Map (Id v) (Pattern v)
-> Map (Id v) (Pattern v)
-> Map (Id v) (Pattern v)
-> Map (Id v) (Pattern v)
-> Map (Id v) (extra, Pattern v)
-> Map (Id v) [Pattern v]
-> PatternGraph extra v
PatternGraph Map (Id v) (Pattern v)
forall k a. Map k a
Map.empty Map (Id v) (Pattern v)
forall k a. Map k a
Map.empty Map (Id v) (Pattern v)
forall k a. Map k a
Map.empty Map (Id v) (Pattern v)
forall k a. Map k a
Map.empty Map (Id v) (extra, Pattern v)
forall k a. Map k a
Map.empty Map (Id v) [Pattern v]
forall k a. Map k a
Map.empty

-- | Merge a single pattern into the graph. Uses LastWriteWins for duplicate identities.
merge
  :: (GraphValue v, Eq v, Reconcile.Mergeable v, Reconcile.HasIdentity v (Id v), Reconcile.Refinable v)
  => GraphClassifier extra v
  -> Pattern v
  -> PatternGraph extra v
  -> PatternGraph extra v
merge :: forall v extra.
(GraphValue v, Eq v, Mergeable v, HasIdentity v (Id v),
 Refinable v) =>
GraphClassifier extra v
-> Pattern v -> PatternGraph extra v -> PatternGraph extra v
merge GraphClassifier extra v
classifier Pattern v
p PatternGraph extra v
g = GraphClassifier extra v
-> ReconciliationPolicy (MergeStrategy v)
-> Pattern v
-> PatternGraph extra v
-> PatternGraph extra v
forall v extra.
(GraphValue v, Eq v, Mergeable v, HasIdentity v (Id v),
 Refinable v) =>
GraphClassifier extra v
-> ReconciliationPolicy (MergeStrategy v)
-> Pattern v
-> PatternGraph extra v
-> PatternGraph extra v
mergeWithPolicy GraphClassifier extra v
classifier ReconciliationPolicy (MergeStrategy v)
forall s. ReconciliationPolicy s
Reconcile.LastWriteWins Pattern v
p PatternGraph extra v
g

-- | Merge a single pattern using the given reconciliation policy for duplicate identities.
mergeWithPolicy
  :: (GraphValue v, Eq v, Reconcile.Mergeable v, Reconcile.HasIdentity v (Id v), Reconcile.Refinable v)
  => GraphClassifier extra v
  -> Reconcile.ReconciliationPolicy (Reconcile.MergeStrategy v)
  -> Pattern v
  -> PatternGraph extra v
  -> PatternGraph extra v
mergeWithPolicy :: forall v extra.
(GraphValue v, Eq v, Mergeable v, HasIdentity v (Id v),
 Refinable v) =>
GraphClassifier extra v
-> ReconciliationPolicy (MergeStrategy v)
-> Pattern v
-> PatternGraph extra v
-> PatternGraph extra v
mergeWithPolicy GraphClassifier extra v
classifier ReconciliationPolicy (MergeStrategy v)
policy Pattern v
p PatternGraph extra v
g =
  case GraphClassifier extra v -> Pattern v -> GraphClass extra
forall extra v.
GraphClassifier extra v -> Pattern v -> GraphClass extra
classify GraphClassifier extra v
classifier Pattern v
p of
    GraphClass extra
GNode -> ReconciliationPolicy (MergeStrategy v)
-> Pattern v -> PatternGraph extra v -> PatternGraph extra v
forall v extra.
(GraphValue v, Eq v, Mergeable v, HasIdentity v (Id v),
 Refinable v) =>
ReconciliationPolicy (MergeStrategy v)
-> Pattern v -> PatternGraph extra v -> PatternGraph extra v
insertNode ReconciliationPolicy (MergeStrategy v)
policy Pattern v
p PatternGraph extra v
g
    GraphClass extra
GRelationship -> GraphClassifier extra v
-> ReconciliationPolicy (MergeStrategy v)
-> Pattern v
-> PatternGraph extra v
-> PatternGraph extra v
forall v extra.
(GraphValue v, Eq v, Mergeable v, HasIdentity v (Id v),
 Refinable v) =>
GraphClassifier extra v
-> ReconciliationPolicy (MergeStrategy v)
-> Pattern v
-> PatternGraph extra v
-> PatternGraph extra v
insertRelationship GraphClassifier extra v
classifier ReconciliationPolicy (MergeStrategy v)
policy Pattern v
p PatternGraph extra v
g
    GraphClass extra
GWalk -> GraphClassifier extra v
-> ReconciliationPolicy (MergeStrategy v)
-> Pattern v
-> PatternGraph extra v
-> PatternGraph extra v
forall v extra.
(GraphValue v, Eq v, Mergeable v, HasIdentity v (Id v),
 Refinable v) =>
GraphClassifier extra v
-> ReconciliationPolicy (MergeStrategy v)
-> Pattern v
-> PatternGraph extra v
-> PatternGraph extra v
insertWalk GraphClassifier extra v
classifier ReconciliationPolicy (MergeStrategy v)
policy Pattern v
p PatternGraph extra v
g
    GraphClass extra
GAnnotation -> GraphClassifier extra v
-> ReconciliationPolicy (MergeStrategy v)
-> Pattern v
-> PatternGraph extra v
-> PatternGraph extra v
forall v extra.
(GraphValue v, Eq v, Mergeable v, HasIdentity v (Id v),
 Refinable v) =>
GraphClassifier extra v
-> ReconciliationPolicy (MergeStrategy v)
-> Pattern v
-> PatternGraph extra v
-> PatternGraph extra v
insertAnnotation GraphClassifier extra v
classifier ReconciliationPolicy (MergeStrategy v)
policy Pattern v
p PatternGraph extra v
g
    GOther extra
extra -> ReconciliationPolicy (MergeStrategy v)
-> extra
-> Pattern v
-> PatternGraph extra v
-> PatternGraph extra v
forall v extra.
(GraphValue v, Eq v, Mergeable v, HasIdentity v (Id v),
 Refinable v) =>
ReconciliationPolicy (MergeStrategy v)
-> extra
-> Pattern v
-> PatternGraph extra v
-> PatternGraph extra v
insertOther ReconciliationPolicy (MergeStrategy v)
policy extra
extra Pattern v
p PatternGraph extra v
g

-- | Two occurrences of the same identity: root = existing, single child = p.
-- Used so Reconcile.reconcile sees exactly two occurrences (no extra duplicate root).
twoOccurrences :: Pattern v -> Pattern v -> Pattern v
twoOccurrences :: forall v. Pattern v -> Pattern v -> Pattern v
twoOccurrences Pattern v
existing Pattern v
p = v -> [Pattern v] -> Pattern v
forall v. v -> [Pattern v] -> Pattern v
Pattern (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
existing) [Pattern v
p]

insertNode
  :: (GraphValue v, Eq v, Reconcile.Mergeable v, Reconcile.HasIdentity v (Id v), Reconcile.Refinable v)
  => Reconcile.ReconciliationPolicy (Reconcile.MergeStrategy v)
  -> Pattern v
  -> PatternGraph extra v
  -> PatternGraph extra v
insertNode :: forall v extra.
(GraphValue v, Eq v, Mergeable v, HasIdentity v (Id v),
 Refinable v) =>
ReconciliationPolicy (MergeStrategy v)
-> Pattern v -> PatternGraph extra v -> PatternGraph extra v
insertNode ReconciliationPolicy (MergeStrategy v)
policy Pattern v
p PatternGraph extra v
g =
  let i :: Id v
i = v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
p)
  in case Id v -> Map (Id v) (Pattern v) -> Maybe (Pattern v)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Id v
i (PatternGraph extra v -> Map (Id v) (Pattern v)
forall extra v. PatternGraph extra v -> Map (Id v) (Pattern v)
pgNodes PatternGraph extra v
g) of
    Maybe (Pattern v)
Nothing -> PatternGraph extra v
g { pgNodes = Map.insert i p (pgNodes g) }
    Just Pattern v
existing ->
      case ReconciliationPolicy (MergeStrategy v)
-> Pattern v -> Either (ReconcileError (Id v) 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.reconcile ReconciliationPolicy (MergeStrategy v)
policy (Pattern v -> Pattern v -> Pattern v
forall v. Pattern v -> Pattern v -> Pattern v
twoOccurrences Pattern v
existing Pattern v
p) of
        Left ReconcileError (Id v) v
_ -> PatternGraph extra v
g { pgConflicts = Map.insertWith (++) i [p] (pgConflicts g) }
        Right Pattern v
merged -> PatternGraph extra v
g { pgNodes = Map.insert i merged (pgNodes g) }

insertRelationship
  :: (GraphValue v, Eq v, Reconcile.Mergeable v, Reconcile.HasIdentity v (Id v), Reconcile.Refinable v)
  => GraphClassifier extra v
  -> Reconcile.ReconciliationPolicy (Reconcile.MergeStrategy v)
  -> Pattern v
  -> PatternGraph extra v
  -> PatternGraph extra v
insertRelationship :: forall v extra.
(GraphValue v, Eq v, Mergeable v, HasIdentity v (Id v),
 Refinable v) =>
GraphClassifier extra v
-> ReconciliationPolicy (MergeStrategy v)
-> Pattern v
-> PatternGraph extra v
-> PatternGraph extra v
insertRelationship GraphClassifier extra v
classifier ReconciliationPolicy (MergeStrategy v)
policy Pattern v
p PatternGraph extra v
g =
  let -- Merge endpoint nodes first (relationship has 2 node elements).
      g1 :: PatternGraph extra v
g1 = case Pattern v -> [Pattern v]
forall v. Pattern v -> [Pattern v]
elements Pattern v
p of
        [Pattern v
n1, Pattern v
n2] ->
          let g1' :: PatternGraph extra v
g1' = GraphClassifier extra v
-> ReconciliationPolicy (MergeStrategy v)
-> Pattern v
-> PatternGraph extra v
-> PatternGraph extra v
forall v extra.
(GraphValue v, Eq v, Mergeable v, HasIdentity v (Id v),
 Refinable v) =>
GraphClassifier extra v
-> ReconciliationPolicy (MergeStrategy v)
-> Pattern v
-> PatternGraph extra v
-> PatternGraph extra v
mergeWithPolicy GraphClassifier extra v
classifier ReconciliationPolicy (MergeStrategy v)
policy Pattern v
n1 PatternGraph extra v
g
          in GraphClassifier extra v
-> ReconciliationPolicy (MergeStrategy v)
-> Pattern v
-> PatternGraph extra v
-> PatternGraph extra v
forall v extra.
(GraphValue v, Eq v, Mergeable v, HasIdentity v (Id v),
 Refinable v) =>
GraphClassifier extra v
-> ReconciliationPolicy (MergeStrategy v)
-> Pattern v
-> PatternGraph extra v
-> PatternGraph extra v
mergeWithPolicy GraphClassifier extra v
classifier ReconciliationPolicy (MergeStrategy v)
policy Pattern v
n2 PatternGraph extra v
g1'
        [Pattern v]
_        -> PatternGraph extra v
g
      i :: Id v
i = v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
p)
  in case Id v -> Map (Id v) (Pattern v) -> Maybe (Pattern v)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Id v
i (PatternGraph extra v -> Map (Id v) (Pattern v)
forall extra v. PatternGraph extra v -> Map (Id v) (Pattern v)
pgRelationships PatternGraph extra v
g1) of
    Maybe (Pattern v)
Nothing -> PatternGraph extra v
g1 { pgRelationships = Map.insert i p (pgRelationships g1) }
    Just Pattern v
existing ->
      case ReconciliationPolicy (MergeStrategy v)
-> Pattern v -> Either (ReconcileError (Id v) 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.reconcile ReconciliationPolicy (MergeStrategy v)
policy (Pattern v -> Pattern v -> Pattern v
forall v. Pattern v -> Pattern v -> Pattern v
twoOccurrences Pattern v
existing Pattern v
p) of
        Left ReconcileError (Id v) v
_ -> PatternGraph extra v
g1 { pgConflicts = Map.insertWith (++) i [p] (pgConflicts g1) }
        Right Pattern v
mergedRel -> PatternGraph extra v
g1 { pgRelationships = Map.insert i mergedRel (pgRelationships g1) }

insertWalk
  :: (GraphValue v, Eq v, Reconcile.Mergeable v, Reconcile.HasIdentity v (Id v), Reconcile.Refinable v)
  => GraphClassifier extra v
  -> Reconcile.ReconciliationPolicy (Reconcile.MergeStrategy v)
  -> Pattern v
  -> PatternGraph extra v
  -> PatternGraph extra v
insertWalk :: forall v extra.
(GraphValue v, Eq v, Mergeable v, HasIdentity v (Id v),
 Refinable v) =>
GraphClassifier extra v
-> ReconciliationPolicy (MergeStrategy v)
-> Pattern v
-> PatternGraph extra v
-> PatternGraph extra v
insertWalk GraphClassifier extra v
classifier ReconciliationPolicy (MergeStrategy v)
policy Pattern v
p PatternGraph extra v
g =
  let g1 :: PatternGraph extra v
g1 = (PatternGraph extra v -> Pattern v -> PatternGraph extra v)
-> PatternGraph extra v -> [Pattern v] -> PatternGraph extra v
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 -> PatternGraph extra v -> PatternGraph extra v)
-> PatternGraph extra v -> Pattern v -> PatternGraph extra v
forall a b c. (a -> b -> c) -> b -> a -> c
flip (GraphClassifier extra v
-> ReconciliationPolicy (MergeStrategy v)
-> Pattern v
-> PatternGraph extra v
-> PatternGraph extra v
forall v extra.
(GraphValue v, Eq v, Mergeable v, HasIdentity v (Id v),
 Refinable v) =>
GraphClassifier extra v
-> ReconciliationPolicy (MergeStrategy v)
-> Pattern v
-> PatternGraph extra v
-> PatternGraph extra v
mergeWithPolicy GraphClassifier extra v
classifier ReconciliationPolicy (MergeStrategy v)
policy)) PatternGraph extra v
g (Pattern v -> [Pattern v]
forall v. Pattern v -> [Pattern v]
elements Pattern v
p)
      i :: Id v
i = v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
p)
  in case Id v -> Map (Id v) (Pattern v) -> Maybe (Pattern v)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Id v
i (PatternGraph extra v -> Map (Id v) (Pattern v)
forall extra v. PatternGraph extra v -> Map (Id v) (Pattern v)
pgWalks PatternGraph extra v
g1) of
    Maybe (Pattern v)
Nothing -> PatternGraph extra v
g1 { pgWalks = Map.insert i p (pgWalks g1) }
    Just Pattern v
existing ->
      case ReconciliationPolicy (MergeStrategy v)
-> Pattern v -> Either (ReconcileError (Id v) 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.reconcile ReconciliationPolicy (MergeStrategy v)
policy (Pattern v -> Pattern v -> Pattern v
forall v. Pattern v -> Pattern v -> Pattern v
twoOccurrences Pattern v
existing Pattern v
p) of
        Left ReconcileError (Id v) v
_ -> PatternGraph extra v
g1 { pgConflicts = Map.insertWith (++) i [p] (pgConflicts g1) }
        Right Pattern v
walkPat -> PatternGraph extra v
g1 { pgWalks = Map.insert i walkPat (pgWalks g1) }

insertAnnotation
  :: (GraphValue v, Eq v, Reconcile.Mergeable v, Reconcile.HasIdentity v (Id v), Reconcile.Refinable v)
  => GraphClassifier extra v
  -> Reconcile.ReconciliationPolicy (Reconcile.MergeStrategy v)
  -> Pattern v
  -> PatternGraph extra v
  -> PatternGraph extra v
insertAnnotation :: forall v extra.
(GraphValue v, Eq v, Mergeable v, HasIdentity v (Id v),
 Refinable v) =>
GraphClassifier extra v
-> ReconciliationPolicy (MergeStrategy v)
-> Pattern v
-> PatternGraph extra v
-> PatternGraph extra v
insertAnnotation GraphClassifier extra v
classifier ReconciliationPolicy (MergeStrategy v)
policy Pattern v
p PatternGraph extra v
g =
  let g1 :: PatternGraph extra v
g1 = case Pattern v -> [Pattern v]
forall v. Pattern v -> [Pattern v]
elements Pattern v
p of
        [Pattern v
inner] -> GraphClassifier extra v
-> ReconciliationPolicy (MergeStrategy v)
-> Pattern v
-> PatternGraph extra v
-> PatternGraph extra v
forall v extra.
(GraphValue v, Eq v, Mergeable v, HasIdentity v (Id v),
 Refinable v) =>
GraphClassifier extra v
-> ReconciliationPolicy (MergeStrategy v)
-> Pattern v
-> PatternGraph extra v
-> PatternGraph extra v
mergeWithPolicy GraphClassifier extra v
classifier ReconciliationPolicy (MergeStrategy v)
policy Pattern v
inner PatternGraph extra v
g
        [Pattern v]
_ -> PatternGraph extra v
g
      i :: Id v
i = v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
p)
  in case Id v -> Map (Id v) (Pattern v) -> Maybe (Pattern v)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Id v
i (PatternGraph extra v -> Map (Id v) (Pattern v)
forall extra v. PatternGraph extra v -> Map (Id v) (Pattern v)
pgAnnotations PatternGraph extra v
g1) of
    Maybe (Pattern v)
Nothing -> PatternGraph extra v
g1 { pgAnnotations = Map.insert i p (pgAnnotations g1) }
    Just Pattern v
existing ->
      case ReconciliationPolicy (MergeStrategy v)
-> Pattern v -> Either (ReconcileError (Id v) 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.reconcile ReconciliationPolicy (MergeStrategy v)
policy (Pattern v -> Pattern v -> Pattern v
forall v. Pattern v -> Pattern v -> Pattern v
twoOccurrences Pattern v
existing Pattern v
p) of
        Left ReconcileError (Id v) v
_ -> PatternGraph extra v
g1 { pgConflicts = Map.insertWith (++) i [p] (pgConflicts g1) }
        Right Pattern v
mergedP -> PatternGraph extra v
g1 { pgAnnotations = Map.insert i mergedP (pgAnnotations g1) }

insertOther
  :: (GraphValue v, Eq v, Reconcile.Mergeable v, Reconcile.HasIdentity v (Id v), Reconcile.Refinable v)
  => Reconcile.ReconciliationPolicy (Reconcile.MergeStrategy v)
  -> extra
  -> Pattern v
  -> PatternGraph extra v
  -> PatternGraph extra v
insertOther :: forall v extra.
(GraphValue v, Eq v, Mergeable v, HasIdentity v (Id v),
 Refinable v) =>
ReconciliationPolicy (MergeStrategy v)
-> extra
-> Pattern v
-> PatternGraph extra v
-> PatternGraph extra v
insertOther ReconciliationPolicy (MergeStrategy v)
policy extra
extra Pattern v
p PatternGraph extra v
g =
  let i :: Id v
i = v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
p)
  in case Id v -> Map (Id v) (extra, Pattern v) -> Maybe (extra, Pattern v)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Id v
i (PatternGraph extra v -> Map (Id v) (extra, Pattern v)
forall extra v.
PatternGraph extra v -> Map (Id v) (extra, Pattern v)
pgOther PatternGraph extra v
g) of
    Maybe (extra, Pattern v)
Nothing -> PatternGraph extra v
g { pgOther = Map.insert i (extra, p) (pgOther g) }
    Just (extra
_, Pattern v
existing) ->
      case ReconciliationPolicy (MergeStrategy v)
-> Pattern v -> Either (ReconcileError (Id v) 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.reconcile ReconciliationPolicy (MergeStrategy v)
policy (Pattern v -> Pattern v -> Pattern v
forall v. Pattern v -> Pattern v -> Pattern v
twoOccurrences Pattern v
existing Pattern v
p) of
        Left ReconcileError (Id v) v
_ -> PatternGraph extra v
g { pgConflicts = Map.insertWith (++) i [p] (pgConflicts g) }
        Right Pattern v
mergedP -> PatternGraph extra v
g { pgOther = Map.insert i (extra, mergedP) (pgOther g) }

-- ============================================================================
-- fromPatterns
-- ============================================================================

-- | Build a graph from a list of patterns (fold of merge).
fromPatterns
  :: (GraphValue v, Eq v, Reconcile.Mergeable v, Reconcile.HasIdentity v (Id v), Reconcile.Refinable v)
  => GraphClassifier extra v
  -> [Pattern v]
  -> PatternGraph extra v
fromPatterns :: forall v extra.
(GraphValue v, Eq v, Mergeable v, HasIdentity v (Id v),
 Refinable v) =>
GraphClassifier extra v -> [Pattern v] -> PatternGraph extra v
fromPatterns GraphClassifier extra v
classifier [Pattern v]
ps = GraphClassifier extra v
-> ReconciliationPolicy (MergeStrategy v)
-> [Pattern v]
-> PatternGraph extra v
forall v extra.
(GraphValue v, Eq v, Mergeable v, HasIdentity v (Id v),
 Refinable v) =>
GraphClassifier extra v
-> ReconciliationPolicy (MergeStrategy v)
-> [Pattern v]
-> PatternGraph extra v
fromPatternsWithPolicy GraphClassifier extra v
classifier ReconciliationPolicy (MergeStrategy v)
forall s. ReconciliationPolicy s
Reconcile.LastWriteWins [Pattern v]
ps

-- | Build a graph from a list of patterns using the given reconciliation policy.
fromPatternsWithPolicy
  :: (GraphValue v, Eq v, Reconcile.Mergeable v, Reconcile.HasIdentity v (Id v), Reconcile.Refinable v)
  => GraphClassifier extra v
  -> Reconcile.ReconciliationPolicy (Reconcile.MergeStrategy v)
  -> [Pattern v]
  -> PatternGraph extra v
fromPatternsWithPolicy :: forall v extra.
(GraphValue v, Eq v, Mergeable v, HasIdentity v (Id v),
 Refinable v) =>
GraphClassifier extra v
-> ReconciliationPolicy (MergeStrategy v)
-> [Pattern v]
-> PatternGraph extra v
fromPatternsWithPolicy GraphClassifier extra v
classifier ReconciliationPolicy (MergeStrategy v)
policy [Pattern v]
ps =
  (PatternGraph extra v -> Pattern v -> PatternGraph extra v)
-> PatternGraph extra v -> [Pattern v] -> PatternGraph extra v
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\PatternGraph extra v
g Pattern v
p -> GraphClassifier extra v
-> ReconciliationPolicy (MergeStrategy v)
-> Pattern v
-> PatternGraph extra v
-> PatternGraph extra v
forall v extra.
(GraphValue v, Eq v, Mergeable v, HasIdentity v (Id v),
 Refinable v) =>
GraphClassifier extra v
-> ReconciliationPolicy (MergeStrategy v)
-> Pattern v
-> PatternGraph extra v
-> PatternGraph extra v
mergeWithPolicy GraphClassifier extra v
classifier ReconciliationPolicy (MergeStrategy v)
policy Pattern v
p PatternGraph extra v
g) PatternGraph extra v
forall v extra. GraphValue v => PatternGraph extra v
empty [Pattern v]
ps

-- ============================================================================
-- fromPatternGraph
-- ============================================================================

-- | Construct a 'GraphQuery v' directly from a 'PatternGraph extra v'.
--
-- Reads from the typed maps (@pgNodes@, @pgRelationships@, @pgWalks@,
-- @pgAnnotations@) without going through 'GraphLens'. Provides O(log n)
-- lookups for 'queryNodeById' and 'queryRelationshipById'.
--
-- Preferred over constructing a 'GraphLens' for algorithm access.
fromPatternGraph :: (GraphValue v, Eq v) => PatternGraph extra v -> GraphQuery v
fromPatternGraph :: forall v extra.
(GraphValue v, Eq v) =>
PatternGraph extra v -> GraphQuery v
fromPatternGraph PatternGraph extra v
pg = GraphQuery
  { queryNodes :: [Pattern v]
queryNodes            = Map (Id v) (Pattern v) -> [Pattern v]
forall k a. Map k a -> [a]
Map.elems (PatternGraph extra v -> Map (Id v) (Pattern v)
forall extra v. PatternGraph extra v -> Map (Id v) (Pattern v)
pgNodes PatternGraph extra v
pg)
  , queryRelationships :: [Pattern v]
queryRelationships    = Map (Id v) (Pattern v) -> [Pattern v]
forall k a. Map k a -> [a]
Map.elems (PatternGraph extra v -> Map (Id v) (Pattern v)
forall extra v. PatternGraph extra v -> Map (Id v) (Pattern v)
pgRelationships PatternGraph extra v
pg)
  , queryIncidentRels :: Pattern v -> [Pattern v]
queryIncidentRels     = \Pattern v
n ->
      let nodeId :: Id v
nodeId = v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
n)
      in (Pattern v -> Bool) -> [Pattern v] -> [Pattern v]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Pattern v
r -> case (Pattern v -> Maybe (Pattern v)
forall {v}. Pattern v -> Maybe (Pattern v)
srcOf Pattern v
r, Pattern v -> Maybe (Pattern v)
forall {v}. Pattern v -> Maybe (Pattern v)
tgtOf Pattern v
r) of
                   (Just Pattern v
s, Maybe (Pattern v)
_) | v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
s) Id v -> Id v -> Bool
forall a. Eq a => a -> a -> Bool
== Id v
nodeId -> Bool
True
                   (Maybe (Pattern v)
_, Just Pattern v
t) | v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
t) Id v -> Id v -> Bool
forall a. Eq a => a -> a -> Bool
== Id v
nodeId -> Bool
True
                   (Maybe (Pattern v), Maybe (Pattern v))
_ -> Bool
False)
               (Map (Id v) (Pattern v) -> [Pattern v]
forall k a. Map k a -> [a]
Map.elems (PatternGraph extra v -> Map (Id v) (Pattern v)
forall extra v. PatternGraph extra v -> Map (Id v) (Pattern v)
pgRelationships PatternGraph extra v
pg))
  , querySource :: Pattern v -> Maybe (Pattern v)
querySource           = Pattern v -> Maybe (Pattern v)
forall {v}. Pattern v -> Maybe (Pattern v)
srcOf
  , queryTarget :: Pattern v -> Maybe (Pattern v)
queryTarget           = Pattern v -> Maybe (Pattern v)
forall {v}. Pattern v -> Maybe (Pattern v)
tgtOf
  , queryDegree :: Pattern v -> Int
queryDegree           = \Pattern v
n ->
      let nodeId :: Id v
nodeId = v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
n)
      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
r -> case (Pattern v -> Maybe (Pattern v)
forall {v}. Pattern v -> Maybe (Pattern v)
srcOf Pattern v
r, Pattern v -> Maybe (Pattern v)
forall {v}. Pattern v -> Maybe (Pattern v)
tgtOf Pattern v
r) of
                   (Just Pattern v
s, Maybe (Pattern v)
_) | v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
s) Id v -> Id v -> Bool
forall a. Eq a => a -> a -> Bool
== Id v
nodeId -> Bool
True
                   (Maybe (Pattern v)
_, Just Pattern v
t) | v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
t) Id v -> Id v -> Bool
forall a. Eq a => a -> a -> Bool
== Id v
nodeId -> Bool
True
                   (Maybe (Pattern v), Maybe (Pattern v))
_ -> Bool
False)
               (Map (Id v) (Pattern v) -> [Pattern v]
forall k a. Map k a -> [a]
Map.elems (PatternGraph extra v -> Map (Id v) (Pattern v)
forall extra v. PatternGraph extra v -> Map (Id v) (Pattern v)
pgRelationships PatternGraph extra v
pg))
  , queryNodeById :: Id v -> Maybe (Pattern v)
queryNodeById         = \Id v
i -> Id v -> Map (Id v) (Pattern v) -> Maybe (Pattern v)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Id v
i (PatternGraph extra v -> Map (Id v) (Pattern v)
forall extra v. PatternGraph extra v -> Map (Id v) (Pattern v)
pgNodes PatternGraph extra v
pg)
  , queryRelationshipById :: Id v -> Maybe (Pattern v)
queryRelationshipById = \Id v
i -> Id v -> Map (Id v) (Pattern v) -> Maybe (Pattern v)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Id v
i (PatternGraph extra v -> Map (Id v) (Pattern v)
forall extra v. PatternGraph extra v -> Map (Id v) (Pattern v)
pgRelationships PatternGraph extra v
pg)
  , queryContainers :: Pattern v -> [Pattern v]
queryContainers       = \Pattern v
p ->
      let nodeId :: Id v
nodeId = v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
p)
          inRel :: Pattern v -> Bool
inRel Pattern v
r = case (Pattern v -> Maybe (Pattern v)
forall {v}. Pattern v -> Maybe (Pattern v)
srcOf Pattern v
r, Pattern v -> Maybe (Pattern v)
forall {v}. Pattern v -> Maybe (Pattern v)
tgtOf Pattern v
r) of
            (Just Pattern v
s, Maybe (Pattern v)
_) | v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
s) Id v -> Id v -> Bool
forall a. Eq a => a -> a -> Bool
== Id v
nodeId -> Bool
True
            (Maybe (Pattern v)
_, Just Pattern v
t) | v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
t) Id v -> Id v -> Bool
forall a. Eq a => a -> a -> Bool
== Id v
nodeId -> Bool
True
            (Maybe (Pattern v), Maybe (Pattern v))
_ -> Bool
False
          containingRels :: [Pattern v]
containingRels  = (Pattern v -> Bool) -> [Pattern v] -> [Pattern v]
forall a. (a -> Bool) -> [a] -> [a]
filter Pattern v -> Bool
inRel (Map (Id v) (Pattern v) -> [Pattern v]
forall k a. Map k a -> [a]
Map.elems (PatternGraph extra v -> Map (Id v) (Pattern v)
forall extra v. PatternGraph extra v -> Map (Id v) (Pattern v)
pgRelationships PatternGraph extra v
pg))
          containingWalks :: [Pattern v]
containingWalks = (Pattern v -> Bool) -> [Pattern v] -> [Pattern v]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Pattern v
w -> (Pattern v -> Bool) -> [Pattern v] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Pattern v
r -> v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
r) Id v -> Id v -> Bool
forall a. Eq a => a -> a -> Bool
== Id v
nodeId) (Pattern v -> [Pattern v]
forall v. Pattern v -> [Pattern v]
elements Pattern v
w))
                                   (Map (Id v) (Pattern v) -> [Pattern v]
forall k a. Map k a -> [a]
Map.elems (PatternGraph extra v -> Map (Id v) (Pattern v)
forall extra v. PatternGraph extra v -> Map (Id v) (Pattern v)
pgWalks PatternGraph extra v
pg))
          containingAnnotations :: [Pattern v]
containingAnnotations = (Pattern v -> Bool) -> [Pattern v] -> [Pattern v]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Pattern v
a -> case Pattern v -> [Pattern v]
forall v. Pattern v -> [Pattern v]
elements Pattern v
a of
                                            [Pattern v
inner] -> v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
inner) Id v -> Id v -> Bool
forall a. Eq a => a -> a -> Bool
== Id v
nodeId
                                            [Pattern v]
_ -> Bool
False)
                                         (Map (Id v) (Pattern v) -> [Pattern v]
forall k a. Map k a -> [a]
Map.elems (PatternGraph extra v -> Map (Id v) (Pattern v)
forall extra v. PatternGraph extra v -> Map (Id v) (Pattern v)
pgAnnotations PatternGraph extra v
pg))
      in [Pattern v]
containingRels [Pattern v] -> [Pattern v] -> [Pattern v]
forall a. [a] -> [a] -> [a]
++ [Pattern v]
containingWalks [Pattern v] -> [Pattern v] -> [Pattern v]
forall a. [a] -> [a] -> [a]
++ [Pattern v]
containingAnnotations
  }
  where
    srcOf :: Pattern v -> Maybe (Pattern v)
srcOf (Pattern v
_ (Pattern v
s:[Pattern v]
_)) = Pattern v -> Maybe (Pattern v)
forall a. a -> Maybe a
Just Pattern v
s
    srcOf Pattern v
_                  = Maybe (Pattern v)
forall a. Maybe a
Nothing
    tgtOf :: Pattern v -> Maybe (Pattern v)
tgtOf (Pattern v
_ [Pattern v
_, Pattern v
t]) = Pattern v -> Maybe (Pattern v)
forall a. a -> Maybe a
Just Pattern v
t
    tgtOf Pattern v
_                  = Maybe (Pattern v)
forall a. Maybe a
Nothing

-- ============================================================================
-- toGraphView
-- ============================================================================

-- | Construct a 'GraphView' from a 'PatternGraph'.
--
-- The 'GraphClassifier' determines the 'GraphClass' tag for each element.
-- 'viewQuery' is the snapshot query built from the same graph; it is never
-- updated by subsequent transformations, ensuring deterministic context-aware
-- operations.
--
-- Note: defined here (not in "Pattern.Graph") to avoid a circular import —
-- 'Pattern.Graph' cannot import 'PatternGraph'.
toGraphView
  :: (GraphValue v, Eq v)
  => GraphClassifier extra v
  -> PatternGraph extra v
  -> GraphView extra v
toGraphView :: forall v extra.
(GraphValue v, Eq v) =>
GraphClassifier extra v
-> PatternGraph extra v -> GraphView extra v
toGraphView GraphClassifier extra v
classifier PatternGraph extra v
pg =
  GraphView
    { viewQuery :: GraphQuery v
viewQuery    = PatternGraph extra v -> GraphQuery v
forall v extra.
(GraphValue v, Eq v) =>
PatternGraph extra v -> GraphQuery v
fromPatternGraph PatternGraph extra v
pg
    , viewElements :: [(GraphClass extra, Pattern v)]
viewElements = [(GraphClass extra, Pattern v)]
taggedElems
    }
  where
    taggedElems :: [(GraphClass extra, Pattern v)]
taggedElems =
      (Pattern v -> (GraphClass extra, Pattern v))
-> [Pattern v] -> [(GraphClass extra, Pattern v)]
forall a b. (a -> b) -> [a] -> [b]
map (\Pattern v
p -> (GraphClassifier extra v -> Pattern v -> GraphClass extra
forall extra v.
GraphClassifier extra v -> Pattern v -> GraphClass extra
classify GraphClassifier extra v
classifier Pattern v
p, Pattern v
p)) ([Pattern v] -> [(GraphClass extra, Pattern v)])
-> [Pattern v] -> [(GraphClass extra, Pattern v)]
forall a b. (a -> b) -> a -> b
$
        Map (Id v) (Pattern v) -> [Pattern v]
forall k a. Map k a -> [a]
Map.elems (PatternGraph extra v -> Map (Id v) (Pattern v)
forall extra v. PatternGraph extra v -> Map (Id v) (Pattern v)
pgNodes PatternGraph extra v
pg)
        [Pattern v] -> [Pattern v] -> [Pattern v]
forall a. [a] -> [a] -> [a]
++ Map (Id v) (Pattern v) -> [Pattern v]
forall k a. Map k a -> [a]
Map.elems (PatternGraph extra v -> Map (Id v) (Pattern v)
forall extra v. PatternGraph extra v -> Map (Id v) (Pattern v)
pgRelationships PatternGraph extra v
pg)
        [Pattern v] -> [Pattern v] -> [Pattern v]
forall a. [a] -> [a] -> [a]
++ Map (Id v) (Pattern v) -> [Pattern v]
forall k a. Map k a -> [a]
Map.elems (PatternGraph extra v -> Map (Id v) (Pattern v)
forall extra v. PatternGraph extra v -> Map (Id v) (Pattern v)
pgWalks PatternGraph extra v
pg)
        [Pattern v] -> [Pattern v] -> [Pattern v]
forall a. [a] -> [a] -> [a]
++ Map (Id v) (Pattern v) -> [Pattern v]
forall k a. Map k a -> [a]
Map.elems (PatternGraph extra v -> Map (Id v) (Pattern v)
forall extra v. PatternGraph extra v -> Map (Id v) (Pattern v)
pgAnnotations PatternGraph extra v
pg)
        [Pattern v] -> [Pattern v] -> [Pattern v]
forall a. [a] -> [a] -> [a]
++ ((extra, Pattern v) -> Pattern v)
-> [(extra, Pattern v)] -> [Pattern v]
forall a b. (a -> b) -> [a] -> [b]
map (extra, Pattern v) -> Pattern v
forall a b. (a, b) -> b
snd (Map (Id v) (extra, Pattern v) -> [(extra, Pattern v)]
forall k a. Map k a -> [a]
Map.elems (PatternGraph extra v -> Map (Id v) (extra, Pattern v)
forall extra v.
PatternGraph extra v -> Map (Id v) (extra, Pattern v)
pgOther PatternGraph extra v
pg))

-- ============================================================================
-- materialize
-- ============================================================================

-- | Reconstruct a 'PatternGraph' from a 'GraphView'.
--
-- Folds all elements in 'viewElements' through 'mergeWithPolicy', using the
-- provided classifier and reconciliation policy. This is the finalizer for a
-- lazy transformation pipeline.
--
-- Note: defined here (not in "Pattern.Graph") to avoid a circular import.
materialize
  :: ( GraphValue v, Eq v
     , Reconcile.Mergeable v, Reconcile.HasIdentity v (Id v), Reconcile.Refinable v )
  => GraphClassifier extra v
  -> Reconcile.ReconciliationPolicy (Reconcile.MergeStrategy v)
  -> GraphView extra v
  -> PatternGraph extra v
materialize :: forall v extra.
(GraphValue v, Eq v, Mergeable v, HasIdentity v (Id v),
 Refinable v) =>
GraphClassifier extra v
-> ReconciliationPolicy (MergeStrategy v)
-> GraphView extra v
-> PatternGraph extra v
materialize GraphClassifier extra v
classifier ReconciliationPolicy (MergeStrategy v)
policy (GraphView GraphQuery v
_ [(GraphClass extra, Pattern v)]
elems) =
  (PatternGraph extra v
 -> (GraphClass extra, Pattern v) -> PatternGraph extra v)
-> PatternGraph extra v
-> [(GraphClass extra, Pattern v)]
-> PatternGraph extra v
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\PatternGraph extra v
g (GraphClass extra
_, Pattern v
p) -> GraphClassifier extra v
-> ReconciliationPolicy (MergeStrategy v)
-> Pattern v
-> PatternGraph extra v
-> PatternGraph extra v
forall v extra.
(GraphValue v, Eq v, Mergeable v, HasIdentity v (Id v),
 Refinable v) =>
GraphClassifier extra v
-> ReconciliationPolicy (MergeStrategy v)
-> Pattern v
-> PatternGraph extra v
-> PatternGraph extra v
mergeWithPolicy GraphClassifier extra v
classifier ReconciliationPolicy (MergeStrategy v)
policy Pattern v
p PatternGraph extra v
g) PatternGraph extra v
forall v extra. GraphValue v => PatternGraph extra v
empty [(GraphClass extra, Pattern v)]
elems