{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

module Gram.Validate 
  ( SymbolTable
  , SymbolInfo(..)
  , SymbolType(..)
  , DefinitionStatus(..)
  , PatternSignature(..)
  , ValidationEnv(..)
  , ValidationError(..)
  , validate
  ) where

import Data.Map (Map)
import qualified Data.Map as Map
import Data.Set (Set)
import qualified Data.Set as Set
import Control.Monad.State
import Control.Monad (when)

import Gram.CST (GramDoc(..), AnnotatedPattern(..), PatternElement(..), Path(..), PathSegment(..), Node(..), Relationship(..), SubjectPattern(..), SubjectData(..), Identifier(..))

-- | The internal state used during validation.
type SymbolTable = Map Identifier SymbolInfo

data SymbolInfo = SymbolInfo
  { SymbolInfo -> SymbolType
symType :: SymbolType
  , SymbolInfo -> DefinitionStatus
symStatus :: DefinitionStatus
  , SymbolInfo -> Maybe PatternSignature
symSignature :: Maybe PatternSignature
  } deriving (Int -> SymbolInfo -> ShowS
[SymbolInfo] -> ShowS
SymbolInfo -> [Char]
(Int -> SymbolInfo -> ShowS)
-> (SymbolInfo -> [Char])
-> ([SymbolInfo] -> ShowS)
-> Show SymbolInfo
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SymbolInfo -> ShowS
showsPrec :: Int -> SymbolInfo -> ShowS
$cshow :: SymbolInfo -> [Char]
show :: SymbolInfo -> [Char]
$cshowList :: [SymbolInfo] -> ShowS
showList :: [SymbolInfo] -> ShowS
Show, SymbolInfo -> SymbolInfo -> Bool
(SymbolInfo -> SymbolInfo -> Bool)
-> (SymbolInfo -> SymbolInfo -> Bool) -> Eq SymbolInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SymbolInfo -> SymbolInfo -> Bool
== :: SymbolInfo -> SymbolInfo -> Bool
$c/= :: SymbolInfo -> SymbolInfo -> Bool
/= :: SymbolInfo -> SymbolInfo -> Bool
Eq)

data SymbolType
  = TypeNode
  | TypeRelationship
  | TypePattern
  | TypeUnknown
  deriving (Int -> SymbolType -> ShowS
[SymbolType] -> ShowS
SymbolType -> [Char]
(Int -> SymbolType -> ShowS)
-> (SymbolType -> [Char])
-> ([SymbolType] -> ShowS)
-> Show SymbolType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SymbolType -> ShowS
showsPrec :: Int -> SymbolType -> ShowS
$cshow :: SymbolType -> [Char]
show :: SymbolType -> [Char]
$cshowList :: [SymbolType] -> ShowS
showList :: [SymbolType] -> ShowS
Show, SymbolType -> SymbolType -> Bool
(SymbolType -> SymbolType -> Bool)
-> (SymbolType -> SymbolType -> Bool) -> Eq SymbolType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SymbolType -> SymbolType -> Bool
== :: SymbolType -> SymbolType -> Bool
$c/= :: SymbolType -> SymbolType -> Bool
/= :: SymbolType -> SymbolType -> Bool
Eq)

data DefinitionStatus
  = StatusDefined
  | StatusReferenced
  | StatusImplicit
  deriving (Int -> DefinitionStatus -> ShowS
[DefinitionStatus] -> ShowS
DefinitionStatus -> [Char]
(Int -> DefinitionStatus -> ShowS)
-> (DefinitionStatus -> [Char])
-> ([DefinitionStatus] -> ShowS)
-> Show DefinitionStatus
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DefinitionStatus -> ShowS
showsPrec :: Int -> DefinitionStatus -> ShowS
$cshow :: DefinitionStatus -> [Char]
show :: DefinitionStatus -> [Char]
$cshowList :: [DefinitionStatus] -> ShowS
showList :: [DefinitionStatus] -> ShowS
Show, DefinitionStatus -> DefinitionStatus -> Bool
(DefinitionStatus -> DefinitionStatus -> Bool)
-> (DefinitionStatus -> DefinitionStatus -> Bool)
-> Eq DefinitionStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DefinitionStatus -> DefinitionStatus -> Bool
== :: DefinitionStatus -> DefinitionStatus -> Bool
$c/= :: DefinitionStatus -> DefinitionStatus -> Bool
/= :: DefinitionStatus -> DefinitionStatus -> Bool
Eq)

data PatternSignature = PatternSignature
  { PatternSignature -> Set [Char]
sigLabels :: Set String
  , PatternSignature -> Int
sigArity :: Int
  , PatternSignature -> Maybe (Maybe Identifier, Maybe Identifier)
sigEndpoints :: Maybe (Maybe Identifier, Maybe Identifier) -- (source, target) for relationships
  } deriving (Int -> PatternSignature -> ShowS
[PatternSignature] -> ShowS
PatternSignature -> [Char]
(Int -> PatternSignature -> ShowS)
-> (PatternSignature -> [Char])
-> ([PatternSignature] -> ShowS)
-> Show PatternSignature
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PatternSignature -> ShowS
showsPrec :: Int -> PatternSignature -> ShowS
$cshow :: PatternSignature -> [Char]
show :: PatternSignature -> [Char]
$cshowList :: [PatternSignature] -> ShowS
showList :: [PatternSignature] -> ShowS
Show, PatternSignature -> PatternSignature -> Bool
(PatternSignature -> PatternSignature -> Bool)
-> (PatternSignature -> PatternSignature -> Bool)
-> Eq PatternSignature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PatternSignature -> PatternSignature -> Bool
== :: PatternSignature -> PatternSignature -> Bool
$c/= :: PatternSignature -> PatternSignature -> Bool
/= :: PatternSignature -> PatternSignature -> Bool
Eq)

data ValidationEnv = ValidationEnv
  { ValidationEnv -> [Identifier]
envCurrentPath :: [Identifier] -- For cycle detection
  } deriving (Int -> ValidationEnv -> ShowS
[ValidationEnv] -> ShowS
ValidationEnv -> [Char]
(Int -> ValidationEnv -> ShowS)
-> (ValidationEnv -> [Char])
-> ([ValidationEnv] -> ShowS)
-> Show ValidationEnv
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ValidationEnv -> ShowS
showsPrec :: Int -> ValidationEnv -> ShowS
$cshow :: ValidationEnv -> [Char]
show :: ValidationEnv -> [Char]
$cshowList :: [ValidationEnv] -> ShowS
showList :: [ValidationEnv] -> ShowS
Show, ValidationEnv -> ValidationEnv -> Bool
(ValidationEnv -> ValidationEnv -> Bool)
-> (ValidationEnv -> ValidationEnv -> Bool) -> Eq ValidationEnv
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ValidationEnv -> ValidationEnv -> Bool
== :: ValidationEnv -> ValidationEnv -> Bool
$c/= :: ValidationEnv -> ValidationEnv -> Bool
/= :: ValidationEnv -> ValidationEnv -> Bool
Eq)

data ValidationError
  = DuplicateDefinition Identifier
  | UndefinedReference Identifier
  | SelfReference Identifier
  | InconsistentDefinition Identifier String
  | ImmutabilityViolation Identifier
  deriving (Int -> ValidationError -> ShowS
[ValidationError] -> ShowS
ValidationError -> [Char]
(Int -> ValidationError -> ShowS)
-> (ValidationError -> [Char])
-> ([ValidationError] -> ShowS)
-> Show ValidationError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ValidationError -> ShowS
showsPrec :: Int -> ValidationError -> ShowS
$cshow :: ValidationError -> [Char]
show :: ValidationError -> [Char]
$cshowList :: [ValidationError] -> ShowS
showList :: [ValidationError] -> ShowS
Show, ValidationError -> ValidationError -> Bool
(ValidationError -> ValidationError -> Bool)
-> (ValidationError -> ValidationError -> Bool)
-> Eq ValidationError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ValidationError -> ValidationError -> Bool
== :: ValidationError -> ValidationError -> Bool
$c/= :: ValidationError -> ValidationError -> Bool
/= :: ValidationError -> ValidationError -> Bool
Eq)

type ValidationState = (SymbolTable, [ValidationError])
type ValidateM a = State ValidationEnv a

-- | Initial state
emptySymbolTable :: SymbolTable
emptySymbolTable :: SymbolTable
emptySymbolTable = SymbolTable
forall k a. Map k a
Map.empty

emptyEnv :: ValidationEnv
emptyEnv :: ValidationEnv
emptyEnv = [Identifier] -> ValidationEnv
ValidationEnv []

-- | Validate a parsed Gram AST.
validate :: GramDoc -> Either [ValidationError] ()
validate :: GramDoc -> Either [ValidationError] ()
validate (GramDoc Maybe (Map [Char] Value)
_ [AnnotatedPattern]
patterns) = 
  let (SymbolTable
_, [ValidationError]
errs) = State ValidationState () -> ValidationState -> ValidationState
forall s a. State s a -> s -> s
execState ([AnnotatedPattern] -> State ValidationState ()
validatePatterns [AnnotatedPattern]
patterns) (SymbolTable
emptySymbolTable, [])
  in if [ValidationError] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ValidationError]
errs then () -> Either [ValidationError] ()
forall a b. b -> Either a b
Right () else [ValidationError] -> Either [ValidationError] ()
forall a b. a -> Either a b
Left ([ValidationError] -> [ValidationError]
forall a. [a] -> [a]
reverse [ValidationError]
errs)

-- | Main validation loop state
-- State: (SymbolTable, [ValidationError])
validatePatterns :: [AnnotatedPattern] -> State ValidationState ()
validatePatterns :: [AnnotatedPattern] -> State ValidationState ()
validatePatterns [AnnotatedPattern]
pats = do
  -- Pass 1: Register all definitions
  (AnnotatedPattern -> State ValidationState ())
-> [AnnotatedPattern] -> State ValidationState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ AnnotatedPattern -> State ValidationState ()
registerDefinition [AnnotatedPattern]
pats
  -- Pass 2: Check references and consistency
  (AnnotatedPattern -> State ValidationState ())
-> [AnnotatedPattern] -> State ValidationState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ AnnotatedPattern -> State ValidationState ()
checkReferences [AnnotatedPattern]
pats

-- | Register definitions
registerDefinition :: AnnotatedPattern -> State ValidationState ()
registerDefinition :: AnnotatedPattern -> State ValidationState ()
registerDefinition (AnnotatedPattern [Annotation]
_ [PatternElement]
elements) = 
  (PatternElement -> State ValidationState ())
-> [PatternElement] -> State ValidationState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ PatternElement -> State ValidationState ()
registerElement [PatternElement]
elements

registerElement :: PatternElement -> State ValidationState ()
registerElement :: PatternElement -> State ValidationState ()
registerElement (PESubjectPattern SubjectPattern
sp) = SubjectPattern -> State ValidationState ()
registerSubjectPattern SubjectPattern
sp
registerElement (PEPath Path
path) = Path -> State ValidationState ()
registerPath Path
path
registerElement (PEReference Identifier
_) = () -> State ValidationState ()
forall a. a -> StateT ValidationState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return () -- References don't define

registerSubjectPattern :: SubjectPattern -> State ValidationState ()
registerSubjectPattern :: SubjectPattern -> State ValidationState ()
registerSubjectPattern (SubjectPattern Maybe SubjectData
maybeSubj [PatternElement]
elements) = do
  -- Register the subject itself if identified
  let arity :: Int
arity = [PatternElement] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PatternElement]
elements
  case Maybe SubjectData
maybeSubj of
    Just (SubjectData (Just Identifier
ident) Set [Char]
labels Map [Char] Value
_) -> do
      (syms, errs) <- StateT ValidationState Identity ValidationState
forall s (m :: * -> *). MonadState s m => m s
get
      case Map.lookup ident syms of
        Just SymbolInfo
info | SymbolInfo -> DefinitionStatus
symStatus SymbolInfo
info DefinitionStatus -> DefinitionStatus -> Bool
forall a. Eq a => a -> a -> Bool
== DefinitionStatus
StatusDefined -> 
          ValidationState -> State ValidationState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (SymbolTable
syms, Identifier -> ValidationError
DuplicateDefinition Identifier
ident ValidationError -> [ValidationError] -> [ValidationError]
forall a. a -> [a] -> [a]
: [ValidationError]
errs)
        Maybe SymbolInfo
_ -> do
          -- We define it here with its signature (no endpoints for pattern notation)
          let sig :: PatternSignature
sig = Set [Char]
-> Int
-> Maybe (Maybe Identifier, Maybe Identifier)
-> PatternSignature
PatternSignature Set [Char]
labels Int
arity Maybe (Maybe Identifier, Maybe Identifier)
forall a. Maybe a
Nothing
          let info :: SymbolInfo
info = SymbolType
-> DefinitionStatus -> Maybe PatternSignature -> SymbolInfo
SymbolInfo SymbolType
TypePattern DefinitionStatus
StatusDefined (PatternSignature -> Maybe PatternSignature
forall a. a -> Maybe a
Just PatternSignature
sig)
          ValidationState -> State ValidationState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Identifier -> SymbolInfo -> SymbolTable -> SymbolTable
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Identifier
ident SymbolInfo
info SymbolTable
syms, [ValidationError]
errs)
    Maybe SubjectData
_ -> () -> State ValidationState ()
forall a. a -> StateT ValidationState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  
  -- Recurse into elements
  (PatternElement -> State ValidationState ())
-> [PatternElement] -> State ValidationState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ PatternElement -> State ValidationState ()
registerElement [PatternElement]
elements

registerPath :: Path -> State ValidationState ()
registerPath :: Path -> State ValidationState ()
registerPath (Path Node
start [PathSegment]
segments) = do
  Node -> State ValidationState ()
registerNode Node
start
  let sourceId :: Maybe Identifier
sourceId = Node -> Maybe Identifier
getNodeIdentifier Node
start
  Maybe Identifier -> [PathSegment] -> State ValidationState ()
registerPathSegments Maybe Identifier
sourceId [PathSegment]
segments

-- | Extract the identifier from a node, if present.
-- Returns Nothing for anonymous nodes.
getNodeIdentifier :: Node -> Maybe Identifier
getNodeIdentifier :: Node -> Maybe Identifier
getNodeIdentifier (Node (Just (SubjectData (Just Identifier
ident) Set [Char]
_ Map [Char] Value
_))) = Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just Identifier
ident
getNodeIdentifier Node
_ = Maybe Identifier
forall a. Maybe a
Nothing

-- | Register path segments while tracking node identifiers for relationship endpoint validation.
-- The sourceId parameter is the identifier of the preceding node.
-- For each segment, we extract the target node identifier and pass both to registerRelationship,
-- allowing us to detect when a relationship identifier is reused with different endpoints.
registerPathSegments :: Maybe Identifier -> [PathSegment] -> State ValidationState ()
registerPathSegments :: Maybe Identifier -> [PathSegment] -> State ValidationState ()
registerPathSegments Maybe Identifier
_ [] = () -> State ValidationState ()
forall a. a -> StateT ValidationState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
registerPathSegments Maybe Identifier
sourceId (PathSegment Relationship
rel Node
nextNode : [PathSegment]
rest) = do
  let targetId :: Maybe Identifier
targetId = Node -> Maybe Identifier
getNodeIdentifier Node
nextNode
  Relationship
-> Maybe Identifier -> Maybe Identifier -> State ValidationState ()
registerRelationship Relationship
rel Maybe Identifier
sourceId Maybe Identifier
targetId
  Node -> State ValidationState ()
registerNode Node
nextNode
  Maybe Identifier -> [PathSegment] -> State ValidationState ()
registerPathSegments Maybe Identifier
targetId [PathSegment]
rest

registerNode :: Node -> State ValidationState ()
registerNode :: Node -> State ValidationState ()
registerNode (Node (Just (SubjectData (Just Identifier
ident) Set [Char]
_ Map [Char] Value
_))) = do
  (syms, errs) <- StateT ValidationState Identity ValidationState
forall s (m :: * -> *). MonadState s m => m s
get
  case Map.lookup ident syms of
    Just SymbolInfo
info | SymbolInfo -> DefinitionStatus
symStatus SymbolInfo
info DefinitionStatus -> DefinitionStatus -> Bool
forall a. Eq a => a -> a -> Bool
== DefinitionStatus
StatusDefined -> () -> State ValidationState ()
forall a. a -> StateT ValidationState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return () 
    Maybe SymbolInfo
_ -> do
      let info :: SymbolInfo
info = SymbolType
-> DefinitionStatus -> Maybe PatternSignature -> SymbolInfo
SymbolInfo SymbolType
TypeNode DefinitionStatus
StatusDefined Maybe PatternSignature
forall a. Maybe a
Nothing
      ValidationState -> State ValidationState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Identifier -> SymbolInfo -> SymbolTable -> SymbolTable
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Identifier
ident SymbolInfo
info SymbolTable
syms, [ValidationError]
errs)
registerNode Node
_ = () -> State ValidationState ()
forall a. a -> StateT ValidationState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return () 

registerRelationship :: Relationship -> Maybe Identifier -> Maybe Identifier -> State ValidationState ()
registerRelationship :: Relationship
-> Maybe Identifier -> Maybe Identifier -> State ValidationState ()
registerRelationship (Relationship [Char]
_ (Just (SubjectData (Just Identifier
ident) Set [Char]
_ Map [Char] Value
_))) Maybe Identifier
sourceId Maybe Identifier
targetId = do
  (syms, errs) <- StateT ValidationState Identity ValidationState
forall s (m :: * -> *). MonadState s m => m s
get
  let endpoints = (Maybe Identifier
sourceId, Maybe Identifier
targetId)
  case Map.lookup ident syms of
    Just SymbolInfo
info | SymbolInfo -> DefinitionStatus
symStatus SymbolInfo
info DefinitionStatus -> DefinitionStatus -> Bool
forall a. Eq a => a -> a -> Bool
== DefinitionStatus
StatusDefined -> 
      case SymbolInfo -> SymbolType
symType SymbolInfo
info of
        SymbolType
TypeRelationship -> 
          -- Check if the endpoints match the original definition
          case SymbolInfo -> Maybe PatternSignature
symSignature SymbolInfo
info of
            Just (PatternSignature Set [Char]
_ Int
_ (Just (Maybe Identifier, Maybe Identifier)
existingEndpoints)) ->
              if (Maybe Identifier, Maybe Identifier)
existingEndpoints (Maybe Identifier, Maybe Identifier)
-> (Maybe Identifier, Maybe Identifier) -> Bool
forall a. Eq a => a -> a -> Bool
== (Maybe Identifier, Maybe Identifier)
endpoints
                then () -> State ValidationState ()
forall a. a -> StateT ValidationState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return () -- Same endpoints, this is a valid reference
                else ValidationState -> State ValidationState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (SymbolTable
syms, Identifier -> ValidationError
DuplicateDefinition Identifier
ident ValidationError -> [ValidationError] -> [ValidationError]
forall a. a -> [a] -> [a]
: [ValidationError]
errs) -- Different endpoints, redefinition
            Maybe PatternSignature
_ -> () -> State ValidationState ()
forall a. a -> StateT ValidationState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return () -- No endpoints stored, allow
        SymbolType
TypePattern -> 
          -- Defined via pattern notation, allow if arity is consistent with path usage
          case SymbolInfo -> Maybe PatternSignature
symSignature SymbolInfo
info of
            Just (PatternSignature Set [Char]
_ Int
existingArity Maybe (Maybe Identifier, Maybe Identifier)
_)
              | Int
existingArity Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 -> () -> State ValidationState ()
forall a. a -> StateT ValidationState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return () -- Arity matches, path usage is consistent
              | Bool
otherwise -> ValidationState -> State ValidationState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (SymbolTable
syms, Identifier -> [Char] -> ValidationError
InconsistentDefinition Identifier
ident ([Char]
"Expected arity 2 but got " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
existingArity) ValidationError -> [ValidationError] -> [ValidationError]
forall a. a -> [a] -> [a]
: [ValidationError]
errs)
            Maybe PatternSignature
Nothing -> () -> State ValidationState ()
forall a. a -> StateT ValidationState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return () -- No signature to check, allow usage
        SymbolType
_ -> 
          -- Other types (TypeNode, TypeUnknown) - allow if arity matches
          case SymbolInfo -> Maybe PatternSignature
symSignature SymbolInfo
info of
            Just (PatternSignature Set [Char]
_ Int
existingArity Maybe (Maybe Identifier, Maybe Identifier)
_)
              | Int
existingArity Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 -> () -> State ValidationState ()
forall a. a -> StateT ValidationState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
              | Bool
otherwise -> ValidationState -> State ValidationState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (SymbolTable
syms, Identifier -> [Char] -> ValidationError
InconsistentDefinition Identifier
ident ([Char]
"Expected arity 2 but got " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
existingArity) ValidationError -> [ValidationError] -> [ValidationError]
forall a. a -> [a] -> [a]
: [ValidationError]
errs)
            Maybe PatternSignature
Nothing -> () -> State ValidationState ()
forall a. a -> StateT ValidationState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Maybe SymbolInfo
_ -> do
      -- A relationship in a path (a)-[r]->(b) is implicitly arity 2 (source, target)
      let sig :: PatternSignature
sig = Set [Char]
-> Int
-> Maybe (Maybe Identifier, Maybe Identifier)
-> PatternSignature
PatternSignature Set [Char]
forall a. Set a
Set.empty Int
2 ((Maybe Identifier, Maybe Identifier)
-> Maybe (Maybe Identifier, Maybe Identifier)
forall a. a -> Maybe a
Just (Maybe Identifier, Maybe Identifier)
endpoints)
      let info :: SymbolInfo
info = SymbolType
-> DefinitionStatus -> Maybe PatternSignature -> SymbolInfo
SymbolInfo SymbolType
TypeRelationship DefinitionStatus
StatusDefined (PatternSignature -> Maybe PatternSignature
forall a. a -> Maybe a
Just PatternSignature
sig)
      ValidationState -> State ValidationState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Identifier -> SymbolInfo -> SymbolTable -> SymbolTable
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Identifier
ident SymbolInfo
info SymbolTable
syms, [ValidationError]
errs)
registerRelationship Relationship
_ Maybe Identifier
_ Maybe Identifier
_ = () -> State ValidationState ()
forall a. a -> StateT ValidationState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Check references and consistency
checkReferences :: AnnotatedPattern -> State ValidationState ()
checkReferences :: AnnotatedPattern -> State ValidationState ()
checkReferences (AnnotatedPattern [Annotation]
_ [PatternElement]
elements) = 
  (PatternElement -> State ValidationState ())
-> [PatternElement] -> State ValidationState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ PatternElement -> State ValidationState ()
checkElement [PatternElement]
elements

checkElement :: PatternElement -> State ValidationState ()
checkElement :: PatternElement -> State ValidationState ()
checkElement (PESubjectPattern SubjectPattern
sp) = SubjectPattern -> State ValidationState ()
checkSubjectPattern SubjectPattern
sp
checkElement (PEPath Path
path) = Path -> State ValidationState ()
checkPath Path
path
checkElement (PEReference Identifier
ident) = Identifier -> Maybe Int -> State ValidationState ()
checkIdentifierRef Identifier
ident Maybe Int
forall a. Maybe a
Nothing

checkSubjectPattern :: SubjectPattern -> State ValidationState ()
checkSubjectPattern :: SubjectPattern -> State ValidationState ()
checkSubjectPattern (SubjectPattern Maybe SubjectData
maybeSubj [PatternElement]
elements) = do
  case Maybe SubjectData
maybeSubj of
    Just (SubjectData (Just Identifier
ident) Set [Char]
_ Map [Char] Value
_) -> do
      let directRefs :: [Identifier]
directRefs = [Identifier
id | PEReference Identifier
id <- [PatternElement]
elements]
      Bool -> State ValidationState () -> State ValidationState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Identifier
ident Identifier -> [Identifier] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Identifier]
directRefs) (State ValidationState () -> State ValidationState ())
-> State ValidationState () -> State ValidationState ()
forall a b. (a -> b) -> a -> b
$ do
        (syms, errs) <- StateT ValidationState Identity ValidationState
forall s (m :: * -> *). MonadState s m => m s
get
        put (syms, SelfReference ident : errs)
    Maybe SubjectData
_ -> () -> State ValidationState ()
forall a. a -> StateT ValidationState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  (PatternElement -> State ValidationState ())
-> [PatternElement] -> State ValidationState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ PatternElement -> State ValidationState ()
checkElement [PatternElement]
elements

checkPath :: Path -> State ValidationState ()
checkPath :: Path -> State ValidationState ()
checkPath (Path Node
start [PathSegment]
segments) = do
  Node -> State ValidationState ()
checkNode Node
start
  (PathSegment -> State ValidationState ())
-> [PathSegment] -> State ValidationState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ PathSegment -> State ValidationState ()
checkSegment [PathSegment]
segments

checkSegment :: PathSegment -> State ValidationState ()
checkSegment :: PathSegment -> State ValidationState ()
checkSegment (PathSegment Relationship
rel Node
nextNode) = do
  Relationship -> State ValidationState ()
checkRelationship Relationship
rel
  Node -> State ValidationState ()
checkNode Node
nextNode

checkNode :: Node -> State ValidationState ()
checkNode :: Node -> State ValidationState ()
checkNode (Node (Just (SubjectData (Just Identifier
ident) Set [Char]
_ Map [Char] Value
_))) = Identifier -> Maybe Int -> State ValidationState ()
checkIdentifierRef Identifier
ident Maybe Int
forall a. Maybe a
Nothing
checkNode Node
_ = () -> State ValidationState ()
forall a. a -> StateT ValidationState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

checkRelationship :: Relationship -> State ValidationState ()
checkRelationship :: Relationship -> State ValidationState ()
checkRelationship (Relationship [Char]
_ (Just (SubjectData (Just Identifier
ident) Set [Char]
_ Map [Char] Value
_))) = 
  -- Relationships in paths imply arity 2.
  Identifier -> Maybe Int -> State ValidationState ()
checkIdentifierRef Identifier
ident (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2)
checkRelationship Relationship
_ = () -> State ValidationState ()
forall a. a -> StateT ValidationState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

checkIdentifierRef :: Identifier -> Maybe Int -> State ValidationState ()
checkIdentifierRef :: Identifier -> Maybe Int -> State ValidationState ()
checkIdentifierRef Identifier
ident Maybe Int
expectedArity = do
  (syms, errs) <- StateT ValidationState Identity ValidationState
forall s (m :: * -> *). MonadState s m => m s
get
  case Map.lookup ident syms of
    Just SymbolInfo
info -> do
      -- Check consistency if we have an expected arity
      case (Maybe Int
expectedArity, SymbolInfo -> Maybe PatternSignature
symSignature SymbolInfo
info) of
        (Just Int
expected, Just (PatternSignature Set [Char]
_ Int
actual Maybe (Maybe Identifier, Maybe Identifier)
_)) 
          | Int
expected Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
actual -> 
            ValidationState -> State ValidationState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (SymbolTable
syms, Identifier -> [Char] -> ValidationError
InconsistentDefinition Identifier
ident ([Char]
"Expected arity " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
expected [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" but got " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
actual) ValidationError -> [ValidationError] -> [ValidationError]
forall a. a -> [a] -> [a]
: [ValidationError]
errs)
        (Maybe Int, Maybe PatternSignature)
_ -> () -> State ValidationState ()
forall a. a -> StateT ValidationState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Maybe SymbolInfo
Nothing -> ValidationState -> State ValidationState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (SymbolTable
syms, Identifier -> ValidationError
UndefinedReference Identifier
ident ValidationError -> [ValidationError] -> [ValidationError]
forall a. a -> [a] -> [a]
: [ValidationError]
errs)