-- | Graph Lens: Interpretive view of Pattern structures as graphs.
--
-- This module provides the Graph Lens feature, which enables interpreting
-- Pattern structures as graph structures (nodes, relationships, walks) through
-- a minimal, elegant design based on a single predicate.
--
-- == Overview
--
-- A Graph Lens provides an interpretive view of a Pattern as a graph structure.
-- Rather than defining graph concepts (nodes, relationships, walks) as intrinsic
-- properties of Pattern, they emerge through the lens's interpretation. This
-- design enables multiple graph views of the same Pattern and supports
-- higher-order graphs where relationships or entire graphs become nodes.
--
-- == Core Design
--
-- The Graph Lens consists of:
--
-- * @scopePattern@: The Pattern that defines the boundary for all graph operations.
--   Only direct elements of this pattern are considered for graph structure.
-- * @testNode@: A predicate determining which direct elements are nodes.
--   All other graph concepts (relationships, walks) derive from this single predicate.
--
-- == Design Principles
--
-- 1. **Scope-bounded operations**: All graph operations only consider direct elements
--    of @scopePattern@, never descending into nested structures.
--
-- 2. **Single predicate foundation**: Only @testNode@ is required. All other graph
--    predicates (relationships, walks, etc.) are derived from this.
--
-- 3. **Context captured at construction**: If a predicate needs context, that context
--    must be captured when the predicate is created, not during evaluation.
--
-- 4. **Interpretation, not intrinsic**: Graph structure is not a property of Pattern
--    itself, but an interpretation through the lens.
--
-- == Categorical Interpretation
--
-- Graph Lens provides a functorial interpretation where Pattern structures are
-- transformed into graph interpretations. The transformation Pattern → Graph
-- interpretation is functorial in nature.
--
-- == Example
--
-- >>> let graphPattern = pattern "graph" [point "a", point "b", pattern "r1" [point "a", point "b"]]
-- >>> let isAtomic (Pattern _ els) = null els
-- >>> let atomicLens = GraphLens graphPattern isAtomic
-- >>> nodes atomicLens
-- [Pattern "a" [],Pattern "b" []]
--
-- See @design/graph-lens.md@ and @specs/023-graph-lens/quickstart.md@ for
-- comprehensive examples and usage patterns.
module Pattern.Graph
  ( -- * Graph Lens Type
    GraphLens(..)
    -- * Node Operations
  , nodes
  , isNode
    -- * Relationship Operations
  , isRelationship
  , relationships
  , source
  , target
  , reverseRel
    -- * Walk Operations
  , isWalk
  , walks
  , walkNodes
    -- * Navigation Operations
  , neighbors
  , incidentRels
  , degree
    -- * Graph Analysis Operations
  , connectedComponents  -- Requires Ord v
  , bfs                   -- Requires Ord v
  , findPath              -- Requires Ord v
  ) where

import Pattern.Core (Pattern(..))
import Data.Maybe (mapMaybe)
import qualified Data.Set as Set
import Data.Map ()

-- | A Graph Lens provides an interpretive view of a Pattern as a graph structure.
-- 
-- The lens consists of:
-- * @scopePattern@: The Pattern that defines the boundary for all graph operations.
--   Only direct elements of this pattern are considered for graph structure.
-- * @testNode@: A predicate determining which direct elements are nodes.
--   All other graph concepts (relationships, walks) derive from this predicate.
--
-- == Categorical Interpretation
--
-- Graph Lens provides a functorial interpretation where Pattern structures are
-- transformed into graph interpretations. The transformation Pattern → Graph
-- interpretation is functorial in nature.
--
-- == Design Principles
--
-- 1. Scope-bounded: All operations only consider direct elements of scopePattern
-- 2. Single predicate foundation: Only testNode is required, all else derives
-- 3. Context at construction: Predicate context captured when lens is created
-- 4. Interpretation, not intrinsic: Graph structure is an interpretation, not
--    a property of Pattern itself
--
-- == Example
--
-- >>> let atomicLens = GraphLens pattern (\(Pattern _ els) -> null els)
-- >>> nodes atomicLens
-- [[a], [b], [c]]
data GraphLens v = GraphLens
  { forall v. GraphLens v -> Pattern v
scopePattern :: Pattern v
    -- ^ The Pattern that defines the graph scope
  , forall v. GraphLens v -> Pattern v -> Bool
testNode     :: Pattern v -> Bool
    -- ^ Predicate determining which elements are nodes
  }

-- | Extract all nodes from the graph lens.
--
-- Nodes are direct elements of scopePattern that satisfy the testNode predicate.
--
-- == Time Complexity
-- O(n) where n is the number of direct elements in scopePattern
--
-- == Example
--
-- >>> let lens = GraphLens pattern isAtomic
-- >>> nodes lens
-- [[a], [b], [c]]
nodes :: GraphLens v -> [Pattern v]
nodes :: forall v. GraphLens v -> [Pattern v]
nodes lens :: GraphLens v
lens@(GraphLens (Pattern v
_ [Pattern v]
elems) Pattern v -> Bool
_) = 
  (Pattern v -> Bool) -> [Pattern v] -> [Pattern v]
forall a. (a -> Bool) -> [a] -> [a]
filter (GraphLens v -> Pattern v -> Bool
forall v. GraphLens v -> Pattern v -> Bool
isNode GraphLens v
lens) [Pattern v]
elems

-- | Determine if a Pattern is a node according to the lens.
--
-- This is the context-aware version that uses the lens's testNode predicate.
-- The lens parameter provides the predicate context.
--
-- == Example
--
-- >>> let lens = GraphLens pattern isAtomic
-- >>> isNode lens (point "a")
-- True
-- >>> isNode lens (pattern "rel" [point "a", point "b"])
-- False
isNode :: GraphLens v -> Pattern v -> Bool
isNode :: forall v. GraphLens v -> Pattern v -> Bool
isNode (GraphLens Pattern v
_ Pattern v -> Bool
testNodePred) Pattern v
p = Pattern v -> Bool
testNodePred Pattern v
p

-- * Relationship Operations

-- | Determine if a Pattern is a relationship according to the lens.
--
-- A relationship is a non-node pattern with exactly two node elements.
--
-- == Properties
-- * Must not be a node (does not satisfy testNode predicate)
-- * Must have exactly two elements
-- * Both elements must be nodes (according to the lens)
--
-- == Example
--
-- >>> let lens = GraphLens pattern isAtomic
-- >>> let rel = pattern "knows" [point "Alice", point "Bob"]
-- >>> isRelationship lens rel
-- True
isRelationship :: GraphLens v -> Pattern v -> Bool
isRelationship :: forall v. GraphLens v -> Pattern v -> Bool
isRelationship lens :: GraphLens v
lens@(GraphLens Pattern v
_ Pattern v -> Bool
_) p :: Pattern v
p@(Pattern v
_ [Pattern v]
els) =
  Bool -> Bool
not (GraphLens v -> Pattern v -> Bool
forall v. GraphLens v -> Pattern v -> Bool
isNode GraphLens v
lens Pattern v
p) Bool -> Bool -> Bool
&&
  [Pattern v] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pattern v]
els Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 Bool -> Bool -> Bool
&&
  (Pattern v -> Bool) -> [Pattern v] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (GraphLens v -> Pattern v -> Bool
forall v. GraphLens v -> Pattern v -> Bool
isNode GraphLens v
lens) [Pattern v]
els

-- | Extract all relationships from the graph lens.
--
-- Relationships are non-node patterns with exactly two node elements.
--
-- == Time Complexity
-- O(n) where n is the number of direct elements in scopePattern
--
-- == Example
--
-- >>> let lens = GraphLens pattern isAtomic
-- >>> relationships lens
-- [[knows | [Alice], [Bob]], [likes | [Bob], [Charlie]]]
relationships :: GraphLens v -> [Pattern v]
relationships :: forall v. GraphLens v -> [Pattern v]
relationships lens :: GraphLens v
lens@(GraphLens (Pattern v
_ [Pattern v]
elems) Pattern v -> Bool
_) =
  (Pattern v -> Bool) -> [Pattern v] -> [Pattern v]
forall a. (a -> Bool) -> [a] -> [a]
filter (GraphLens v -> Pattern v -> Bool
forall v. GraphLens v -> Pattern v -> Bool
isRelationship GraphLens v
lens) [Pattern v]
elems

-- | Extract the source node from a relationship.
--
-- For directed relationships, the source is the first element.
-- Returns Nothing if the pattern is not a relationship.
--
-- == Example
--
-- >>> let lens = GraphLens pattern isAtomic
-- >>> let rel = pattern "knows" [point "Alice", point "Bob"]
-- >>> source lens rel
-- Just (point "Alice")
source :: GraphLens v -> Pattern v -> Maybe (Pattern v)
source :: forall v. GraphLens v -> Pattern v -> Maybe (Pattern v)
source GraphLens v
lens p :: Pattern v
p@(Pattern v
_ (Pattern v
s:[Pattern v]
_))
  | GraphLens v -> Pattern v -> Bool
forall v. GraphLens v -> Pattern v -> Bool
isRelationship GraphLens v
lens Pattern v
p = Pattern v -> Maybe (Pattern v)
forall a. a -> Maybe a
Just Pattern v
s
  | Bool
otherwise = Maybe (Pattern v)
forall a. Maybe a
Nothing
source GraphLens v
_ Pattern v
_ = Maybe (Pattern v)
forall a. Maybe a
Nothing

-- | Extract the target node from a relationship.
--
-- For directed relationships, the target is the second element.
-- Returns Nothing if the pattern is not a relationship.
--
-- == Example
--
-- >>> let lens = GraphLens pattern isAtomic
-- >>> let rel = pattern "knows" [point "Alice", point "Bob"]
-- >>> target lens rel
-- Just (point "Bob")
target :: GraphLens v -> Pattern v -> Maybe (Pattern v)
target :: forall v. GraphLens v -> Pattern v -> Maybe (Pattern v)
target GraphLens v
lens p :: Pattern v
p@(Pattern v
_ [Pattern v
_, Pattern v
t])
  | GraphLens v -> Pattern v -> Bool
forall v. GraphLens v -> Pattern v -> Bool
isRelationship GraphLens v
lens Pattern v
p = Pattern v -> Maybe (Pattern v)
forall a. a -> Maybe a
Just Pattern v
t
  | Bool
otherwise = Maybe (Pattern v)
forall a. Maybe a
Nothing
target GraphLens v
_ Pattern v
_ = Maybe (Pattern v)
forall a. Maybe a
Nothing

-- | Reverse the direction of a relationship pattern.
--
-- Swaps the first and second elements, effectively reversing the
-- relationship direction.
--
-- == Example
--
-- >>> let rel = pattern "knows" [point "Alice", point "Bob"]
-- >>> reverseRel rel
-- pattern "knows" [point "Bob", point "Alice"]
reverseRel :: Pattern v -> Pattern v
reverseRel :: forall v. Pattern v -> Pattern v
reverseRel (Pattern v
v [Pattern v
a, Pattern v
b]) = v -> [Pattern v] -> Pattern v
forall v. v -> [Pattern v] -> Pattern v
Pattern v
v [Pattern v
b, Pattern v
a]
reverseRel Pattern v
p = Pattern v
p  -- Return unchanged if not a 2-element pattern

-- * Walk Operations

-- | Check if a list of relationships are consecutively connected.
--
-- Relationships are consecutively connected if the target of one
-- equals the source of the next.
--
-- == Internal Function
-- This is an internal helper function used by isWalk.
consecutivelyConnected :: Eq v => GraphLens v -> [Pattern v] -> Bool
consecutivelyConnected :: forall v. Eq v => GraphLens v -> [Pattern v] -> Bool
consecutivelyConnected GraphLens v
lens [Pattern v]
rels =
  case [Pattern v]
rels of
    [] -> Bool
True
    [Pattern v
_] -> Bool
True
    (Pattern v
r1:Pattern v
r2:[Pattern v]
rest) ->
      case (GraphLens v -> Pattern v -> Maybe (Pattern v)
forall v. GraphLens v -> Pattern v -> Maybe (Pattern v)
target GraphLens v
lens Pattern v
r1, GraphLens v -> Pattern v -> Maybe (Pattern v)
forall v. GraphLens v -> Pattern v -> Maybe (Pattern v)
source GraphLens v
lens Pattern v
r2) of
        (Just Pattern v
t, Just Pattern v
s) -> Pattern v
t Pattern v -> Pattern v -> Bool
forall a. Eq a => a -> a -> Bool
== Pattern v
s Bool -> Bool -> Bool
&& GraphLens v -> [Pattern v] -> Bool
forall v. Eq v => GraphLens v -> [Pattern v] -> Bool
consecutivelyConnected GraphLens v
lens (Pattern v
r2Pattern v -> [Pattern v] -> [Pattern v]
forall a. a -> [a] -> [a]
:[Pattern v]
rest)
        (Maybe (Pattern v), Maybe (Pattern v))
_ -> Bool
False

-- | Determine if a Pattern is a walk according to the lens.
--
-- A walk is a non-node pattern whose elements are all relationships,
-- where consecutive relationships share nodes (target of one equals
-- source of next).
--
-- == Properties
-- * Must not be a node (does not satisfy testNode predicate)
-- * All elements must be relationships (according to the lens)
-- * Consecutive relationships must be connected
--
-- == Example
--
-- >>> let lens = GraphLens pattern isAtomic
-- >>> let walk = pattern "path" [rel1, rel2, rel3]
-- >>> isWalk lens walk
-- True
isWalk :: Eq v => GraphLens v -> Pattern v -> Bool
isWalk :: forall v. Eq v => GraphLens v -> Pattern v -> Bool
isWalk lens :: GraphLens v
lens@(GraphLens Pattern v
_ Pattern v -> Bool
_) p :: Pattern v
p@(Pattern v
_ [Pattern v]
elems) =
  Bool -> Bool
not (GraphLens v -> Pattern v -> Bool
forall v. GraphLens v -> Pattern v -> Bool
isNode GraphLens v
lens Pattern v
p) Bool -> Bool -> Bool
&&
  (Pattern v -> Bool) -> [Pattern v] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (GraphLens v -> Pattern v -> Bool
forall v. GraphLens v -> Pattern v -> Bool
isRelationship GraphLens v
lens) [Pattern v]
elems Bool -> Bool -> Bool
&&
  GraphLens v -> [Pattern v] -> Bool
forall v. Eq v => GraphLens v -> [Pattern v] -> Bool
consecutivelyConnected GraphLens v
lens [Pattern v]
elems

-- | Extract all walks from the graph lens.
--
-- Walks are non-node patterns whose elements are all relationships,
-- where consecutive relationships share nodes.
--
-- == Time Complexity
-- O(n) where n is the number of direct elements in scopePattern
--
-- == Example
--
-- >>> let lens = GraphLens pattern isAtomic
-- >>> walks lens
-- [[path | [rel1], [rel2], [rel3]]]
walks :: Eq v => GraphLens v -> [Pattern v]
walks :: forall v. Eq v => GraphLens v -> [Pattern v]
walks lens :: GraphLens v
lens@(GraphLens (Pattern v
_ [Pattern v]
elems) Pattern v -> Bool
_) =
  (Pattern v -> Bool) -> [Pattern v] -> [Pattern v]
forall a. (a -> Bool) -> [a] -> [a]
filter (GraphLens v -> Pattern v -> Bool
forall v. Eq v => GraphLens v -> Pattern v -> Bool
isWalk GraphLens v
lens) [Pattern v]
elems

-- | Extract nodes from a walk in traversal order.
--
-- Returns the source of the first relationship, followed by the targets
-- of subsequent relationships. Returns empty list if the pattern is not
-- a valid walk.
--
-- == Example
--
-- >>> let lens = GraphLens pattern isAtomic
-- >>> let walk = pattern "path" [rel1, rel2]
-- >>> walkNodes lens walk
-- [pattern "A", pattern "B", pattern "C"]
walkNodes :: Eq v => GraphLens v -> Pattern v -> [Pattern v]
walkNodes :: forall v. Eq v => GraphLens v -> Pattern v -> [Pattern v]
walkNodes GraphLens v
lens p :: Pattern v
p@(Pattern v
_ [Pattern v]
rels)
  | GraphLens v -> Pattern v -> Bool
forall v. Eq v => GraphLens v -> Pattern v -> Bool
isWalk GraphLens v
lens Pattern v
p = case [Pattern v]
rels of
      [] -> []
      (Pattern v
r:[Pattern v]
rest) -> case GraphLens v -> Pattern v -> Maybe (Pattern v)
forall v. GraphLens v -> Pattern v -> Maybe (Pattern v)
source GraphLens v
lens Pattern v
r of
        Just Pattern v
s -> Pattern v
s Pattern v -> [Pattern v] -> [Pattern v]
forall a. a -> [a] -> [a]
: (Pattern v -> Maybe (Pattern v)) -> [Pattern v] -> [Pattern v]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (GraphLens v -> Pattern v -> Maybe (Pattern v)
forall v. GraphLens v -> Pattern v -> Maybe (Pattern v)
target GraphLens v
lens) (Pattern v
rPattern v -> [Pattern v] -> [Pattern v]
forall a. a -> [a] -> [a]
:[Pattern v]
rest)
        Maybe (Pattern v)
Nothing -> []
  | Bool
otherwise = []

-- * Navigation Operations

-- | Find all neighbors of a node.
--
-- Neighbors are nodes connected to the given node via relationships
-- (either as source or target).
--
-- == Time Complexity
-- O(r) where r is the number of relationships in the graph
--
-- == Example
--
-- >>> let lens = GraphLens pattern isAtomic
-- >>> neighbors lens (point "Alice")
-- [point "Bob", pattern "Charlie"]
neighbors :: Eq v => GraphLens v -> Pattern v -> [Pattern v]
neighbors :: forall v. Eq v => GraphLens v -> Pattern v -> [Pattern v]
neighbors GraphLens v
lens Pattern v
node =
  let rels :: [Pattern v]
rels = GraphLens v -> [Pattern v]
forall v. GraphLens v -> [Pattern v]
relationships GraphLens v
lens
      connectedNodes :: [Pattern v]
connectedNodes = (Pattern v -> [Pattern v]) -> [Pattern v] -> [Pattern v]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Pattern v
r -> 
        case (GraphLens v -> Pattern v -> Maybe (Pattern v)
forall v. GraphLens v -> Pattern v -> Maybe (Pattern v)
source GraphLens v
lens Pattern v
r, GraphLens v -> Pattern v -> Maybe (Pattern v)
forall v. GraphLens v -> Pattern v -> Maybe (Pattern v)
target GraphLens v
lens Pattern v
r) of
          (Just Pattern v
s, Just Pattern v
t) | Pattern v
s Pattern v -> Pattern v -> Bool
forall a. Eq a => a -> a -> Bool
== Pattern v
node -> [Pattern v
t]
                           | Pattern v
t Pattern v -> Pattern v -> Bool
forall a. Eq a => a -> a -> Bool
== Pattern v
node -> [Pattern v
s]
          (Maybe (Pattern v), Maybe (Pattern v))
_ -> []
        ) [Pattern v]
rels
  in [Pattern v]
connectedNodes

-- | Find all relationships involving a node.
--
-- Returns relationships where the node is either source or target.
--
-- == Time Complexity
-- O(r) where r is the number of relationships in the graph
--
-- == Example
--
-- >>> let lens = GraphLens pattern isAtomic
-- >>> incidentRels lens (point "Alice")
-- [[knows | [Alice], [Bob]], [likes | [Charlie], [Alice]]]
incidentRels :: Eq v => GraphLens v -> Pattern v -> [Pattern v]
incidentRels :: forall v. Eq v => GraphLens v -> Pattern v -> [Pattern v]
incidentRels GraphLens v
lens Pattern v
node =
  (Pattern v -> Bool) -> [Pattern v] -> [Pattern v]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Pattern v
r ->
    case (GraphLens v -> Pattern v -> Maybe (Pattern v)
forall v. GraphLens v -> Pattern v -> Maybe (Pattern v)
source GraphLens v
lens Pattern v
r, GraphLens v -> Pattern v -> Maybe (Pattern v)
forall v. GraphLens v -> Pattern v -> Maybe (Pattern v)
target GraphLens v
lens Pattern v
r) of
      (Just Pattern v
s, Maybe (Pattern v)
_) | Pattern v
s Pattern v -> Pattern v -> Bool
forall a. Eq a => a -> a -> Bool
== Pattern v
node -> Bool
True
      (Maybe (Pattern v)
_, Just Pattern v
t) | Pattern v
t Pattern v -> Pattern v -> Bool
forall a. Eq a => a -> a -> Bool
== Pattern v
node -> Bool
True
      (Maybe (Pattern v), Maybe (Pattern v))
_ -> Bool
False
    ) (GraphLens v -> [Pattern v]
forall v. GraphLens v -> [Pattern v]
relationships GraphLens v
lens)

-- | Compute the degree of a node (number of incident relationships).
--
-- The degree is the count of relationships where the node is either
-- source or target.
--
-- == Time Complexity
-- O(r) where r is the number of relationships in the graph
--
-- == Example
--
-- >>> let lens = GraphLens pattern isAtomic
-- >>> degree lens (point "Alice")
-- 3
degree :: Eq v => GraphLens v -> Pattern v -> Int
degree :: forall v. Eq v => GraphLens v -> Pattern v -> Int
degree GraphLens v
lens Pattern v
node = [Pattern v] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (GraphLens v -> Pattern v -> [Pattern v]
forall v. Eq v => GraphLens v -> Pattern v -> [Pattern v]
incidentRels GraphLens v
lens Pattern v
node)

-- * Graph Analysis Operations

-- | Find all connected components in the graph.
--
-- A connected component is a set of nodes that are reachable from
-- each other via relationships. Returns a list of lists, where each
-- inner list represents a component.
--
-- == Time Complexity
-- O(n + r) where n is number of nodes and r is number of relationships
--
-- == Example
--
-- >>> let lens = GraphLens pattern isAtomic
-- >>> connectedComponents lens
-- [[pattern "A", pattern "B", pattern "C"], [pattern "D", pattern "E"]]
connectedComponents :: Ord v => GraphLens v -> [[Pattern v]]
connectedComponents :: forall v. Ord v => GraphLens v -> [[Pattern v]]
connectedComponents GraphLens v
lens = GraphLens v
-> [Pattern v] -> Set (Pattern v) -> [[Pattern v]] -> [[Pattern v]]
forall v.
Ord v =>
GraphLens v
-> [Pattern v] -> Set (Pattern v) -> [[Pattern v]] -> [[Pattern v]]
findComponents GraphLens v
lens (GraphLens v -> [Pattern v]
forall v. GraphLens v -> [Pattern v]
nodes GraphLens v
lens) Set (Pattern v)
forall a. Set a
Set.empty []

findComponents :: Ord v => GraphLens v -> [Pattern v] -> Set.Set (Pattern v) -> [[Pattern v]] -> [[Pattern v]]
findComponents :: forall v.
Ord v =>
GraphLens v
-> [Pattern v] -> Set (Pattern v) -> [[Pattern v]] -> [[Pattern v]]
findComponents GraphLens v
_ [] Set (Pattern v)
_ [[Pattern v]]
acc = [[Pattern v]] -> [[Pattern v]]
forall a. [a] -> [a]
reverse [[Pattern v]]
acc
findComponents GraphLens v
lens (Pattern v
n:[Pattern v]
ns) Set (Pattern v)
visited [[Pattern v]]
acc =
  if Pattern v -> Set (Pattern v) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Pattern v
n Set (Pattern v)
visited
  then GraphLens v
-> [Pattern v] -> Set (Pattern v) -> [[Pattern v]] -> [[Pattern v]]
forall v.
Ord v =>
GraphLens v
-> [Pattern v] -> Set (Pattern v) -> [[Pattern v]] -> [[Pattern v]]
findComponents GraphLens v
lens [Pattern v]
ns Set (Pattern v)
visited [[Pattern v]]
acc
  else
    let component :: [Pattern v]
component = GraphLens v -> Pattern v -> [Pattern v]
forall v. Ord v => GraphLens v -> Pattern v -> [Pattern v]
bfs GraphLens v
lens Pattern v
n
        newVisited :: Set (Pattern v)
newVisited = Set (Pattern v) -> Set (Pattern v) -> Set (Pattern v)
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set (Pattern v)
visited ([Pattern v] -> Set (Pattern v)
forall a. Ord a => [a] -> Set a
Set.fromList [Pattern v]
component)
        newAcc :: [[Pattern v]]
newAcc = [Pattern v]
component [Pattern v] -> [[Pattern v]] -> [[Pattern v]]
forall a. a -> [a] -> [a]
: [[Pattern v]]
acc
    in GraphLens v
-> [Pattern v] -> Set (Pattern v) -> [[Pattern v]] -> [[Pattern v]]
forall v.
Ord v =>
GraphLens v
-> [Pattern v] -> Set (Pattern v) -> [[Pattern v]] -> [[Pattern v]]
findComponents GraphLens v
lens [Pattern v]
ns Set (Pattern v)
newVisited [[Pattern v]]
newAcc

-- | Perform breadth-first search from a starting node.
--
-- Returns all nodes reachable from the starting node via relationships.
--
-- == Time Complexity
-- O(n + r) where n is number of nodes and r is number of relationships
--
-- == Example
--
-- >>> let lens = GraphLens pattern isAtomic
-- >>> bfs lens (point "Alice")
-- [point "Alice", point "Bob", pattern "Charlie"]
bfs :: Ord v => GraphLens v -> Pattern v -> [Pattern v]
bfs :: forall v. Ord v => GraphLens v -> Pattern v -> [Pattern v]
bfs GraphLens v
lens Pattern v
start = GraphLens v
-> Set (Pattern v) -> [Pattern v] -> [Pattern v] -> [Pattern v]
forall v.
Ord v =>
GraphLens v
-> Set (Pattern v) -> [Pattern v] -> [Pattern v] -> [Pattern v]
bfsHelper GraphLens v
lens Set (Pattern v)
forall a. Set a
Set.empty [Pattern v
start] []

bfsHelper :: Ord v => GraphLens v -> Set.Set (Pattern v) -> [Pattern v] -> [Pattern v] -> [Pattern v]
bfsHelper :: forall v.
Ord v =>
GraphLens v
-> Set (Pattern v) -> [Pattern v] -> [Pattern v] -> [Pattern v]
bfsHelper GraphLens v
_ Set (Pattern v)
_ [] [Pattern v]
acc = [Pattern v] -> [Pattern v]
forall a. [a] -> [a]
reverse [Pattern v]
acc
bfsHelper GraphLens v
lens Set (Pattern v)
visited (Pattern v
n:[Pattern v]
queue) [Pattern v]
acc
  | Pattern v -> Set (Pattern v) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Pattern v
n Set (Pattern v)
visited = GraphLens v
-> Set (Pattern v) -> [Pattern v] -> [Pattern v] -> [Pattern v]
forall v.
Ord v =>
GraphLens v
-> Set (Pattern v) -> [Pattern v] -> [Pattern v] -> [Pattern v]
bfsHelper GraphLens v
lens Set (Pattern v)
visited [Pattern v]
queue [Pattern v]
acc
  | Bool
otherwise =
      let newVisited :: Set (Pattern v)
newVisited = Pattern v -> Set (Pattern v) -> Set (Pattern v)
forall a. Ord a => a -> Set a -> Set a
Set.insert Pattern v
n Set (Pattern v)
visited
          newAcc :: [Pattern v]
newAcc = Pattern v
n Pattern v -> [Pattern v] -> [Pattern v]
forall a. a -> [a] -> [a]
: [Pattern v]
acc
          nodeNeighbors :: [Pattern v]
nodeNeighbors = GraphLens v -> Pattern v -> [Pattern v]
forall v. Eq v => GraphLens v -> Pattern v -> [Pattern v]
Pattern.Graph.neighbors GraphLens v
lens Pattern v
n
          newQueue :: [Pattern v]
newQueue = [Pattern v]
queue [Pattern v] -> [Pattern v] -> [Pattern v]
forall a. [a] -> [a] -> [a]
++ (Pattern v -> Bool) -> [Pattern v] -> [Pattern v]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Pattern v -> Bool) -> Pattern v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pattern v -> Set (Pattern v) -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set (Pattern v)
newVisited)) [Pattern v]
nodeNeighbors
      in GraphLens v
-> Set (Pattern v) -> [Pattern v] -> [Pattern v] -> [Pattern v]
forall v.
Ord v =>
GraphLens v
-> Set (Pattern v) -> [Pattern v] -> [Pattern v] -> [Pattern v]
bfsHelper GraphLens v
lens Set (Pattern v)
newVisited [Pattern v]
newQueue [Pattern v]
newAcc

-- | Find a path between two nodes if one exists.
--
-- Returns Just [nodes] if a path exists, Nothing otherwise.
-- The path is a sequence of nodes connecting start to end.
--
-- == Time Complexity
-- O(n + r) where n is number of nodes and r is number of relationships
--
-- == Example
--
-- >>> let lens = GraphLens pattern isAtomic
-- >>> findPath lens (point "Alice") (pattern "Charlie")
-- Just [point "Alice", point "Bob", pattern "Charlie"]
findPath :: Ord v => GraphLens v -> Pattern v -> Pattern v -> Maybe [Pattern v]
findPath :: forall v.
Ord v =>
GraphLens v -> Pattern v -> Pattern v -> Maybe [Pattern v]
findPath GraphLens v
lens Pattern v
start Pattern v
end
  | Pattern v
start Pattern v -> Pattern v -> Bool
forall a. Eq a => a -> a -> Bool
== Pattern v
end = [Pattern v] -> Maybe [Pattern v]
forall a. a -> Maybe a
Just [Pattern v
start]
  | Bool
otherwise = GraphLens v
-> Set (Pattern v)
-> [(Pattern v, [Pattern v])]
-> Pattern v
-> Maybe [Pattern v]
forall v.
Ord v =>
GraphLens v
-> Set (Pattern v)
-> [(Pattern v, [Pattern v])]
-> Pattern v
-> Maybe [Pattern v]
findPathHelper GraphLens v
lens Set (Pattern v)
forall a. Set a
Set.empty [(Pattern v
start, [Pattern v
start])] Pattern v
end

findPathHelper :: Ord v => GraphLens v -> Set.Set (Pattern v) -> [(Pattern v, [Pattern v])] -> Pattern v -> Maybe [Pattern v]
findPathHelper :: forall v.
Ord v =>
GraphLens v
-> Set (Pattern v)
-> [(Pattern v, [Pattern v])]
-> Pattern v
-> Maybe [Pattern v]
findPathHelper GraphLens v
_ Set (Pattern v)
_ [] Pattern v
_ = Maybe [Pattern v]
forall a. Maybe a
Nothing
findPathHelper GraphLens v
lens Set (Pattern v)
visited ((Pattern v
n, [Pattern v]
path):[(Pattern v, [Pattern v])]
queue) Pattern v
targetNode
  | Pattern v
n Pattern v -> Pattern v -> Bool
forall a. Eq a => a -> a -> Bool
== Pattern v
targetNode = [Pattern v] -> Maybe [Pattern v]
forall a. a -> Maybe a
Just ([Pattern v] -> [Pattern v]
forall a. [a] -> [a]
reverse [Pattern v]
path)
  | Pattern v -> Set (Pattern v) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Pattern v
n Set (Pattern v)
visited = GraphLens v
-> Set (Pattern v)
-> [(Pattern v, [Pattern v])]
-> Pattern v
-> Maybe [Pattern v]
forall v.
Ord v =>
GraphLens v
-> Set (Pattern v)
-> [(Pattern v, [Pattern v])]
-> Pattern v
-> Maybe [Pattern v]
findPathHelper GraphLens v
lens Set (Pattern v)
visited [(Pattern v, [Pattern v])]
queue Pattern v
targetNode
  | Bool
otherwise =
      let newVisited :: Set (Pattern v)
newVisited = Pattern v -> Set (Pattern v) -> Set (Pattern v)
forall a. Ord a => a -> Set a -> Set a
Set.insert Pattern v
n Set (Pattern v)
visited
          nodeNeighbors :: [Pattern v]
nodeNeighbors = GraphLens v -> Pattern v -> [Pattern v]
forall v. Eq v => GraphLens v -> Pattern v -> [Pattern v]
Pattern.Graph.neighbors GraphLens v
lens Pattern v
n
          newPaths :: [(Pattern v, [Pattern v])]
newPaths = (Pattern v -> (Pattern v, [Pattern v]))
-> [Pattern v] -> [(Pattern v, [Pattern v])]
forall a b. (a -> b) -> [a] -> [b]
map (\Pattern v
neighbor -> (Pattern v
neighbor, Pattern v
neighborPattern v -> [Pattern v] -> [Pattern v]
forall a. a -> [a] -> [a]
:[Pattern v]
path)) [Pattern v]
nodeNeighbors
          unvisitedPaths :: [(Pattern v, [Pattern v])]
unvisitedPaths = ((Pattern v, [Pattern v]) -> Bool)
-> [(Pattern v, [Pattern v])] -> [(Pattern v, [Pattern v])]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Pattern v
neighbor, [Pattern v]
_) -> Bool -> Bool
not (Pattern v -> Set (Pattern v) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Pattern v
neighbor Set (Pattern v)
newVisited)) [(Pattern v, [Pattern v])]
newPaths
          newQueue :: [(Pattern v, [Pattern v])]
newQueue = [(Pattern v, [Pattern v])]
queue [(Pattern v, [Pattern v])]
-> [(Pattern v, [Pattern v])] -> [(Pattern v, [Pattern v])]
forall a. [a] -> [a] -> [a]
++ [(Pattern v, [Pattern v])]
unvisitedPaths
      in GraphLens v
-> Set (Pattern v)
-> [(Pattern v, [Pattern v])]
-> Pattern v
-> Maybe [Pattern v]
forall v.
Ord v =>
GraphLens v
-> Set (Pattern v)
-> [(Pattern v, [Pattern v])]
-> Pattern v
-> Maybe [Pattern v]
findPathHelper GraphLens v
lens Set (Pattern v)
newVisited [(Pattern v, [Pattern v])]
newQueue Pattern v
targetNode