{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
-- | Transformation of CST (Concrete Syntax Tree) to Pattern Subject.
--
-- This module provides functions to transform parsed gram notation (CST)
-- into the core Pattern Subject representation. The default behavior
-- preserves anonymous subjects as 'Symbol ""' to enable round-trip
-- compatibility, while optional functions are available for explicit
-- ID assignment when needed.
--
-- == Design Decision: Anonymity Preservation by Default
--
-- The default 'transformGram' function preserves anonymous subjects
-- (represented as 'Symbol ""') rather than assigning generated IDs.
-- This enables true round-trip compatibility: parsing and serializing
-- anonymous patterns preserves their anonymous nature.
--
-- == When to Use ID Assignment
--
-- Use 'transformGramWithIds' or 'assignIdentities' when:
--
-- * You need unique identifiers for graph algorithms
-- * You need to distinguish between anonymous instances
-- * You're working with external systems that require explicit IDs
--
-- Use 'transformGram' (default) when:
--
-- * You need round-trip compatibility
-- * You want to preserve the original gram notation structure
-- * Anonymous subjects should remain anonymous
--
-- == Examples
--
-- >>> transformGram (parseGram "()")
-- Pattern with Subject {identity = Symbol "", ...}
--
-- >>> transformGramWithIds (parseGram "() ()")
-- Pattern with two subjects having identities Symbol "#1" and Symbol "#2"
module Gram.Transform
  ( transformGram
  , transformGramWithIds
  , assignIdentities
  ) where

import qualified Gram.CST as CST
import qualified Pattern.Core as P
import qualified Subject.Core as S
import qualified Subject.Value as V
import Data.Map (Map)
import qualified Data.Map as Map
import qualified Data.Set as Set
import Control.Monad.State (State, evalState, get, put)
import Data.Char (isDigit)

type Transform = State Int

-- | Transform a CST Gram into a Core Pattern Subject.
--
-- This function preserves anonymous subjects as 'Symbol ""' to enable
-- round-trip compatibility. Anonymous subjects in the gram notation
-- (e.g., @()@, @()-[]->()@) will be represented with empty identity.
--
-- If you need unique IDs assigned to anonymous subjects, use
-- 'transformGramWithIds' instead.
transformGram :: CST.Gram -> P.Pattern S.Subject
transformGram :: Gram -> Pattern Subject
transformGram Gram
gram = State Int (Pattern Subject) -> Int -> Pattern Subject
forall s a. State s a -> s -> a
evalState (Gram -> State Int (Pattern Subject)
transformGram' Gram
gram) Int
0

-- | Find the maximum numeric suffix of IDs matching "#<N>" in the CST
findMaxId :: CST.Gram -> Int
findMaxId :: Gram -> Int
findMaxId (CST.Gram Maybe (Map String Value)
_ [AnnotatedPattern]
patterns) = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (AnnotatedPattern -> [Int]) -> [AnnotatedPattern] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AnnotatedPattern -> [Int]
forall {b}. Read b => AnnotatedPattern -> [b]
scanPattern [AnnotatedPattern]
patterns)
  where
    scanPattern :: AnnotatedPattern -> [b]
scanPattern (CST.AnnotatedPattern [Annotation]
_ [PatternElement]
elements) = (PatternElement -> [b]) -> [PatternElement] -> [b]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PatternElement -> [b]
forall {a}. Read a => PatternElement -> [a]
scanElement [PatternElement]
elements

    scanElement :: PatternElement -> [a]
scanElement (CST.PEPath Path
path) = Path -> [a]
forall {a}. Read a => Path -> [a]
scanPath Path
path
    scanElement (CST.PESubjectPattern SubjectPattern
sp) = SubjectPattern -> [a]
scanSubjectPattern SubjectPattern
sp
    scanElement (CST.PEReference Identifier
ident) = Maybe Identifier -> [a]
forall {a}. Read a => Maybe Identifier -> [a]
scanIdentifier (Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just Identifier
ident)

    scanPath :: Path -> [a]
scanPath (CST.Path Node
startNode [PathSegment]
segments) = 
      Node -> [a]
forall {a}. Read a => Node -> [a]
scanNode Node
startNode [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ (PathSegment -> [a]) -> [PathSegment] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PathSegment -> [a]
forall {a}. Read a => PathSegment -> [a]
scanSegment [PathSegment]
segments

    scanSegment :: PathSegment -> [a]
scanSegment (CST.PathSegment Relationship
rel Node
nextNode) = 
      Relationship -> [a]
forall {a}. Read a => Relationship -> [a]
scanRelationship Relationship
rel [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Node -> [a]
forall {a}. Read a => Node -> [a]
scanNode Node
nextNode

    scanNode :: Node -> [a]
scanNode (CST.Node Maybe SubjectData
subjData) = Maybe SubjectData -> [a]
forall {a}. Read a => Maybe SubjectData -> [a]
scanSubjectData Maybe SubjectData
subjData

    scanRelationship :: Relationship -> [a]
scanRelationship (CST.Relationship String
_ Maybe SubjectData
subjData) = Maybe SubjectData -> [a]
forall {a}. Read a => Maybe SubjectData -> [a]
scanSubjectData Maybe SubjectData
subjData

    scanSubjectPattern :: SubjectPattern -> [a]
scanSubjectPattern (CST.SubjectPattern Maybe SubjectData
subjData [PatternElement]
nested) = 
      Maybe SubjectData -> [a]
forall {a}. Read a => Maybe SubjectData -> [a]
scanSubjectData Maybe SubjectData
subjData [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ (PatternElement -> [a]) -> [PatternElement] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PatternElement -> [a]
scanElement [PatternElement]
nested

    scanSubjectData :: Maybe SubjectData -> [a]
scanSubjectData Maybe SubjectData
Nothing = []
    scanSubjectData (Just (CST.SubjectData Maybe Identifier
ident Set String
_ Map String Value
_)) = Maybe Identifier -> [a]
forall {a}. Read a => Maybe Identifier -> [a]
scanIdentifier Maybe Identifier
ident

    scanIdentifier :: Maybe Identifier -> [a]
scanIdentifier (Just (CST.IdentSymbol (CST.Symbol String
s))) = case String -> Maybe a
forall {a}. Read a => String -> Maybe a
parseGeneratedId String
s of
      Just a
n -> [a
n]
      Maybe a
Nothing -> []
    scanIdentifier Maybe Identifier
_ = []

    parseGeneratedId :: String -> Maybe a
parseGeneratedId (Char
'#':String
rest) | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
rest Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest) = a -> Maybe a
forall a. a -> Maybe a
Just (String -> a
forall a. Read a => String -> a
read String
rest)
    parseGeneratedId String
_ = Maybe a
forall a. Maybe a
Nothing

transformGram' :: CST.Gram -> Transform (P.Pattern S.Subject)
transformGram' :: Gram -> State Int (Pattern Subject)
transformGram' (CST.Gram Maybe (Map String Value)
record [AnnotatedPattern]
patterns) =
  case (Maybe (Map String Value)
record, [AnnotatedPattern]
patterns) of
    (Just Map String Value
props, []) -> 
      -- Only record
      Pattern Subject -> State Int (Pattern Subject)
forall a. a -> StateT Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern Subject -> State Int (Pattern Subject))
-> Pattern Subject -> State Int (Pattern Subject)
forall a b. (a -> b) -> a -> b
$ Subject -> [Pattern Subject] -> Pattern Subject
forall v. v -> [Pattern v] -> Pattern v
P.Pattern (Symbol -> Set String -> Map String Value -> Subject
S.Subject (String -> Symbol
S.Symbol String
"") (String -> Set String
forall a. a -> Set a
Set.singleton String
"Gram.Root") Map String Value
props) []
    (Just Map String Value
props, [AnnotatedPattern]
pats) -> do
      pats' <- (AnnotatedPattern -> State Int (Pattern Subject))
-> [AnnotatedPattern] -> StateT Int Identity [Pattern Subject]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM AnnotatedPattern -> State Int (Pattern Subject)
transformPattern [AnnotatedPattern]
pats
      -- Explicit root record.
      return $ P.Pattern (S.Subject (S.Symbol "") (Set.singleton "Gram.Root") props) pats'
    (Maybe (Map String Value)
Nothing, [AnnotatedPattern
p]) ->
      AnnotatedPattern -> State Int (Pattern Subject)
transformPattern AnnotatedPattern
p
    (Maybe (Map String Value)
Nothing, [AnnotatedPattern]
pats) -> do
      pats' <- (AnnotatedPattern -> State Int (Pattern Subject))
-> [AnnotatedPattern] -> StateT Int Identity [Pattern Subject]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM AnnotatedPattern -> State Int (Pattern Subject)
transformPattern [AnnotatedPattern]
pats
      return $ P.Pattern (S.Subject (S.Symbol "") (Set.singleton "Gram.Root") Map.empty) pats'

transformPattern :: CST.AnnotatedPattern -> Transform (P.Pattern S.Subject)
transformPattern :: AnnotatedPattern -> State Int (Pattern Subject)
transformPattern (CST.AnnotatedPattern [Annotation]
annotations [PatternElement]
elements) = do
  -- Transform elements (AnnotatedPattern contains exactly ONE element in 0.2.7)
  transformedElements <- (PatternElement -> State Int (Pattern Subject))
-> [PatternElement] -> StateT Int Identity [Pattern Subject]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM PatternElement -> State Int (Pattern Subject)
transformElement [PatternElement]
elements
  
  case annotations of
    [] -> case [Pattern Subject]
transformedElements of
      [Pattern Subject
el] -> Pattern Subject -> State Int (Pattern Subject)
forall a. a -> StateT Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Pattern Subject
el
      (Pattern Subject
first:[Pattern Subject]
rest) -> Pattern Subject -> State Int (Pattern Subject)
forall a. a -> StateT Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern Subject -> State Int (Pattern Subject))
-> Pattern Subject -> State Int (Pattern Subject)
forall a b. (a -> b) -> a -> b
$ Subject -> [Pattern Subject] -> Pattern Subject
forall v. v -> [Pattern v] -> Pattern v
P.Pattern (Pattern Subject -> Subject
forall v. Pattern v -> v
P.value Pattern Subject
first) (Pattern Subject -> [Pattern Subject]
forall v. Pattern v -> [Pattern v]
P.elements Pattern Subject
first [Pattern Subject] -> [Pattern Subject] -> [Pattern Subject]
forall a. [a] -> [a] -> [a]
++ [Pattern Subject]
rest)
      [] -> Pattern Subject -> State Int (Pattern Subject)
forall a. a -> StateT Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern Subject -> State Int (Pattern Subject))
-> Pattern Subject -> State Int (Pattern Subject)
forall a b. (a -> b) -> a -> b
$ Subject -> [Pattern Subject] -> Pattern Subject
forall v. v -> [Pattern v] -> Pattern v
P.Pattern (Symbol -> Set String -> Map String Value -> Subject
S.Subject (String -> Symbol
S.Symbol String
"") Set String
forall a. Set a
Set.empty Map String Value
forall k a. Map k a
Map.empty) []
      
    [Annotation]
anns -> do
      -- Convert annotations to properties
      let annProps :: Map String Value
annProps = [Annotation] -> Map String Value
annotationsToProperties [Annotation]
anns
      
      -- Annotations become properties of a wrapper subject pattern.
      -- The single element from annotated_pattern becomes the content.
      
      -- Preserve anonymity for annotation wrapper subjects
      -- Note: In the semantic mapping, the annotations become properties of the "subject"
      -- that wraps the content.
      
      let wrapperSubject :: Subject
wrapperSubject = Symbol -> Set String -> Map String Value -> Subject
S.Subject (String -> Symbol
S.Symbol String
"") Set String
forall a. Set a
Set.empty Map String Value
annProps
      
      Pattern Subject -> State Int (Pattern Subject)
forall a. a -> StateT Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern Subject -> State Int (Pattern Subject))
-> Pattern Subject -> State Int (Pattern Subject)
forall a b. (a -> b) -> a -> b
$ Subject -> [Pattern Subject] -> Pattern Subject
forall v. v -> [Pattern v] -> Pattern v
P.Pattern Subject
wrapperSubject [Pattern Subject]
transformedElements

annotationsToProperties :: [CST.Annotation] -> Map String V.Value
annotationsToProperties :: [Annotation] -> Map String Value
annotationsToProperties = [(String, Value)] -> Map String Value
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(String, Value)] -> Map String Value)
-> ([Annotation] -> [(String, Value)])
-> [Annotation]
-> Map String Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Annotation -> (String, Value))
-> [Annotation] -> [(String, Value)]
forall a b. (a -> b) -> [a] -> [b]
map (\(CST.Annotation (CST.Symbol String
k) Value
v) -> (String
k, Value
v))


transformElement :: CST.PatternElement -> Transform (P.Pattern S.Subject)
transformElement :: PatternElement -> State Int (Pattern Subject)
transformElement (CST.PEPath Path
path) = Path -> State Int (Pattern Subject)
transformPath Path
path
transformElement (CST.PESubjectPattern SubjectPattern
b) = SubjectPattern -> State Int (Pattern Subject)
transformSubjectPattern SubjectPattern
b
transformElement (CST.PEReference Identifier
ident) = do
  sym <- Maybe Identifier -> Transform Symbol
transformIdentifier (Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just Identifier
ident)
  return $ P.Pattern (S.Subject sym Set.empty Map.empty) []

-- | Transform a path into a Pattern.
-- 
-- 1. Single Node: (a) -> Pattern a []
-- 2. Single Edge: (a)-[r]->(b) -> Pattern r [a, b]
-- 3. Walk: (a)-[r1]->(b)-[r2]->(c) -> Pattern walk [Pattern r1 [a, b], Pattern r2 [b, c]]
transformPath :: CST.Path -> Transform (P.Pattern S.Subject)
transformPath :: Path -> State Int (Pattern Subject)
transformPath (CST.Path Node
startNode [PathSegment]
segments) =
  case [PathSegment]
segments of
    [] -> Node -> State Int (Pattern Subject)
transformNode Node
startNode
    [PathSegment
seg] -> do
      -- Single Edge case: Return the edge pattern directly
      -- (a)-[r]->(b) becomes [r | a, b]
      left <- Node -> State Int (Pattern Subject)
transformNode Node
startNode
      right <- transformNode (CST.segmentNode seg)
      rel <- transformRelationship (CST.segmentRel seg)
      return $ P.Pattern (P.value rel) [left, right]
    [PathSegment]
_ -> do
      -- Walk case (multiple segments): Return a Walk Pattern containing edges
      -- (a)-[r1]->(b)-[r2]->(c) becomes [walk | [r1 | a, b], [r2 | b, c]]
      leftP <- Node -> State Int (Pattern Subject)
transformNode Node
startNode
      edges <- constructWalkEdges leftP segments
      -- Use a specific label for Walk container to distinguish it
      let walkSubject = Symbol -> Set String -> Map String Value -> Subject
S.Subject (String -> Symbol
S.Symbol String
"") (String -> Set String
forall a. a -> Set a
Set.singleton String
"Gram.Walk") Map String Value
forall k a. Map k a
Map.empty
      return $ P.Pattern walkSubject edges

-- | Construct a list of Edge Patterns from a start node and path segments.
-- We pass the transformed left pattern to ensure identity continuity in the walk.
constructWalkEdges :: P.Pattern S.Subject -> [CST.PathSegment] -> Transform [P.Pattern S.Subject]
constructWalkEdges :: Pattern Subject
-> [PathSegment] -> StateT Int Identity [Pattern Subject]
constructWalkEdges Pattern Subject
_ [] = [Pattern Subject] -> StateT Int Identity [Pattern Subject]
forall a. a -> StateT Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []
constructWalkEdges Pattern Subject
leftP (PathSegment
seg:[PathSegment]
rest) = do
  let rightNode :: Node
rightNode = PathSegment -> Node
CST.segmentNode PathSegment
seg
  rightP <- Node -> State Int (Pattern Subject)
transformNode Node
rightNode
  relP <- transformRelationship (CST.segmentRel seg)
  -- Create self-contained edge: [rel | left, right]
  let edge = Subject -> [Pattern Subject] -> Pattern Subject
forall v. v -> [Pattern v] -> Pattern v
P.Pattern (Pattern Subject -> Subject
forall v. Pattern v -> v
P.value Pattern Subject
relP) [Pattern Subject
leftP, Pattern Subject
rightP]
  restEdges <- constructWalkEdges rightP rest
  return (edge : restEdges)

transformNode :: CST.Node -> Transform (P.Pattern S.Subject)
transformNode :: Node -> State Int (Pattern Subject)
transformNode (CST.Node Maybe SubjectData
subjData) = do
  subj <- StateT Int Identity Subject
-> (SubjectData -> StateT Int Identity Subject)
-> Maybe SubjectData
-> StateT Int Identity Subject
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StateT Int Identity Subject
transformEmptySubject SubjectData -> StateT Int Identity Subject
transformSubjectData Maybe SubjectData
subjData
  return $ P.Pattern subj []

transformSubjectPattern :: CST.SubjectPattern -> Transform (P.Pattern S.Subject)
transformSubjectPattern :: SubjectPattern -> State Int (Pattern Subject)
transformSubjectPattern (CST.SubjectPattern Maybe SubjectData
subjData [PatternElement]
nested) = do
  subj <- StateT Int Identity Subject
-> (SubjectData -> StateT Int Identity Subject)
-> Maybe SubjectData
-> StateT Int Identity Subject
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StateT Int Identity Subject
transformEmptySubject SubjectData -> StateT Int Identity Subject
transformSubjectData Maybe SubjectData
subjData
  nestedPats <- mapM transformElement nested
  return $ P.Pattern subj nestedPats

transformRelationship :: CST.Relationship -> Transform (P.Pattern S.Subject)
transformRelationship :: Relationship -> State Int (Pattern Subject)
transformRelationship (CST.Relationship String
_ Maybe SubjectData
subjData) = do
  -- Arrow string is currently ignored in Pattern Subject (as per design)
  subj <- StateT Int Identity Subject
-> (SubjectData -> StateT Int Identity Subject)
-> Maybe SubjectData
-> StateT Int Identity Subject
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StateT Int Identity Subject
transformEmptySubject SubjectData -> StateT Int Identity Subject
transformSubjectData Maybe SubjectData
subjData
  return $ P.Pattern subj []

transformSubjectData :: CST.SubjectData -> Transform S.Subject
transformSubjectData :: SubjectData -> StateT Int Identity Subject
transformSubjectData (CST.SubjectData Maybe Identifier
ident Set String
labels Map String Value
props) = do
  sym <- Maybe Identifier -> Transform Symbol
transformIdentifier Maybe Identifier
ident
  return $ S.Subject
    sym
    labels
    props

transformIdentifier :: Maybe CST.Identifier -> Transform S.Symbol
transformIdentifier :: Maybe Identifier -> Transform Symbol
transformIdentifier Maybe Identifier
Nothing = Symbol -> Transform Symbol
forall a. a -> StateT Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Symbol
S.Symbol String
"")  -- Preserve anonymity
transformIdentifier (Just (CST.IdentSymbol (CST.Symbol String
s))) = Symbol -> Transform Symbol
forall a. a -> StateT Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Symbol -> Transform Symbol) -> Symbol -> Transform Symbol
forall a b. (a -> b) -> a -> b
$ String -> Symbol
S.Symbol String
s
transformIdentifier (Just (CST.IdentString String
s)) = Symbol -> Transform Symbol
forall a. a -> StateT Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Symbol -> Transform Symbol) -> Symbol -> Transform Symbol
forall a b. (a -> b) -> a -> b
$ String -> Symbol
S.Symbol String
s
transformIdentifier (Just (CST.IdentInteger Integer
i)) = Symbol -> Transform Symbol
forall a. a -> StateT Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Symbol -> Transform Symbol) -> Symbol -> Transform Symbol
forall a b. (a -> b) -> a -> b
$ String -> Symbol
S.Symbol (Integer -> String
forall a. Show a => a -> String
show Integer
i)

transformEmptySubject :: Transform S.Subject
transformEmptySubject :: StateT Int Identity Subject
transformEmptySubject = Subject -> StateT Int Identity Subject
forall a. a -> StateT Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Subject -> StateT Int Identity Subject)
-> Subject -> StateT Int Identity Subject
forall a b. (a -> b) -> a -> b
$ Symbol -> Set String -> Map String Value -> Subject
S.Subject (String -> Symbol
S.Symbol String
"") Set String
forall a. Set a
Set.empty Map String Value
forall k a. Map k a
Map.empty

generateId :: Transform S.Symbol
generateId :: Transform Symbol
generateId = do
  i <- StateT Int Identity Int
forall s (m :: * -> *). MonadState s m => m s
get
  put (i + 1)
  return $ S.Symbol ("#" ++ show i)

-- | Find the maximum numeric suffix of IDs matching "#<N>" in a Pattern.
--
-- Used by 'assignIdentities' to determine the starting counter value
-- to avoid collisions with existing generated IDs.
findMaxIdInPattern :: P.Pattern S.Subject -> Int
findMaxIdInPattern :: Pattern Subject -> Int
findMaxIdInPattern (P.Pattern Subject
subj [Pattern Subject]
elems) =
  [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Subject -> Int
forall {a}. (Read a, Num a) => Subject -> a
scanSubject Subject
subj Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (Pattern Subject -> Int) -> [Pattern Subject] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Pattern Subject -> Int
findMaxIdInPattern [Pattern Subject]
elems)
  where
    scanSubject :: Subject -> a
scanSubject (S.Subject (S.Symbol String
s) Set String
_ Map String Value
_) = case String -> Maybe a
forall {a}. Read a => String -> Maybe a
parseGeneratedId String
s of
      Just a
n -> a
n
      Maybe a
Nothing -> a
0
    parseGeneratedId :: String -> Maybe a
parseGeneratedId (Char
'#':String
rest) | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
rest Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest) = a -> Maybe a
forall a. a -> Maybe a
Just (String -> a
forall a. Read a => String -> a
read String
rest)
    parseGeneratedId String
_ = Maybe a
forall a. Maybe a
Nothing

-- | Assign unique sequential IDs to anonymous subjects in a Pattern.
--
-- This function recursively traverses a pattern and assigns IDs of the form
-- @#N@ to all subjects with empty identity ('Symbol ""'). The counter starts
-- from the maximum existing @#N@-style ID found in the pattern plus one,
-- ensuring no collisions.
--
-- Named subjects (non-empty identity) are left unchanged.
assignIdentities :: P.Pattern S.Subject -> P.Pattern S.Subject
assignIdentities :: Pattern Subject -> Pattern Subject
assignIdentities Pattern Subject
pattern = State Int (Pattern Subject) -> Int -> Pattern Subject
forall s a. State s a -> s -> a
evalState (Pattern Subject -> State Int (Pattern Subject)
assignIdentities' Pattern Subject
pattern) (Pattern Subject -> Int
findMaxIdInPattern Pattern Subject
pattern Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

assignIdentities' :: P.Pattern S.Subject -> Transform (P.Pattern S.Subject)
assignIdentities' :: Pattern Subject -> State Int (Pattern Subject)
assignIdentities' (P.Pattern Subject
subj [Pattern Subject]
elems) = do
  newSubj <- case Subject
subj of
    S.Subject (S.Symbol String
"") Set String
lbls Map String Value
props -> do
      i <- StateT Int Identity Int
forall s (m :: * -> *). MonadState s m => m s
get
      put (i + 1)
      return $ S.Subject (S.Symbol ("#" ++ show i)) lbls props
    Subject
_ -> Subject -> StateT Int Identity Subject
forall a. a -> StateT Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Subject
subj
  newElems <- mapM assignIdentities' elems
  return $ P.Pattern newSubj newElems

-- | Transform a CST Gram into a Core Pattern Subject with ID assignment.
--
-- This function is equivalent to applying 'assignIdentities' to the result
-- of 'transformGram'. It assigns unique sequential IDs (e.g., @#1@, @#2@)
-- to all anonymous subjects in the parsed pattern.
--
-- Use this function when you need unique identifiers for anonymous subjects,
-- such as for graph algorithms or when distinguishing between anonymous
-- instances is important.
--
-- For round-trip compatibility, use 'transformGram' instead, which preserves
-- anonymity.
transformGramWithIds :: CST.Gram -> P.Pattern S.Subject
transformGramWithIds :: Gram -> Pattern Subject
transformGramWithIds = Pattern Subject -> Pattern Subject
assignIdentities (Pattern Subject -> Pattern Subject)
-> (Gram -> Pattern Subject) -> Gram -> Pattern Subject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gram -> Pattern Subject
transformGram