-- | A SHACL syntax model. See https://www.w3.org/TR/shacl

module Hydra.Ext.Shacl.Model where

import qualified Hydra.Core as Core
import qualified Hydra.Ext.Rdf.Syntax as Syntax
import Data.List
import Data.Map
import Data.Set

-- | See https://www.w3.org/TR/shacl/#ClosedPatterConstraintComponent
data Closed = 
  Closed {
    Closed -> Bool
closedIsClosed :: Bool,
    Closed -> Maybe (Set Property)
closedIgnoredProperties :: (Maybe (Set Syntax.Property))}
  deriving (Closed -> Closed -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Closed -> Closed -> Bool
$c/= :: Closed -> Closed -> Bool
== :: Closed -> Closed -> Bool
$c== :: Closed -> Closed -> Bool
Eq, Eq Closed
Closed -> Closed -> Bool
Closed -> Closed -> Ordering
Closed -> Closed -> Closed
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Closed -> Closed -> Closed
$cmin :: Closed -> Closed -> Closed
max :: Closed -> Closed -> Closed
$cmax :: Closed -> Closed -> Closed
>= :: Closed -> Closed -> Bool
$c>= :: Closed -> Closed -> Bool
> :: Closed -> Closed -> Bool
$c> :: Closed -> Closed -> Bool
<= :: Closed -> Closed -> Bool
$c<= :: Closed -> Closed -> Bool
< :: Closed -> Closed -> Bool
$c< :: Closed -> Closed -> Bool
compare :: Closed -> Closed -> Ordering
$ccompare :: Closed -> Closed -> Ordering
Ord, ReadPrec [Closed]
ReadPrec Closed
Int -> ReadS Closed
ReadS [Closed]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Closed]
$creadListPrec :: ReadPrec [Closed]
readPrec :: ReadPrec Closed
$creadPrec :: ReadPrec Closed
readList :: ReadS [Closed]
$creadList :: ReadS [Closed]
readsPrec :: Int -> ReadS Closed
$creadsPrec :: Int -> ReadS Closed
Read, Int -> Closed -> ShowS
[Closed] -> ShowS
Closed -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Closed] -> ShowS
$cshowList :: [Closed] -> ShowS
show :: Closed -> String
$cshow :: Closed -> String
showsPrec :: Int -> Closed -> ShowS
$cshowsPrec :: Int -> Closed -> ShowS
Show)

_Closed :: Name
_Closed = (String -> Name
Core.Name String
"hydra/ext/shacl/model.Closed")

_Closed_isClosed :: FieldName
_Closed_isClosed = (String -> FieldName
Core.FieldName String
"isClosed")

_Closed_ignoredProperties :: FieldName
_Closed_ignoredProperties = (String -> FieldName
Core.FieldName String
"ignoredProperties")

-- | Any of a number of constraint parameters which can be applied either to node or property shapes
data CommonConstraint = 
  -- | See https://www.w3.org/TR/shacl/#AndConstraintComponent
  CommonConstraintAnd (Set (Reference Shape)) |
  -- | See https://www.w3.org/TR/shacl/#ClosedConstraintComponent
  CommonConstraintClosed Closed |
  -- | See https://www.w3.org/TR/shacl/#ClassConstraintComponent
  CommonConstraintClass (Set Syntax.RdfsClass) |
  -- | See https://www.w3.org/TR/shacl/#DatatypeConstraintComponent
  CommonConstraintDatatype Syntax.Iri |
  -- | See https://www.w3.org/TR/shacl/#DisjointConstraintComponent
  CommonConstraintDisjoint (Set Syntax.Property) |
  -- | See https://www.w3.org/TR/shacl/#EqualsConstraintComponent
  CommonConstraintEquals (Set Syntax.Property) |
  -- | Specifies the condition that at least one value node is equal to the given RDF term. See https://www.w3.org/TR/shacl/#HasValueConstraintComponent
  CommonConstraintHasValue (Set Syntax.Node) |
  -- | Specifies the condition that each value node is a member of a provided SHACL list. See https://www.w3.org/TR/shacl/#InConstraintComponent
  CommonConstraintIn [Syntax.Node] |
  -- | See https://www.w3.org/TR/shacl/#LanguageInConstraintComponent
  CommonConstraintLanguageIn (Set Syntax.LanguageTag) |
  -- | See https://www.w3.org/TR/shacl/#NodeKindConstraintComponent
  CommonConstraintNodeKind NodeKind |
  -- | See https://www.w3.org/TR/shacl/#NodeConstraintComponent
  CommonConstraintNode (Set (Reference NodeShape)) |
  -- | See https://www.w3.org/TR/shacl/#NotConstraintComponent
  CommonConstraintNot (Set (Reference Shape)) |
  -- | See https://www.w3.org/TR/shacl/#MaxExclusiveConstraintComponent
  CommonConstraintMaxExclusive Syntax.Literal |
  -- | See https://www.w3.org/TR/shacl/#MaxInclusiveConstraintComponent
  CommonConstraintMaxInclusive Syntax.Literal |
  -- | See https://www.w3.org/TR/shacl/#MaxLengthConstraintComponent
  CommonConstraintMaxLength Integer |
  -- | See https://www.w3.org/TR/shacl/#MinExclusiveConstraintComponent
  CommonConstraintMinExclusive Syntax.Literal |
  -- | See https://www.w3.org/TR/shacl/#MinInclusiveConstraintComponent
  CommonConstraintMinInclusive Syntax.Literal |
  -- | See https://www.w3.org/TR/shacl/#MinLengthConstraintComponent
  CommonConstraintMinLength Integer |
  -- | See https://www.w3.org/TR/shacl/#PatternConstraintComponent
  CommonConstraintPattern Pattern |
  -- | See https://www.w3.org/TR/shacl/#PropertyConstraintComponent
  CommonConstraintProperty (Set (Reference PropertyShape)) |
  -- | See https://www.w3.org/TR/shacl/#OrConstraintComponent
  CommonConstraintOr (Set (Reference Shape)) |
  -- | See https://www.w3.org/TR/shacl/#XoneConstraintComponent
  CommonConstraintXone (Set (Reference Shape))
  deriving (CommonConstraint -> CommonConstraint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommonConstraint -> CommonConstraint -> Bool
$c/= :: CommonConstraint -> CommonConstraint -> Bool
== :: CommonConstraint -> CommonConstraint -> Bool
$c== :: CommonConstraint -> CommonConstraint -> Bool
Eq, Eq CommonConstraint
CommonConstraint -> CommonConstraint -> Bool
CommonConstraint -> CommonConstraint -> Ordering
CommonConstraint -> CommonConstraint -> CommonConstraint
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CommonConstraint -> CommonConstraint -> CommonConstraint
$cmin :: CommonConstraint -> CommonConstraint -> CommonConstraint
max :: CommonConstraint -> CommonConstraint -> CommonConstraint
$cmax :: CommonConstraint -> CommonConstraint -> CommonConstraint
>= :: CommonConstraint -> CommonConstraint -> Bool
$c>= :: CommonConstraint -> CommonConstraint -> Bool
> :: CommonConstraint -> CommonConstraint -> Bool
$c> :: CommonConstraint -> CommonConstraint -> Bool
<= :: CommonConstraint -> CommonConstraint -> Bool
$c<= :: CommonConstraint -> CommonConstraint -> Bool
< :: CommonConstraint -> CommonConstraint -> Bool
$c< :: CommonConstraint -> CommonConstraint -> Bool
compare :: CommonConstraint -> CommonConstraint -> Ordering
$ccompare :: CommonConstraint -> CommonConstraint -> Ordering
Ord, ReadPrec [CommonConstraint]
ReadPrec CommonConstraint
Int -> ReadS CommonConstraint
ReadS [CommonConstraint]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CommonConstraint]
$creadListPrec :: ReadPrec [CommonConstraint]
readPrec :: ReadPrec CommonConstraint
$creadPrec :: ReadPrec CommonConstraint
readList :: ReadS [CommonConstraint]
$creadList :: ReadS [CommonConstraint]
readsPrec :: Int -> ReadS CommonConstraint
$creadsPrec :: Int -> ReadS CommonConstraint
Read, Int -> CommonConstraint -> ShowS
[CommonConstraint] -> ShowS
CommonConstraint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommonConstraint] -> ShowS
$cshowList :: [CommonConstraint] -> ShowS
show :: CommonConstraint -> String
$cshow :: CommonConstraint -> String
showsPrec :: Int -> CommonConstraint -> ShowS
$cshowsPrec :: Int -> CommonConstraint -> ShowS
Show)

_CommonConstraint :: Name
_CommonConstraint = (String -> Name
Core.Name String
"hydra/ext/shacl/model.CommonConstraint")

_CommonConstraint_and :: FieldName
_CommonConstraint_and = (String -> FieldName
Core.FieldName String
"and")

_CommonConstraint_closed :: FieldName
_CommonConstraint_closed = (String -> FieldName
Core.FieldName String
"closed")

_CommonConstraint_class :: FieldName
_CommonConstraint_class = (String -> FieldName
Core.FieldName String
"class")

_CommonConstraint_datatype :: FieldName
_CommonConstraint_datatype = (String -> FieldName
Core.FieldName String
"datatype")

_CommonConstraint_disjoint :: FieldName
_CommonConstraint_disjoint = (String -> FieldName
Core.FieldName String
"disjoint")

_CommonConstraint_equals :: FieldName
_CommonConstraint_equals = (String -> FieldName
Core.FieldName String
"equals")

_CommonConstraint_hasValue :: FieldName
_CommonConstraint_hasValue = (String -> FieldName
Core.FieldName String
"hasValue")

_CommonConstraint_in :: FieldName
_CommonConstraint_in = (String -> FieldName
Core.FieldName String
"in")

_CommonConstraint_languageIn :: FieldName
_CommonConstraint_languageIn = (String -> FieldName
Core.FieldName String
"languageIn")

_CommonConstraint_nodeKind :: FieldName
_CommonConstraint_nodeKind = (String -> FieldName
Core.FieldName String
"nodeKind")

_CommonConstraint_node :: FieldName
_CommonConstraint_node = (String -> FieldName
Core.FieldName String
"node")

_CommonConstraint_not :: FieldName
_CommonConstraint_not = (String -> FieldName
Core.FieldName String
"not")

_CommonConstraint_maxExclusive :: FieldName
_CommonConstraint_maxExclusive = (String -> FieldName
Core.FieldName String
"maxExclusive")

_CommonConstraint_maxInclusive :: FieldName
_CommonConstraint_maxInclusive = (String -> FieldName
Core.FieldName String
"maxInclusive")

_CommonConstraint_maxLength :: FieldName
_CommonConstraint_maxLength = (String -> FieldName
Core.FieldName String
"maxLength")

_CommonConstraint_minExclusive :: FieldName
_CommonConstraint_minExclusive = (String -> FieldName
Core.FieldName String
"minExclusive")

_CommonConstraint_minInclusive :: FieldName
_CommonConstraint_minInclusive = (String -> FieldName
Core.FieldName String
"minInclusive")

_CommonConstraint_minLength :: FieldName
_CommonConstraint_minLength = (String -> FieldName
Core.FieldName String
"minLength")

_CommonConstraint_pattern :: FieldName
_CommonConstraint_pattern = (String -> FieldName
Core.FieldName String
"pattern")

_CommonConstraint_property :: FieldName
_CommonConstraint_property = (String -> FieldName
Core.FieldName String
"property")

_CommonConstraint_or :: FieldName
_CommonConstraint_or = (String -> FieldName
Core.FieldName String
"or")

_CommonConstraint_xone :: FieldName
_CommonConstraint_xone = (String -> FieldName
Core.FieldName String
"xone")

-- | Common constraint parameters and other properties for SHACL shapes
data CommonProperties = 
  CommonProperties {
    -- | Common constraint parameters attached to this shape
    CommonProperties -> Set CommonConstraint
commonPropertiesConstraints :: (Set CommonConstraint),
    -- | See https://www.w3.org/TR/shacl/#deactivated
    CommonProperties -> Maybe Bool
commonPropertiesDeactivated :: (Maybe Bool),
    -- | See https://www.w3.org/TR/shacl/#message
    CommonProperties -> LangStrings
commonPropertiesMessage :: Syntax.LangStrings,
    -- | See https://www.w3.org/TR/shacl/#severity
    CommonProperties -> Severity
commonPropertiesSeverity :: Severity,
    -- | See https://www.w3.org/TR/shacl/#targetClass
    CommonProperties -> Set RdfsClass
commonPropertiesTargetClass :: (Set Syntax.RdfsClass),
    -- | See https://www.w3.org/TR/shacl/#targetNode
    CommonProperties -> Set IriOrLiteral
commonPropertiesTargetNode :: (Set Syntax.IriOrLiteral),
    -- | See https://www.w3.org/TR/shacl/#targetObjectsOf
    CommonProperties -> Set Property
commonPropertiesTargetObjectsOf :: (Set Syntax.Property),
    -- | See https://www.w3.org/TR/shacl/#targetSubjectsOf
    CommonProperties -> Set Property
commonPropertiesTargetSubjectsOf :: (Set Syntax.Property)}
  deriving (CommonProperties -> CommonProperties -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommonProperties -> CommonProperties -> Bool
$c/= :: CommonProperties -> CommonProperties -> Bool
== :: CommonProperties -> CommonProperties -> Bool
$c== :: CommonProperties -> CommonProperties -> Bool
Eq, Eq CommonProperties
CommonProperties -> CommonProperties -> Bool
CommonProperties -> CommonProperties -> Ordering
CommonProperties -> CommonProperties -> CommonProperties
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CommonProperties -> CommonProperties -> CommonProperties
$cmin :: CommonProperties -> CommonProperties -> CommonProperties
max :: CommonProperties -> CommonProperties -> CommonProperties
$cmax :: CommonProperties -> CommonProperties -> CommonProperties
>= :: CommonProperties -> CommonProperties -> Bool
$c>= :: CommonProperties -> CommonProperties -> Bool
> :: CommonProperties -> CommonProperties -> Bool
$c> :: CommonProperties -> CommonProperties -> Bool
<= :: CommonProperties -> CommonProperties -> Bool
$c<= :: CommonProperties -> CommonProperties -> Bool
< :: CommonProperties -> CommonProperties -> Bool
$c< :: CommonProperties -> CommonProperties -> Bool
compare :: CommonProperties -> CommonProperties -> Ordering
$ccompare :: CommonProperties -> CommonProperties -> Ordering
Ord, ReadPrec [CommonProperties]
ReadPrec CommonProperties
Int -> ReadS CommonProperties
ReadS [CommonProperties]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CommonProperties]
$creadListPrec :: ReadPrec [CommonProperties]
readPrec :: ReadPrec CommonProperties
$creadPrec :: ReadPrec CommonProperties
readList :: ReadS [CommonProperties]
$creadList :: ReadS [CommonProperties]
readsPrec :: Int -> ReadS CommonProperties
$creadsPrec :: Int -> ReadS CommonProperties
Read, Int -> CommonProperties -> ShowS
[CommonProperties] -> ShowS
CommonProperties -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommonProperties] -> ShowS
$cshowList :: [CommonProperties] -> ShowS
show :: CommonProperties -> String
$cshow :: CommonProperties -> String
showsPrec :: Int -> CommonProperties -> ShowS
$cshowsPrec :: Int -> CommonProperties -> ShowS
Show)

_CommonProperties :: Name
_CommonProperties = (String -> Name
Core.Name String
"hydra/ext/shacl/model.CommonProperties")

_CommonProperties_constraints :: FieldName
_CommonProperties_constraints = (String -> FieldName
Core.FieldName String
"constraints")

_CommonProperties_deactivated :: FieldName
_CommonProperties_deactivated = (String -> FieldName
Core.FieldName String
"deactivated")

_CommonProperties_message :: FieldName
_CommonProperties_message = (String -> FieldName
Core.FieldName String
"message")

_CommonProperties_severity :: FieldName
_CommonProperties_severity = (String -> FieldName
Core.FieldName String
"severity")

_CommonProperties_targetClass :: FieldName
_CommonProperties_targetClass = (String -> FieldName
Core.FieldName String
"targetClass")

_CommonProperties_targetNode :: FieldName
_CommonProperties_targetNode = (String -> FieldName
Core.FieldName String
"targetNode")

_CommonProperties_targetObjectsOf :: FieldName
_CommonProperties_targetObjectsOf = (String -> FieldName
Core.FieldName String
"targetObjectsOf")

_CommonProperties_targetSubjectsOf :: FieldName
_CommonProperties_targetSubjectsOf = (String -> FieldName
Core.FieldName String
"targetSubjectsOf")

-- | An instance of a type like sh:Shape or sh:NodeShape, together with a unique IRI for that instance
data Definition a = 
  Definition {
    forall a. Definition a -> Iri
definitionIri :: Syntax.Iri,
    forall a. Definition a -> a
definitionTarget :: a}
  deriving (Definition a -> Definition a -> Bool
forall a. Eq a => Definition a -> Definition a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Definition a -> Definition a -> Bool
$c/= :: forall a. Eq a => Definition a -> Definition a -> Bool
== :: Definition a -> Definition a -> Bool
$c== :: forall a. Eq a => Definition a -> Definition a -> Bool
Eq, Definition a -> Definition a -> Bool
Definition a -> Definition a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Definition a)
forall a. Ord a => Definition a -> Definition a -> Bool
forall a. Ord a => Definition a -> Definition a -> Ordering
forall a. Ord a => Definition a -> Definition a -> Definition a
min :: Definition a -> Definition a -> Definition a
$cmin :: forall a. Ord a => Definition a -> Definition a -> Definition a
max :: Definition a -> Definition a -> Definition a
$cmax :: forall a. Ord a => Definition a -> Definition a -> Definition a
>= :: Definition a -> Definition a -> Bool
$c>= :: forall a. Ord a => Definition a -> Definition a -> Bool
> :: Definition a -> Definition a -> Bool
$c> :: forall a. Ord a => Definition a -> Definition a -> Bool
<= :: Definition a -> Definition a -> Bool
$c<= :: forall a. Ord a => Definition a -> Definition a -> Bool
< :: Definition a -> Definition a -> Bool
$c< :: forall a. Ord a => Definition a -> Definition a -> Bool
compare :: Definition a -> Definition a -> Ordering
$ccompare :: forall a. Ord a => Definition a -> Definition a -> Ordering
Ord, ReadPrec [Definition a]
ReadPrec (Definition a)
ReadS [Definition a]
forall a. Read a => ReadPrec [Definition a]
forall a. Read a => ReadPrec (Definition a)
forall a. Read a => Int -> ReadS (Definition a)
forall a. Read a => ReadS [Definition a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Definition a]
$creadListPrec :: forall a. Read a => ReadPrec [Definition a]
readPrec :: ReadPrec (Definition a)
$creadPrec :: forall a. Read a => ReadPrec (Definition a)
readList :: ReadS [Definition a]
$creadList :: forall a. Read a => ReadS [Definition a]
readsPrec :: Int -> ReadS (Definition a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Definition a)
Read, Int -> Definition a -> ShowS
forall a. Show a => Int -> Definition a -> ShowS
forall a. Show a => [Definition a] -> ShowS
forall a. Show a => Definition a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Definition a] -> ShowS
$cshowList :: forall a. Show a => [Definition a] -> ShowS
show :: Definition a -> String
$cshow :: forall a. Show a => Definition a -> String
showsPrec :: Int -> Definition a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Definition a -> ShowS
Show)

_Definition :: Name
_Definition = (String -> Name
Core.Name String
"hydra/ext/shacl/model.Definition")

_Definition_iri :: FieldName
_Definition_iri = (String -> FieldName
Core.FieldName String
"iri")

_Definition_target :: FieldName
_Definition_target = (String -> FieldName
Core.FieldName String
"target")

data NodeKind = 
  -- | A blank node
  NodeKindBlankNode  |
  -- | An IRI
  NodeKindIri  |
  -- | A literal
  NodeKindLiteral  |
  -- | A blank node or an IRI
  NodeKindBlankNodeOrIri  |
  -- | A blank node or a literal
  NodeKindBlankNodeOrLiteral  |
  -- | An IRI or a literal
  NodeKindIriOrLiteral 
  deriving (NodeKind -> NodeKind -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeKind -> NodeKind -> Bool
$c/= :: NodeKind -> NodeKind -> Bool
== :: NodeKind -> NodeKind -> Bool
$c== :: NodeKind -> NodeKind -> Bool
Eq, Eq NodeKind
NodeKind -> NodeKind -> Bool
NodeKind -> NodeKind -> Ordering
NodeKind -> NodeKind -> NodeKind
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NodeKind -> NodeKind -> NodeKind
$cmin :: NodeKind -> NodeKind -> NodeKind
max :: NodeKind -> NodeKind -> NodeKind
$cmax :: NodeKind -> NodeKind -> NodeKind
>= :: NodeKind -> NodeKind -> Bool
$c>= :: NodeKind -> NodeKind -> Bool
> :: NodeKind -> NodeKind -> Bool
$c> :: NodeKind -> NodeKind -> Bool
<= :: NodeKind -> NodeKind -> Bool
$c<= :: NodeKind -> NodeKind -> Bool
< :: NodeKind -> NodeKind -> Bool
$c< :: NodeKind -> NodeKind -> Bool
compare :: NodeKind -> NodeKind -> Ordering
$ccompare :: NodeKind -> NodeKind -> Ordering
Ord, ReadPrec [NodeKind]
ReadPrec NodeKind
Int -> ReadS NodeKind
ReadS [NodeKind]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NodeKind]
$creadListPrec :: ReadPrec [NodeKind]
readPrec :: ReadPrec NodeKind
$creadPrec :: ReadPrec NodeKind
readList :: ReadS [NodeKind]
$creadList :: ReadS [NodeKind]
readsPrec :: Int -> ReadS NodeKind
$creadsPrec :: Int -> ReadS NodeKind
Read, Int -> NodeKind -> ShowS
[NodeKind] -> ShowS
NodeKind -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeKind] -> ShowS
$cshowList :: [NodeKind] -> ShowS
show :: NodeKind -> String
$cshow :: NodeKind -> String
showsPrec :: Int -> NodeKind -> ShowS
$cshowsPrec :: Int -> NodeKind -> ShowS
Show)

_NodeKind :: Name
_NodeKind = (String -> Name
Core.Name String
"hydra/ext/shacl/model.NodeKind")

_NodeKind_blankNode :: FieldName
_NodeKind_blankNode = (String -> FieldName
Core.FieldName String
"blankNode")

_NodeKind_iri :: FieldName
_NodeKind_iri = (String -> FieldName
Core.FieldName String
"iri")

_NodeKind_literal :: FieldName
_NodeKind_literal = (String -> FieldName
Core.FieldName String
"literal")

_NodeKind_blankNodeOrIri :: FieldName
_NodeKind_blankNodeOrIri = (String -> FieldName
Core.FieldName String
"blankNodeOrIri")

_NodeKind_blankNodeOrLiteral :: FieldName
_NodeKind_blankNodeOrLiteral = (String -> FieldName
Core.FieldName String
"blankNodeOrLiteral")

_NodeKind_iriOrLiteral :: FieldName
_NodeKind_iriOrLiteral = (String -> FieldName
Core.FieldName String
"iriOrLiteral")

-- | A SHACL node shape. See https://www.w3.org/TR/shacl/#node-shapes
data NodeShape = 
  NodeShape {
    NodeShape -> CommonProperties
nodeShapeCommon :: CommonProperties}
  deriving (NodeShape -> NodeShape -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeShape -> NodeShape -> Bool
$c/= :: NodeShape -> NodeShape -> Bool
== :: NodeShape -> NodeShape -> Bool
$c== :: NodeShape -> NodeShape -> Bool
Eq, Eq NodeShape
NodeShape -> NodeShape -> Bool
NodeShape -> NodeShape -> Ordering
NodeShape -> NodeShape -> NodeShape
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NodeShape -> NodeShape -> NodeShape
$cmin :: NodeShape -> NodeShape -> NodeShape
max :: NodeShape -> NodeShape -> NodeShape
$cmax :: NodeShape -> NodeShape -> NodeShape
>= :: NodeShape -> NodeShape -> Bool
$c>= :: NodeShape -> NodeShape -> Bool
> :: NodeShape -> NodeShape -> Bool
$c> :: NodeShape -> NodeShape -> Bool
<= :: NodeShape -> NodeShape -> Bool
$c<= :: NodeShape -> NodeShape -> Bool
< :: NodeShape -> NodeShape -> Bool
$c< :: NodeShape -> NodeShape -> Bool
compare :: NodeShape -> NodeShape -> Ordering
$ccompare :: NodeShape -> NodeShape -> Ordering
Ord, ReadPrec [NodeShape]
ReadPrec NodeShape
Int -> ReadS NodeShape
ReadS [NodeShape]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NodeShape]
$creadListPrec :: ReadPrec [NodeShape]
readPrec :: ReadPrec NodeShape
$creadPrec :: ReadPrec NodeShape
readList :: ReadS [NodeShape]
$creadList :: ReadS [NodeShape]
readsPrec :: Int -> ReadS NodeShape
$creadsPrec :: Int -> ReadS NodeShape
Read, Int -> NodeShape -> ShowS
[NodeShape] -> ShowS
NodeShape -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeShape] -> ShowS
$cshowList :: [NodeShape] -> ShowS
show :: NodeShape -> String
$cshow :: NodeShape -> String
showsPrec :: Int -> NodeShape -> ShowS
$cshowsPrec :: Int -> NodeShape -> ShowS
Show)

_NodeShape :: Name
_NodeShape = (String -> Name
Core.Name String
"hydra/ext/shacl/model.NodeShape")

_NodeShape_common :: FieldName
_NodeShape_common = (String -> FieldName
Core.FieldName String
"common")

-- | A SHACL pattern. See https://www.w3.org/TR/shacl/#PatternConstraintComponent
data Pattern = 
  Pattern {
    Pattern -> String
patternRegex :: String,
    Pattern -> Maybe String
patternFlags :: (Maybe String)}
  deriving (Pattern -> Pattern -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pattern -> Pattern -> Bool
$c/= :: Pattern -> Pattern -> Bool
== :: Pattern -> Pattern -> Bool
$c== :: Pattern -> Pattern -> Bool
Eq, Eq Pattern
Pattern -> Pattern -> Bool
Pattern -> Pattern -> Ordering
Pattern -> Pattern -> Pattern
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Pattern -> Pattern -> Pattern
$cmin :: Pattern -> Pattern -> Pattern
max :: Pattern -> Pattern -> Pattern
$cmax :: Pattern -> Pattern -> Pattern
>= :: Pattern -> Pattern -> Bool
$c>= :: Pattern -> Pattern -> Bool
> :: Pattern -> Pattern -> Bool
$c> :: Pattern -> Pattern -> Bool
<= :: Pattern -> Pattern -> Bool
$c<= :: Pattern -> Pattern -> Bool
< :: Pattern -> Pattern -> Bool
$c< :: Pattern -> Pattern -> Bool
compare :: Pattern -> Pattern -> Ordering
$ccompare :: Pattern -> Pattern -> Ordering
Ord, ReadPrec [Pattern]
ReadPrec Pattern
Int -> ReadS Pattern
ReadS [Pattern]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Pattern]
$creadListPrec :: ReadPrec [Pattern]
readPrec :: ReadPrec Pattern
$creadPrec :: ReadPrec Pattern
readList :: ReadS [Pattern]
$creadList :: ReadS [Pattern]
readsPrec :: Int -> ReadS Pattern
$creadsPrec :: Int -> ReadS Pattern
Read, Int -> Pattern -> ShowS
[Pattern] -> ShowS
Pattern -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pattern] -> ShowS
$cshowList :: [Pattern] -> ShowS
show :: Pattern -> String
$cshow :: Pattern -> String
showsPrec :: Int -> Pattern -> ShowS
$cshowsPrec :: Int -> Pattern -> ShowS
Show)

_Pattern :: Name
_Pattern = (String -> Name
Core.Name String
"hydra/ext/shacl/model.Pattern")

_Pattern_regex :: FieldName
_Pattern_regex = (String -> FieldName
Core.FieldName String
"regex")

_Pattern_flags :: FieldName
_Pattern_flags = (String -> FieldName
Core.FieldName String
"flags")

-- | A SHACL property shape. See https://www.w3.org/TR/shacl/#property-shapes
data PropertyShape = 
  PropertyShape {
    PropertyShape -> CommonProperties
propertyShapeCommon :: CommonProperties,
    -- | Any property shape -specific constraint parameters
    PropertyShape -> Set PropertyShapeConstraint
propertyShapeConstraints :: (Set PropertyShapeConstraint),
    -- | See https://www.w3.org/TR/shacl/#defaultValue
    PropertyShape -> Maybe Node
propertyShapeDefaultValue :: (Maybe Syntax.Node),
    -- | See https://www.w3.org/TR/shacl/#name
    PropertyShape -> LangStrings
propertyShapeDescription :: Syntax.LangStrings,
    -- | See https://www.w3.org/TR/shacl/#name
    PropertyShape -> LangStrings
propertyShapeName :: Syntax.LangStrings,
    -- | See https://www.w3.org/TR/shacl/#order
    PropertyShape -> Maybe Integer
propertyShapeOrder :: (Maybe Integer),
    PropertyShape -> Iri
propertyShapePath :: Syntax.Iri}
  deriving (PropertyShape -> PropertyShape -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PropertyShape -> PropertyShape -> Bool
$c/= :: PropertyShape -> PropertyShape -> Bool
== :: PropertyShape -> PropertyShape -> Bool
$c== :: PropertyShape -> PropertyShape -> Bool
Eq, Eq PropertyShape
PropertyShape -> PropertyShape -> Bool
PropertyShape -> PropertyShape -> Ordering
PropertyShape -> PropertyShape -> PropertyShape
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PropertyShape -> PropertyShape -> PropertyShape
$cmin :: PropertyShape -> PropertyShape -> PropertyShape
max :: PropertyShape -> PropertyShape -> PropertyShape
$cmax :: PropertyShape -> PropertyShape -> PropertyShape
>= :: PropertyShape -> PropertyShape -> Bool
$c>= :: PropertyShape -> PropertyShape -> Bool
> :: PropertyShape -> PropertyShape -> Bool
$c> :: PropertyShape -> PropertyShape -> Bool
<= :: PropertyShape -> PropertyShape -> Bool
$c<= :: PropertyShape -> PropertyShape -> Bool
< :: PropertyShape -> PropertyShape -> Bool
$c< :: PropertyShape -> PropertyShape -> Bool
compare :: PropertyShape -> PropertyShape -> Ordering
$ccompare :: PropertyShape -> PropertyShape -> Ordering
Ord, ReadPrec [PropertyShape]
ReadPrec PropertyShape
Int -> ReadS PropertyShape
ReadS [PropertyShape]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PropertyShape]
$creadListPrec :: ReadPrec [PropertyShape]
readPrec :: ReadPrec PropertyShape
$creadPrec :: ReadPrec PropertyShape
readList :: ReadS [PropertyShape]
$creadList :: ReadS [PropertyShape]
readsPrec :: Int -> ReadS PropertyShape
$creadsPrec :: Int -> ReadS PropertyShape
Read, Int -> PropertyShape -> ShowS
[PropertyShape] -> ShowS
PropertyShape -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PropertyShape] -> ShowS
$cshowList :: [PropertyShape] -> ShowS
show :: PropertyShape -> String
$cshow :: PropertyShape -> String
showsPrec :: Int -> PropertyShape -> ShowS
$cshowsPrec :: Int -> PropertyShape -> ShowS
Show)

_PropertyShape :: Name
_PropertyShape = (String -> Name
Core.Name String
"hydra/ext/shacl/model.PropertyShape")

_PropertyShape_common :: FieldName
_PropertyShape_common = (String -> FieldName
Core.FieldName String
"common")

_PropertyShape_constraints :: FieldName
_PropertyShape_constraints = (String -> FieldName
Core.FieldName String
"constraints")

_PropertyShape_defaultValue :: FieldName
_PropertyShape_defaultValue = (String -> FieldName
Core.FieldName String
"defaultValue")

_PropertyShape_description :: FieldName
_PropertyShape_description = (String -> FieldName
Core.FieldName String
"description")

_PropertyShape_name :: FieldName
_PropertyShape_name = (String -> FieldName
Core.FieldName String
"name")

_PropertyShape_order :: FieldName
_PropertyShape_order = (String -> FieldName
Core.FieldName String
"order")

_PropertyShape_path :: FieldName
_PropertyShape_path = (String -> FieldName
Core.FieldName String
"path")

-- | A number of constraint parameters which are specific to property shapes, and cannot be applied to node shapes
data PropertyShapeConstraint = 
  -- | See https://www.w3.org/TR/shacl/#LessThanConstraintComponent
  PropertyShapeConstraintLessThan (Set Syntax.Property) |
  -- | See https://www.w3.org/TR/shacl/#LessThanOrEqualsConstraintComponent
  PropertyShapeConstraintLessThanOrEquals (Set Syntax.Property) |
  -- | The maximum cardinality. Node shapes cannot have any value for sh:maxCount. See https://www.w3.org/TR/shacl/#MaxCountConstraintComponent
  PropertyShapeConstraintMaxCount Integer |
  -- | The minimum cardinality. Node shapes cannot have any value for sh:minCount. See https://www.w3.org/TR/shacl/#MinCountConstraintComponent
  PropertyShapeConstraintMinCount Integer |
  -- | See https://www.w3.org/TR/shacl/#UniqueLangConstraintComponent
  PropertyShapeConstraintUniqueLang Bool |
  -- | See https://www.w3.org/TR/shacl/#QualifiedValueShapeConstraintComponent
  PropertyShapeConstraintQualifiedValueShape QualifiedValueShape
  deriving (PropertyShapeConstraint -> PropertyShapeConstraint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PropertyShapeConstraint -> PropertyShapeConstraint -> Bool
$c/= :: PropertyShapeConstraint -> PropertyShapeConstraint -> Bool
== :: PropertyShapeConstraint -> PropertyShapeConstraint -> Bool
$c== :: PropertyShapeConstraint -> PropertyShapeConstraint -> Bool
Eq, Eq PropertyShapeConstraint
PropertyShapeConstraint -> PropertyShapeConstraint -> Bool
PropertyShapeConstraint -> PropertyShapeConstraint -> Ordering
PropertyShapeConstraint
-> PropertyShapeConstraint -> PropertyShapeConstraint
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PropertyShapeConstraint
-> PropertyShapeConstraint -> PropertyShapeConstraint
$cmin :: PropertyShapeConstraint
-> PropertyShapeConstraint -> PropertyShapeConstraint
max :: PropertyShapeConstraint
-> PropertyShapeConstraint -> PropertyShapeConstraint
$cmax :: PropertyShapeConstraint
-> PropertyShapeConstraint -> PropertyShapeConstraint
>= :: PropertyShapeConstraint -> PropertyShapeConstraint -> Bool
$c>= :: PropertyShapeConstraint -> PropertyShapeConstraint -> Bool
> :: PropertyShapeConstraint -> PropertyShapeConstraint -> Bool
$c> :: PropertyShapeConstraint -> PropertyShapeConstraint -> Bool
<= :: PropertyShapeConstraint -> PropertyShapeConstraint -> Bool
$c<= :: PropertyShapeConstraint -> PropertyShapeConstraint -> Bool
< :: PropertyShapeConstraint -> PropertyShapeConstraint -> Bool
$c< :: PropertyShapeConstraint -> PropertyShapeConstraint -> Bool
compare :: PropertyShapeConstraint -> PropertyShapeConstraint -> Ordering
$ccompare :: PropertyShapeConstraint -> PropertyShapeConstraint -> Ordering
Ord, ReadPrec [PropertyShapeConstraint]
ReadPrec PropertyShapeConstraint
Int -> ReadS PropertyShapeConstraint
ReadS [PropertyShapeConstraint]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PropertyShapeConstraint]
$creadListPrec :: ReadPrec [PropertyShapeConstraint]
readPrec :: ReadPrec PropertyShapeConstraint
$creadPrec :: ReadPrec PropertyShapeConstraint
readList :: ReadS [PropertyShapeConstraint]
$creadList :: ReadS [PropertyShapeConstraint]
readsPrec :: Int -> ReadS PropertyShapeConstraint
$creadsPrec :: Int -> ReadS PropertyShapeConstraint
Read, Int -> PropertyShapeConstraint -> ShowS
[PropertyShapeConstraint] -> ShowS
PropertyShapeConstraint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PropertyShapeConstraint] -> ShowS
$cshowList :: [PropertyShapeConstraint] -> ShowS
show :: PropertyShapeConstraint -> String
$cshow :: PropertyShapeConstraint -> String
showsPrec :: Int -> PropertyShapeConstraint -> ShowS
$cshowsPrec :: Int -> PropertyShapeConstraint -> ShowS
Show)

_PropertyShapeConstraint :: Name
_PropertyShapeConstraint = (String -> Name
Core.Name String
"hydra/ext/shacl/model.PropertyShapeConstraint")

_PropertyShapeConstraint_lessThan :: FieldName
_PropertyShapeConstraint_lessThan = (String -> FieldName
Core.FieldName String
"lessThan")

_PropertyShapeConstraint_lessThanOrEquals :: FieldName
_PropertyShapeConstraint_lessThanOrEquals = (String -> FieldName
Core.FieldName String
"lessThanOrEquals")

_PropertyShapeConstraint_maxCount :: FieldName
_PropertyShapeConstraint_maxCount = (String -> FieldName
Core.FieldName String
"maxCount")

_PropertyShapeConstraint_minCount :: FieldName
_PropertyShapeConstraint_minCount = (String -> FieldName
Core.FieldName String
"minCount")

_PropertyShapeConstraint_uniqueLang :: FieldName
_PropertyShapeConstraint_uniqueLang = (String -> FieldName
Core.FieldName String
"uniqueLang")

_PropertyShapeConstraint_qualifiedValueShape :: FieldName
_PropertyShapeConstraint_qualifiedValueShape = (String -> FieldName
Core.FieldName String
"qualifiedValueShape")

-- | See https://www.w3.org/TR/shacl/#QualifiedValueShapeConstraintComponent
data QualifiedValueShape = 
  QualifiedValueShape {
    QualifiedValueShape -> Reference Shape
qualifiedValueShapeQualifiedValueShape :: (Reference Shape),
    QualifiedValueShape -> Integer
qualifiedValueShapeQualifiedMaxCount :: Integer,
    QualifiedValueShape -> Integer
qualifiedValueShapeQualifiedMinCount :: Integer,
    QualifiedValueShape -> Maybe Bool
qualifiedValueShapeQualifiedValueShapesDisjoint :: (Maybe Bool)}
  deriving (QualifiedValueShape -> QualifiedValueShape -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QualifiedValueShape -> QualifiedValueShape -> Bool
$c/= :: QualifiedValueShape -> QualifiedValueShape -> Bool
== :: QualifiedValueShape -> QualifiedValueShape -> Bool
$c== :: QualifiedValueShape -> QualifiedValueShape -> Bool
Eq, Eq QualifiedValueShape
QualifiedValueShape -> QualifiedValueShape -> Bool
QualifiedValueShape -> QualifiedValueShape -> Ordering
QualifiedValueShape -> QualifiedValueShape -> QualifiedValueShape
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: QualifiedValueShape -> QualifiedValueShape -> QualifiedValueShape
$cmin :: QualifiedValueShape -> QualifiedValueShape -> QualifiedValueShape
max :: QualifiedValueShape -> QualifiedValueShape -> QualifiedValueShape
$cmax :: QualifiedValueShape -> QualifiedValueShape -> QualifiedValueShape
>= :: QualifiedValueShape -> QualifiedValueShape -> Bool
$c>= :: QualifiedValueShape -> QualifiedValueShape -> Bool
> :: QualifiedValueShape -> QualifiedValueShape -> Bool
$c> :: QualifiedValueShape -> QualifiedValueShape -> Bool
<= :: QualifiedValueShape -> QualifiedValueShape -> Bool
$c<= :: QualifiedValueShape -> QualifiedValueShape -> Bool
< :: QualifiedValueShape -> QualifiedValueShape -> Bool
$c< :: QualifiedValueShape -> QualifiedValueShape -> Bool
compare :: QualifiedValueShape -> QualifiedValueShape -> Ordering
$ccompare :: QualifiedValueShape -> QualifiedValueShape -> Ordering
Ord, ReadPrec [QualifiedValueShape]
ReadPrec QualifiedValueShape
Int -> ReadS QualifiedValueShape
ReadS [QualifiedValueShape]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [QualifiedValueShape]
$creadListPrec :: ReadPrec [QualifiedValueShape]
readPrec :: ReadPrec QualifiedValueShape
$creadPrec :: ReadPrec QualifiedValueShape
readList :: ReadS [QualifiedValueShape]
$creadList :: ReadS [QualifiedValueShape]
readsPrec :: Int -> ReadS QualifiedValueShape
$creadsPrec :: Int -> ReadS QualifiedValueShape
Read, Int -> QualifiedValueShape -> ShowS
[QualifiedValueShape] -> ShowS
QualifiedValueShape -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QualifiedValueShape] -> ShowS
$cshowList :: [QualifiedValueShape] -> ShowS
show :: QualifiedValueShape -> String
$cshow :: QualifiedValueShape -> String
showsPrec :: Int -> QualifiedValueShape -> ShowS
$cshowsPrec :: Int -> QualifiedValueShape -> ShowS
Show)

_QualifiedValueShape :: Name
_QualifiedValueShape = (String -> Name
Core.Name String
"hydra/ext/shacl/model.QualifiedValueShape")

_QualifiedValueShape_qualifiedValueShape :: FieldName
_QualifiedValueShape_qualifiedValueShape = (String -> FieldName
Core.FieldName String
"qualifiedValueShape")

_QualifiedValueShape_qualifiedMaxCount :: FieldName
_QualifiedValueShape_qualifiedMaxCount = (String -> FieldName
Core.FieldName String
"qualifiedMaxCount")

_QualifiedValueShape_qualifiedMinCount :: FieldName
_QualifiedValueShape_qualifiedMinCount = (String -> FieldName
Core.FieldName String
"qualifiedMinCount")

_QualifiedValueShape_qualifiedValueShapesDisjoint :: FieldName
_QualifiedValueShape_qualifiedValueShapesDisjoint = (String -> FieldName
Core.FieldName String
"qualifiedValueShapesDisjoint")

-- | Either an instance of a type like sh:Shape or sh:NodeShape, or an IRI which refers to an instance of that type
data Reference a = 
  ReferenceNamed Syntax.Iri |
  -- | An anonymous instance
  ReferenceAnonymous a |
  -- | An inline definition
  ReferenceDefinition (Definition a)
  deriving (Reference a -> Reference a -> Bool
forall a. Eq a => Reference a -> Reference a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Reference a -> Reference a -> Bool
$c/= :: forall a. Eq a => Reference a -> Reference a -> Bool
== :: Reference a -> Reference a -> Bool
$c== :: forall a. Eq a => Reference a -> Reference a -> Bool
Eq, Reference a -> Reference a -> Bool
Reference a -> Reference a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Reference a)
forall a. Ord a => Reference a -> Reference a -> Bool
forall a. Ord a => Reference a -> Reference a -> Ordering
forall a. Ord a => Reference a -> Reference a -> Reference a
min :: Reference a -> Reference a -> Reference a
$cmin :: forall a. Ord a => Reference a -> Reference a -> Reference a
max :: Reference a -> Reference a -> Reference a
$cmax :: forall a. Ord a => Reference a -> Reference a -> Reference a
>= :: Reference a -> Reference a -> Bool
$c>= :: forall a. Ord a => Reference a -> Reference a -> Bool
> :: Reference a -> Reference a -> Bool
$c> :: forall a. Ord a => Reference a -> Reference a -> Bool
<= :: Reference a -> Reference a -> Bool
$c<= :: forall a. Ord a => Reference a -> Reference a -> Bool
< :: Reference a -> Reference a -> Bool
$c< :: forall a. Ord a => Reference a -> Reference a -> Bool
compare :: Reference a -> Reference a -> Ordering
$ccompare :: forall a. Ord a => Reference a -> Reference a -> Ordering
Ord, ReadPrec [Reference a]
ReadPrec (Reference a)
ReadS [Reference a]
forall a. Read a => ReadPrec [Reference a]
forall a. Read a => ReadPrec (Reference a)
forall a. Read a => Int -> ReadS (Reference a)
forall a. Read a => ReadS [Reference a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Reference a]
$creadListPrec :: forall a. Read a => ReadPrec [Reference a]
readPrec :: ReadPrec (Reference a)
$creadPrec :: forall a. Read a => ReadPrec (Reference a)
readList :: ReadS [Reference a]
$creadList :: forall a. Read a => ReadS [Reference a]
readsPrec :: Int -> ReadS (Reference a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Reference a)
Read, Int -> Reference a -> ShowS
forall a. Show a => Int -> Reference a -> ShowS
forall a. Show a => [Reference a] -> ShowS
forall a. Show a => Reference a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Reference a] -> ShowS
$cshowList :: forall a. Show a => [Reference a] -> ShowS
show :: Reference a -> String
$cshow :: forall a. Show a => Reference a -> String
showsPrec :: Int -> Reference a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Reference a -> ShowS
Show)

_Reference :: Name
_Reference = (String -> Name
Core.Name String
"hydra/ext/shacl/model.Reference")

_Reference_named :: FieldName
_Reference_named = (String -> FieldName
Core.FieldName String
"named")

_Reference_anonymous :: FieldName
_Reference_anonymous = (String -> FieldName
Core.FieldName String
"anonymous")

_Reference_definition :: FieldName
_Reference_definition = (String -> FieldName
Core.FieldName String
"definition")

data Severity = 
  -- | A non-critical constraint violation indicating an informative message
  SeverityInfo  |
  -- | A non-critical constraint violation indicating a warning
  SeverityWarning  |
  -- | A constraint violation
  SeverityViolation 
  deriving (Severity -> Severity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Severity -> Severity -> Bool
$c/= :: Severity -> Severity -> Bool
== :: Severity -> Severity -> Bool
$c== :: Severity -> Severity -> Bool
Eq, Eq Severity
Severity -> Severity -> Bool
Severity -> Severity -> Ordering
Severity -> Severity -> Severity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Severity -> Severity -> Severity
$cmin :: Severity -> Severity -> Severity
max :: Severity -> Severity -> Severity
$cmax :: Severity -> Severity -> Severity
>= :: Severity -> Severity -> Bool
$c>= :: Severity -> Severity -> Bool
> :: Severity -> Severity -> Bool
$c> :: Severity -> Severity -> Bool
<= :: Severity -> Severity -> Bool
$c<= :: Severity -> Severity -> Bool
< :: Severity -> Severity -> Bool
$c< :: Severity -> Severity -> Bool
compare :: Severity -> Severity -> Ordering
$ccompare :: Severity -> Severity -> Ordering
Ord, ReadPrec [Severity]
ReadPrec Severity
Int -> ReadS Severity
ReadS [Severity]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Severity]
$creadListPrec :: ReadPrec [Severity]
readPrec :: ReadPrec Severity
$creadPrec :: ReadPrec Severity
readList :: ReadS [Severity]
$creadList :: ReadS [Severity]
readsPrec :: Int -> ReadS Severity
$creadsPrec :: Int -> ReadS Severity
Read, Int -> Severity -> ShowS
[Severity] -> ShowS
Severity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Severity] -> ShowS
$cshowList :: [Severity] -> ShowS
show :: Severity -> String
$cshow :: Severity -> String
showsPrec :: Int -> Severity -> ShowS
$cshowsPrec :: Int -> Severity -> ShowS
Show)

_Severity :: Name
_Severity = (String -> Name
Core.Name String
"hydra/ext/shacl/model.Severity")

_Severity_info :: FieldName
_Severity_info = (String -> FieldName
Core.FieldName String
"info")

_Severity_warning :: FieldName
_Severity_warning = (String -> FieldName
Core.FieldName String
"warning")

_Severity_violation :: FieldName
_Severity_violation = (String -> FieldName
Core.FieldName String
"violation")

-- | A SHACL node or property shape. See https://www.w3.org/TR/shacl/#shapes
data Shape = 
  ShapeNode NodeShape |
  ShapeProperty PropertyShape
  deriving (Shape -> Shape -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Shape -> Shape -> Bool
$c/= :: Shape -> Shape -> Bool
== :: Shape -> Shape -> Bool
$c== :: Shape -> Shape -> Bool
Eq, Eq Shape
Shape -> Shape -> Bool
Shape -> Shape -> Ordering
Shape -> Shape -> Shape
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Shape -> Shape -> Shape
$cmin :: Shape -> Shape -> Shape
max :: Shape -> Shape -> Shape
$cmax :: Shape -> Shape -> Shape
>= :: Shape -> Shape -> Bool
$c>= :: Shape -> Shape -> Bool
> :: Shape -> Shape -> Bool
$c> :: Shape -> Shape -> Bool
<= :: Shape -> Shape -> Bool
$c<= :: Shape -> Shape -> Bool
< :: Shape -> Shape -> Bool
$c< :: Shape -> Shape -> Bool
compare :: Shape -> Shape -> Ordering
$ccompare :: Shape -> Shape -> Ordering
Ord, ReadPrec [Shape]
ReadPrec Shape
Int -> ReadS Shape
ReadS [Shape]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Shape]
$creadListPrec :: ReadPrec [Shape]
readPrec :: ReadPrec Shape
$creadPrec :: ReadPrec Shape
readList :: ReadS [Shape]
$creadList :: ReadS [Shape]
readsPrec :: Int -> ReadS Shape
$creadsPrec :: Int -> ReadS Shape
Read, Int -> Shape -> ShowS
[Shape] -> ShowS
Shape -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Shape] -> ShowS
$cshowList :: [Shape] -> ShowS
show :: Shape -> String
$cshow :: Shape -> String
showsPrec :: Int -> Shape -> ShowS
$cshowsPrec :: Int -> Shape -> ShowS
Show)

_Shape :: Name
_Shape = (String -> Name
Core.Name String
"hydra/ext/shacl/model.Shape")

_Shape_node :: FieldName
_Shape_node = (String -> FieldName
Core.FieldName String
"node")

_Shape_property :: FieldName
_Shape_property = (String -> FieldName
Core.FieldName String
"property")

-- | An RDF graph containing zero or more shapes that is passed into a SHACL validation process so that a data graph can be validated against the shapes
newtype ShapesGraph = 
  ShapesGraph {
    -- | An RDF graph containing zero or more shapes that is passed into a SHACL validation process so that a data graph can be validated against the shapes
    ShapesGraph -> Set (Definition Shape)
unShapesGraph :: (Set (Definition Shape))}
  deriving (ShapesGraph -> ShapesGraph -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShapesGraph -> ShapesGraph -> Bool
$c/= :: ShapesGraph -> ShapesGraph -> Bool
== :: ShapesGraph -> ShapesGraph -> Bool
$c== :: ShapesGraph -> ShapesGraph -> Bool
Eq, Eq ShapesGraph
ShapesGraph -> ShapesGraph -> Bool
ShapesGraph -> ShapesGraph -> Ordering
ShapesGraph -> ShapesGraph -> ShapesGraph
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ShapesGraph -> ShapesGraph -> ShapesGraph
$cmin :: ShapesGraph -> ShapesGraph -> ShapesGraph
max :: ShapesGraph -> ShapesGraph -> ShapesGraph
$cmax :: ShapesGraph -> ShapesGraph -> ShapesGraph
>= :: ShapesGraph -> ShapesGraph -> Bool
$c>= :: ShapesGraph -> ShapesGraph -> Bool
> :: ShapesGraph -> ShapesGraph -> Bool
$c> :: ShapesGraph -> ShapesGraph -> Bool
<= :: ShapesGraph -> ShapesGraph -> Bool
$c<= :: ShapesGraph -> ShapesGraph -> Bool
< :: ShapesGraph -> ShapesGraph -> Bool
$c< :: ShapesGraph -> ShapesGraph -> Bool
compare :: ShapesGraph -> ShapesGraph -> Ordering
$ccompare :: ShapesGraph -> ShapesGraph -> Ordering
Ord, ReadPrec [ShapesGraph]
ReadPrec ShapesGraph
Int -> ReadS ShapesGraph
ReadS [ShapesGraph]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ShapesGraph]
$creadListPrec :: ReadPrec [ShapesGraph]
readPrec :: ReadPrec ShapesGraph
$creadPrec :: ReadPrec ShapesGraph
readList :: ReadS [ShapesGraph]
$creadList :: ReadS [ShapesGraph]
readsPrec :: Int -> ReadS ShapesGraph
$creadsPrec :: Int -> ReadS ShapesGraph
Read, Int -> ShapesGraph -> ShowS
[ShapesGraph] -> ShowS
ShapesGraph -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShapesGraph] -> ShowS
$cshowList :: [ShapesGraph] -> ShowS
show :: ShapesGraph -> String
$cshow :: ShapesGraph -> String
showsPrec :: Int -> ShapesGraph -> ShowS
$cshowsPrec :: Int -> ShapesGraph -> ShowS
Show)

_ShapesGraph :: Name
_ShapesGraph = (String -> Name
Core.Name String
"hydra/ext/shacl/model.ShapesGraph")