module Hydra.Langs.Shacl.Coder where

import Hydra.Kernel
import Hydra.Langs.Rdf.Utils
import qualified Hydra.Langs.Rdf.Syntax as Rdf
import qualified Hydra.Langs.Shacl.Model as Shacl
import qualified Hydra.Dsl.Literals as Literals
import qualified Hydra.Dsl.Expect as Expect
import qualified Hydra.Dsl.Terms as Terms

import qualified Control.Monad as CM
import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Maybe as Y


shaclCoder :: Module -> Flow (Graph) (Shacl.ShapesGraph, Graph -> Flow (Graph) Rdf.Graph)
shaclCoder :: Module -> Flow Graph (ShapesGraph, Graph -> Flow Graph Graph)
shaclCoder Module
mod = do
    Graph
g <- Flow Graph Graph
forall s. Flow s s
getState
    -- Note: untested since deprecation of element schemas
    [Element]
typeEls <- (Element -> Flow Graph Bool) -> [Element] -> Flow Graph [Element]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
CM.filterM (Graph -> Element -> Flow Graph Bool
forall {p}. p -> Element -> Flow Graph Bool
isType Graph
g) ([Element] -> Flow Graph [Element])
-> [Element] -> Flow Graph [Element]
forall a b. (a -> b) -> a -> b
$ Module -> [Element]
moduleElements Module
mod
    [Definition Shape]
shapes <- (Element -> Flow Graph (Definition Shape))
-> [Element] -> Flow Graph [Definition Shape]
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]
CM.mapM Element -> Flow Graph (Definition Shape)
toShape [Element]
typeEls
    let sg :: ShapesGraph
sg = Set (Definition Shape) -> ShapesGraph
Shacl.ShapesGraph (Set (Definition Shape) -> ShapesGraph)
-> Set (Definition Shape) -> ShapesGraph
forall a b. (a -> b) -> a -> b
$ [Definition Shape] -> Set (Definition Shape)
forall a. Ord a => [a] -> Set a
S.fromList [Definition Shape]
shapes
    let termFlow :: p -> Flow Graph a
termFlow = \p
g -> do
          String -> Flow Graph a
forall a. String -> Flow Graph a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not implemented"
    (ShapesGraph, Graph -> Flow Graph Graph)
-> Flow Graph (ShapesGraph, Graph -> Flow Graph Graph)
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (ShapesGraph
sg, Graph -> Flow Graph Graph
forall {p} {a}. p -> Flow Graph a
termFlow)
  where
    isType :: p -> Element -> Flow Graph Bool
isType p
g Element
el = do
      Type
typ <- Term -> Flow Graph Type
requireTermType (Term -> Flow Graph Type) -> Term -> Flow Graph Type
forall a b. (a -> b) -> a -> b
$ Element -> Term
elementData Element
el
      Bool -> Flow Graph Bool
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Flow Graph Bool) -> Bool -> Flow Graph Bool
forall a b. (a -> b) -> a -> b
$ Type -> Type
stripType Type
typ Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> Type
TypeVariable Name
_Type
    toShape :: Element -> Flow Graph (Definition Shape)
toShape Element
el = do
      Type
typ <- Term -> Flow Graph Type
coreDecodeType (Term -> Flow Graph Type) -> Term -> Flow Graph Type
forall a b. (a -> b) -> a -> b
$ Element -> Term
elementData Element
el
      CommonProperties
common <- Type -> Flow Graph CommonProperties
encodeType Type
typ
      Definition Shape -> Flow Graph (Definition Shape)
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Definition Shape -> Flow Graph (Definition Shape))
-> Definition Shape -> Flow Graph (Definition Shape)
forall a b. (a -> b) -> a -> b
$ Iri -> Shape -> Definition Shape
forall a. Iri -> a -> Definition a
Shacl.Definition (Element -> Iri
elementIri Element
el) (Shape -> Definition Shape) -> Shape -> Definition Shape
forall a b. (a -> b) -> a -> b
$ NodeShape -> Shape
Shacl.ShapeNode (NodeShape -> Shape) -> NodeShape -> Shape
forall a b. (a -> b) -> a -> b
$ CommonProperties -> NodeShape
Shacl.NodeShape CommonProperties
common

common :: [Shacl.CommonConstraint] -> Shacl.CommonProperties
common :: [CommonConstraint] -> CommonProperties
common [CommonConstraint]
constraints = CommonProperties
defaultCommonProperties {
  Shacl.commonPropertiesConstraints = S.fromList constraints}

defaultCommonProperties :: Shacl.CommonProperties
defaultCommonProperties :: CommonProperties
defaultCommonProperties = Shacl.CommonProperties {
  commonPropertiesConstraints :: Set CommonConstraint
Shacl.commonPropertiesConstraints = Set CommonConstraint
forall a. Set a
S.empty,
  commonPropertiesDeactivated :: Maybe Bool
Shacl.commonPropertiesDeactivated = Maybe Bool
forall a. Maybe a
Nothing,
  commonPropertiesMessage :: LangStrings
Shacl.commonPropertiesMessage = LangStrings
emptyLangStrings,
  commonPropertiesSeverity :: Severity
Shacl.commonPropertiesSeverity = Severity
Shacl.SeverityInfo,
  commonPropertiesTargetClass :: Set RdfsClass
Shacl.commonPropertiesTargetClass = Set RdfsClass
forall a. Set a
S.empty,
  commonPropertiesTargetNode :: Set IriOrLiteral
Shacl.commonPropertiesTargetNode = Set IriOrLiteral
forall a. Set a
S.empty,
  commonPropertiesTargetObjectsOf :: Set Property
Shacl.commonPropertiesTargetObjectsOf = Set Property
forall a. Set a
S.empty,
  commonPropertiesTargetSubjectsOf :: Set Property
Shacl.commonPropertiesTargetSubjectsOf = Set Property
forall a. Set a
S.empty}

elementIri :: Element -> Rdf.Iri
elementIri :: Element -> Iri
elementIri = Name -> Iri
nameToIri (Name -> Iri) -> (Element -> Name) -> Element -> Iri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Name
elementName

encodeField :: Name -> Rdf.Resource -> Field -> Flow (Graph) [Rdf.Triple]
encodeField :: Name -> Resource -> Field -> Flow Graph [Triple]
encodeField Name
rname Resource
subject Field
field = do
  Resource
node <- Flow Graph Resource
nextBlankNode
  [Description]
descs <- Resource -> Term -> Flow Graph [Description]
encodeTerm Resource
node (Field -> Term
fieldTerm Field
field)
  [Triple] -> Flow Graph [Triple]
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Triple] -> Flow Graph [Triple])
-> [Triple] -> Flow Graph [Triple]
forall a b. (a -> b) -> a -> b
$ [Description] -> [Triple]
triplesOf [Description]
descs [Triple] -> [Triple] -> [Triple]
forall a. [a] -> [a] -> [a]
++
    Resource -> Iri -> [Node] -> [Triple]
forObjects Resource
subject (Name -> Name -> Iri
propertyIri Name
rname (Name -> Iri) -> Name -> Iri
forall a b. (a -> b) -> a -> b
$ Field -> Name
fieldName Field
field) ([Description] -> [Node]
subjectsOf [Description]
descs)

encodeFieldType :: Name -> Maybe Integer -> FieldType -> Flow (Graph) (Shacl.Definition Shacl.PropertyShape)
encodeFieldType :: Name
-> Maybe Integer
-> FieldType
-> Flow Graph (Definition PropertyShape)
encodeFieldType Name
rname Maybe Integer
order (FieldType Name
fname Type
ft) = do
    PropertyShape
shape <- Maybe Integer -> Maybe Integer -> Type -> Flow Graph PropertyShape
forType (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
1) (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
1) Type
ft
    Definition PropertyShape -> Flow Graph (Definition PropertyShape)
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Definition PropertyShape -> Flow Graph (Definition PropertyShape))
-> Definition PropertyShape
-> Flow Graph (Definition PropertyShape)
forall a b. (a -> b) -> a -> b
$ Iri -> PropertyShape -> Definition PropertyShape
forall a. Iri -> a -> Definition a
Shacl.Definition Iri
iri PropertyShape
shape
  where
    iri :: Iri
iri = Name -> Name -> Iri
propertyIri Name
rname Name
fname
    forType :: Maybe Integer -> Maybe Integer -> Type -> Flow Graph PropertyShape
forType Maybe Integer
mn Maybe Integer
mx Type
t = case Type -> Type
stripType Type
t of
      TypeOptional Type
ot -> Maybe Integer -> Maybe Integer -> Type -> Flow Graph PropertyShape
forType (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
0) Maybe Integer
mx Type
ot
      TypeSet Type
st -> Maybe Integer -> Maybe Integer -> Type -> Flow Graph PropertyShape
forType Maybe Integer
mn Maybe Integer
forall a. Maybe a
Nothing Type
st
      Type
_ -> do
        CommonProperties
cp <- Type -> Flow Graph CommonProperties
encodeType Type
t
        let baseProp :: PropertyShape
baseProp = Iri -> PropertyShape
property Iri
iri
        PropertyShape -> Flow Graph PropertyShape
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (PropertyShape -> Flow Graph PropertyShape)
-> PropertyShape -> Flow Graph PropertyShape
forall a b. (a -> b) -> a -> b
$ PropertyShape
baseProp {
          Shacl.propertyShapeCommon = cp,
          Shacl.propertyShapeConstraints = S.fromList $ Y.catMaybes [
            Shacl.PropertyShapeConstraintMinCount <$> mn,
            Shacl.PropertyShapeConstraintMaxCount <$> mx],
          Shacl.propertyShapeOrder = order}

encodeLiteralType :: LiteralType -> Shacl.CommonProperties
encodeLiteralType :: LiteralType -> CommonProperties
encodeLiteralType LiteralType
lt = case LiteralType
lt of
    LiteralType
LiteralTypeBinary -> String -> CommonProperties
xsd String
"base64Binary"
    LiteralType
LiteralTypeBoolean -> String -> CommonProperties
xsd String
"boolean"
    LiteralTypeFloat FloatType
ft -> case FloatType
ft of
      FloatType
FloatTypeBigfloat -> String -> CommonProperties
xsd String
"decimal"
      FloatType
FloatTypeFloat32 -> String -> CommonProperties
xsd String
"float"
      FloatType
FloatTypeFloat64 -> String -> CommonProperties
xsd String
"double"
    LiteralTypeInteger IntegerType
it -> case IntegerType
it of
      IntegerType
IntegerTypeBigint -> String -> CommonProperties
xsd String
"integer"
      IntegerType
IntegerTypeInt8 -> String -> CommonProperties
xsd String
"byte"
      IntegerType
IntegerTypeInt16 -> String -> CommonProperties
xsd String
"short"
      IntegerType
IntegerTypeInt32 -> String -> CommonProperties
xsd String
"int"
      IntegerType
IntegerTypeInt64 -> String -> CommonProperties
xsd String
"long"
      IntegerType
IntegerTypeUint8 -> String -> CommonProperties
xsd String
"unsignedByte"
      IntegerType
IntegerTypeUint16 -> String -> CommonProperties
xsd String
"unsignedShort"
      IntegerType
IntegerTypeUint32 -> String -> CommonProperties
xsd String
"unsignedInt"
      IntegerType
IntegerTypeUint64 -> String -> CommonProperties
xsd String
"unsignedLong"
    LiteralType
LiteralTypeString -> String -> CommonProperties
xsd String
"string"
  where
    xsd :: String -> CommonProperties
xsd String
local = [CommonConstraint] -> CommonProperties
common [Iri -> CommonConstraint
Shacl.CommonConstraintDatatype (Iri -> CommonConstraint) -> Iri -> CommonConstraint
forall a b. (a -> b) -> a -> b
$ String -> Iri
xmlSchemaDatatypeIri String
local]

encodeTerm :: Rdf.Resource -> Term -> Flow (Graph) [Rdf.Description]
encodeTerm :: Resource -> Term -> Flow Graph [Description]
encodeTerm Resource
subject Term
term = case Term
term of
  TermAnnotated (AnnotatedTerm Term
inner Map String Term
ann) -> Resource -> Term -> Flow Graph [Description]
encodeTerm Resource
subject Term
inner -- TODO: extract an rdfs:comment
  TermList [Term]
terms -> Resource -> [Term] -> Flow Graph [Description]
encodeList Resource
subject [Term]
terms
    where
      encodeList :: Resource -> [Term] -> Flow Graph [Description]
encodeList Resource
subj [Term]
terms = if [Term] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [Term]
terms
        then [Description] -> Flow Graph [Description]
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Node -> Description
emptyDescription (Node -> Description) -> Node -> Description
forall a b. (a -> b) -> a -> b
$ (Iri -> Node
Rdf.NodeIri (Iri -> Node) -> Iri -> Node
forall a b. (a -> b) -> a -> b
$ String -> Iri
rdfIri String
"nil")]
          else do
            Resource
node <- Flow Graph Resource
nextBlankNode
            [Description]
fdescs <- Resource -> Term -> Flow Graph [Description]
encodeTerm Resource
node (Term -> Flow Graph [Description])
-> Term -> Flow Graph [Description]
forall a b. (a -> b) -> a -> b
$ [Term] -> Term
forall a. HasCallStack => [a] -> a
L.head [Term]
terms
            let firstTriples :: [Triple]
firstTriples = [Description] -> [Triple]
triplesOf [Description]
fdescs [Triple] -> [Triple] -> [Triple]
forall a. [a] -> [a] -> [a]
++
                  Resource -> Iri -> [Node] -> [Triple]
forObjects Resource
subj (String -> Iri
rdfIri String
"first") ([Description] -> [Node]
subjectsOf [Description]
fdescs)
            Resource
next <- Flow Graph Resource
nextBlankNode
            [Description]
rdescs <- Resource -> [Term] -> Flow Graph [Description]
encodeList Resource
next ([Term] -> Flow Graph [Description])
-> [Term] -> Flow Graph [Description]
forall a b. (a -> b) -> a -> b
$ [Term] -> [Term]
forall a. HasCallStack => [a] -> [a]
L.tail [Term]
terms
            let restTriples :: [Triple]
restTriples = [Description] -> [Triple]
triplesOf [Description]
rdescs [Triple] -> [Triple] -> [Triple]
forall a. [a] -> [a] -> [a]
++
                  Resource -> Iri -> [Node] -> [Triple]
forObjects Resource
subj (String -> Iri
rdfIri String
"rest") ([Description] -> [Node]
subjectsOf [Description]
rdescs)
            [Description] -> Flow Graph [Description]
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return [Node -> Graph -> Description
Rdf.Description (Resource -> Node
resourceToNode Resource
subj) (Set Triple -> Graph
Rdf.Graph (Set Triple -> Graph) -> Set Triple -> Graph
forall a b. (a -> b) -> a -> b
$ [Triple] -> Set Triple
forall a. Ord a => [a] -> Set a
S.fromList ([Triple] -> Set Triple) -> [Triple] -> Set Triple
forall a b. (a -> b) -> a -> b
$ [Triple]
firstTriples [Triple] -> [Triple] -> [Triple]
forall a. [a] -> [a] -> [a]
++ [Triple]
restTriples)]
  TermLiteral Literal
lit -> do
    Node
node <- Literal -> Node
Rdf.NodeLiteral (Literal -> Node) -> Flow Graph Literal -> Flow Graph Node
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Literal -> Flow Graph Literal
encodeLiteral Literal
lit
    [Description] -> Flow Graph [Description]
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return [Node -> Description
emptyDescription Node
node]
  TermMap Map Term Term
m -> do
      [Triple]
triples <- [[Triple]] -> [Triple]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
L.concat ([[Triple]] -> [Triple])
-> Flow Graph [[Triple]] -> Flow Graph [Triple]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (((Term, Term) -> Flow Graph [Triple])
-> [(Term, Term)] -> Flow Graph [[Triple]]
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]
CM.mapM (Resource -> (Term, Term) -> Flow Graph [Triple]
forKeyVal Resource
subject) ([(Term, Term)] -> Flow Graph [[Triple]])
-> [(Term, Term)] -> Flow Graph [[Triple]]
forall a b. (a -> b) -> a -> b
$ Map Term Term -> [(Term, Term)]
forall k a. Map k a -> [(k, a)]
M.toList Map Term Term
m)
      [Description] -> Flow Graph [Description]
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return [Node -> Graph -> Description
Rdf.Description (Resource -> Node
resourceToNode Resource
subject) (Graph -> Description) -> Graph -> Description
forall a b. (a -> b) -> a -> b
$ Set Triple -> Graph
Rdf.Graph (Set Triple -> Graph) -> Set Triple -> Graph
forall a b. (a -> b) -> a -> b
$ [Triple] -> Set Triple
forall a. Ord a => [a] -> Set a
S.fromList [Triple]
triples]
    where
      forKeyVal :: Resource -> (Term, Term) -> Flow Graph [Triple]
forKeyVal Resource
subj (Term
k, Term
v) = do
        -- Note: only string-valued keys are supported
        String
ks <- Term -> Flow Graph String
forall s. Term -> Flow s String
Expect.string (Term -> Flow Graph String) -> Term -> Flow Graph String
forall a b. (a -> b) -> a -> b
$ Term -> Term
stripTerm Term
k
        Resource
node <- Flow Graph Resource
nextBlankNode
        [Description]
descs <- Resource -> Term -> Flow Graph [Description]
encodeTerm Resource
node Term
v
        let pred :: Iri
pred = String -> Iri
keyIri String
ks
        let objs :: [Node]
objs = [Description] -> [Node]
subjectsOf [Description]
descs
        let triples :: [Triple]
triples = Resource -> Iri -> [Node] -> [Triple]
forObjects Resource
subj Iri
pred [Node]
objs
        [Triple] -> Flow Graph [Triple]
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Triple] -> Flow Graph [Triple])
-> [Triple] -> Flow Graph [Triple]
forall a b. (a -> b) -> a -> b
$ [Triple]
triples [Triple] -> [Triple] -> [Triple]
forall a. [a] -> [a] -> [a]
++ [Description] -> [Triple]
triplesOf [Description]
descs
  TermWrap (WrappedTerm Name
name Term
inner) -> do
    [Description]
descs <- Resource -> Term -> Flow Graph [Description]
encodeTerm Resource
subject Term
inner
    [Description] -> Flow Graph [Description]
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Description] -> Flow Graph [Description])
-> [Description] -> Flow Graph [Description]
forall a b. (a -> b) -> a -> b
$ (Name -> Description -> Description
withType Name
name (Description -> Description) -> Description -> Description
forall a b. (a -> b) -> a -> b
$ [Description] -> Description
forall a. HasCallStack => [a] -> a
L.head [Description]
descs)Description -> [Description] -> [Description]
forall a. a -> [a] -> [a]
:([Description] -> [Description]
forall a. HasCallStack => [a] -> [a]
L.tail [Description]
descs)
  TermOptional Maybe Term
mterm -> case Maybe Term
mterm of
    Maybe Term
Nothing -> [Description] -> Flow Graph [Description]
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    Just Term
inner -> Resource -> Term -> Flow Graph [Description]
encodeTerm Resource
subject Term
inner
  TermRecord (Record Name
rname [Field]
fields) -> do
    [[Triple]]
tripless <- (Field -> Flow Graph [Triple]) -> [Field] -> Flow Graph [[Triple]]
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]
CM.mapM (Name -> Resource -> Field -> Flow Graph [Triple]
encodeField Name
rname Resource
subject) [Field]
fields
    [Description] -> Flow Graph [Description]
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return [Name -> Description -> Description
withType Name
rname (Description -> Description) -> Description -> Description
forall a b. (a -> b) -> a -> b
$ Node -> Graph -> Description
Rdf.Description (Resource -> Node
resourceToNode Resource
subject) (Set Triple -> Graph
Rdf.Graph (Set Triple -> Graph) -> Set Triple -> Graph
forall a b. (a -> b) -> a -> b
$ [Triple] -> Set Triple
forall a. Ord a => [a] -> Set a
S.fromList ([Triple] -> Set Triple) -> [Triple] -> Set Triple
forall a b. (a -> b) -> a -> b
$ [[Triple]] -> [Triple]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
L.concat [[Triple]]
tripless)]
  TermSet Set Term
terms -> [[Description]] -> [Description]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
L.concat ([[Description]] -> [Description])
-> Flow Graph [[Description]] -> Flow Graph [Description]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Term -> Flow Graph [Description])
-> [Term] -> Flow Graph [[Description]]
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]
CM.mapM Term -> Flow Graph [Description]
encodeEl (Set Term -> [Term]
forall a. Set a -> [a]
S.toList Set Term
terms)
    where
      encodeEl :: Term -> Flow Graph [Description]
encodeEl Term
term = do
        Resource
node <- Flow Graph Resource
nextBlankNode
        Resource -> Term -> Flow Graph [Description]
encodeTerm Resource
node Term
term
  TermUnion (Injection Name
rname Field
field) -> do
    [Triple]
triples <- Name -> Resource -> Field -> Flow Graph [Triple]
encodeField Name
rname Resource
subject Field
field
    [Description] -> Flow Graph [Description]
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return [Name -> Description -> Description
withType Name
rname (Description -> Description) -> Description -> Description
forall a b. (a -> b) -> a -> b
$ Node -> Graph -> Description
Rdf.Description (Resource -> Node
resourceToNode Resource
subject) (Set Triple -> Graph
Rdf.Graph (Set Triple -> Graph) -> Set Triple -> Graph
forall a b. (a -> b) -> a -> b
$ [Triple] -> Set Triple
forall a. Ord a => [a] -> Set a
S.fromList [Triple]
triples)]
  Term
_ -> String -> String -> Flow Graph [Description]
forall s x. String -> String -> Flow s x
unexpected String
"RDF-compatible term" (String -> Flow Graph [Description])
-> String -> Flow Graph [Description]
forall a b. (a -> b) -> a -> b
$ Term -> String
forall a. Show a => a -> String
show Term
term

encodeType :: Type -> Flow (Graph) Shacl.CommonProperties
encodeType :: Type -> Flow Graph CommonProperties
encodeType Type
typ = case Type -> Type
stripType Type
typ of
    TypeList Type
_ -> Flow Graph CommonProperties
any
    TypeLiteral LiteralType
lt -> CommonProperties -> Flow Graph CommonProperties
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CommonProperties -> Flow Graph CommonProperties)
-> CommonProperties -> Flow Graph CommonProperties
forall a b. (a -> b) -> a -> b
$ LiteralType -> CommonProperties
encodeLiteralType LiteralType
lt
    TypeMap MapType
_ -> Flow Graph CommonProperties
any
    TypeWrap WrappedType
name -> Flow Graph CommonProperties
any -- TODO: include name
    TypeRecord (RowType Name
rname Maybe Name
_ [FieldType]
fields) -> do
      [Definition PropertyShape]
props <- (Maybe Integer
 -> FieldType -> Flow Graph (Definition PropertyShape))
-> [Maybe Integer]
-> [FieldType]
-> Flow Graph [Definition PropertyShape]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
CM.zipWithM (Name
-> Maybe Integer
-> FieldType
-> Flow Graph (Definition PropertyShape)
encodeFieldType Name
rname) (Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer) -> [Integer] -> [Maybe Integer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Integer
0..]) [FieldType]
fields
      CommonProperties -> Flow Graph CommonProperties
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (CommonProperties -> Flow Graph CommonProperties)
-> CommonProperties -> Flow Graph CommonProperties
forall a b. (a -> b) -> a -> b
$ [CommonConstraint] -> CommonProperties
common [Set (Reference PropertyShape) -> CommonConstraint
Shacl.CommonConstraintProperty (Set (Reference PropertyShape) -> CommonConstraint)
-> Set (Reference PropertyShape) -> CommonConstraint
forall a b. (a -> b) -> a -> b
$ [Reference PropertyShape] -> Set (Reference PropertyShape)
forall a. Ord a => [a] -> Set a
S.fromList (Definition PropertyShape -> Reference PropertyShape
forall a. Definition a -> Reference a
Shacl.ReferenceDefinition (Definition PropertyShape -> Reference PropertyShape)
-> [Definition PropertyShape] -> [Reference PropertyShape]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Definition PropertyShape]
props)]
    TypeSet Type
_ -> Flow Graph CommonProperties
any
    TypeUnion (RowType Name
rname Maybe Name
_ [FieldType]
fields) -> do
        [Definition PropertyShape]
props <- (FieldType -> Flow Graph (Definition PropertyShape))
-> [FieldType] -> Flow Graph [Definition PropertyShape]
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]
CM.mapM (Name
-> Maybe Integer
-> FieldType
-> Flow Graph (Definition PropertyShape)
encodeFieldType Name
rname Maybe Integer
forall a. Maybe a
Nothing) [FieldType]
fields
        let shapes :: [Reference Shape]
shapes = (Shape -> Reference Shape
forall a. a -> Reference a
Shacl.ReferenceAnonymous (Shape -> Reference Shape)
-> (Definition PropertyShape -> Shape)
-> Definition PropertyShape
-> Reference Shape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Definition PropertyShape -> Shape
toShape) (Definition PropertyShape -> Reference Shape)
-> [Definition PropertyShape] -> [Reference Shape]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Definition PropertyShape]
props
        CommonProperties -> Flow Graph CommonProperties
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (CommonProperties -> Flow Graph CommonProperties)
-> CommonProperties -> Flow Graph CommonProperties
forall a b. (a -> b) -> a -> b
$ [CommonConstraint] -> CommonProperties
common [Set (Reference Shape) -> CommonConstraint
Shacl.CommonConstraintXone (Set (Reference Shape) -> CommonConstraint)
-> Set (Reference Shape) -> CommonConstraint
forall a b. (a -> b) -> a -> b
$ [Reference Shape] -> Set (Reference Shape)
forall a. Ord a => [a] -> Set a
S.fromList [Reference Shape]
shapes]
      where
        toShape :: Definition PropertyShape -> Shape
toShape Definition PropertyShape
prop = [CommonConstraint] -> Shape
node [Set (Reference PropertyShape) -> CommonConstraint
Shacl.CommonConstraintProperty (Set (Reference PropertyShape) -> CommonConstraint)
-> Set (Reference PropertyShape) -> CommonConstraint
forall a b. (a -> b) -> a -> b
$ [Reference PropertyShape] -> Set (Reference PropertyShape)
forall a. Ord a => [a] -> Set a
S.fromList [Definition PropertyShape -> Reference PropertyShape
forall a. Definition a -> Reference a
Shacl.ReferenceDefinition Definition PropertyShape
prop]]
    Type
_ -> String -> String -> Flow Graph CommonProperties
forall s x. String -> String -> Flow s x
unexpected String
"type" (String -> Flow Graph CommonProperties)
-> String -> Flow Graph CommonProperties
forall a b. (a -> b) -> a -> b
$ Type -> String
forall a. Show a => a -> String
show Type
typ
  where
    -- SHACL's built-in vocabulary is less expressive than Hydra's type system, so for now, SHACL validation simply ends
    -- when inexpressible types are encountered. However, certain constructs such as lists can be validated using
    -- secondary structures. For example, see shsh:ListShape in the SHACL documentation. TODO: explore these constructions.
    any :: Flow Graph CommonProperties
any = CommonProperties -> Flow Graph CommonProperties
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CommonProperties -> Flow Graph CommonProperties)
-> CommonProperties -> Flow Graph CommonProperties
forall a b. (a -> b) -> a -> b
$ [CommonConstraint] -> CommonProperties
common []

node :: [Shacl.CommonConstraint] -> Shacl.Shape
node :: [CommonConstraint] -> Shape
node = NodeShape -> Shape
Shacl.ShapeNode (NodeShape -> Shape)
-> ([CommonConstraint] -> NodeShape) -> [CommonConstraint] -> Shape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommonProperties -> NodeShape
Shacl.NodeShape (CommonProperties -> NodeShape)
-> ([CommonConstraint] -> CommonProperties)
-> [CommonConstraint]
-> NodeShape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CommonConstraint] -> CommonProperties
common

property :: Rdf.Iri -> Shacl.PropertyShape
property :: Iri -> PropertyShape
property Iri
iri = Shacl.PropertyShape {
  propertyShapeCommon :: CommonProperties
Shacl.propertyShapeCommon = CommonProperties
defaultCommonProperties,
  propertyShapeConstraints :: Set PropertyShapeConstraint
Shacl.propertyShapeConstraints = Set PropertyShapeConstraint
forall a. Set a
S.empty,
  propertyShapeDefaultValue :: Maybe Node
Shacl.propertyShapeDefaultValue = Maybe Node
forall a. Maybe a
Nothing,
  propertyShapeDescription :: LangStrings
Shacl.propertyShapeDescription = LangStrings
emptyLangStrings,
  propertyShapeName :: LangStrings
Shacl.propertyShapeName = LangStrings
emptyLangStrings,
  propertyShapeOrder :: Maybe Integer
Shacl.propertyShapeOrder = Maybe Integer
forall a. Maybe a
Nothing,
  propertyShapePath :: Iri
Shacl.propertyShapePath = Iri
iri}

withType :: Name -> Rdf.Description -> Rdf.Description
withType :: Name -> Description -> Description
withType Name
name (Rdf.Description Node
subj (Rdf.Graph Set Triple
triples)) = Node -> Graph -> Description
Rdf.Description Node
subj (Set Triple -> Graph
Rdf.Graph (Set Triple -> Graph) -> Set Triple -> Graph
forall a b. (a -> b) -> a -> b
$ Triple -> Set Triple -> Set Triple
forall a. Ord a => a -> Set a -> Set a
S.insert Triple
triple Set Triple
triples)
  where
    subjRes :: Resource
subjRes = case Node
subj of
      Rdf.NodeIri Iri
iri -> Iri -> Resource
Rdf.ResourceIri Iri
iri
      Rdf.NodeBnode BlankNode
bnode -> BlankNode -> Resource
Rdf.ResourceBnode BlankNode
bnode
    triple :: Triple
triple = Resource -> Iri -> Node -> Triple
Rdf.Triple Resource
subjRes (String -> Iri
rdfIri String
"type") (Iri -> Node
Rdf.NodeIri (Iri -> Node) -> Iri -> Node
forall a b. (a -> b) -> a -> b
$ Name -> Iri
nameToIri Name
name)