module Hydra.Ext.Shacl.Coder where

import Hydra.All
import Hydra.CoreDecoding
import Hydra.Util.Context
import qualified Hydra.Ext.Rdf.Syntax as Rdf
import qualified Hydra.Ext.Shacl.Model as Shacl
import qualified Hydra.Impl.Haskell.Dsl.Literals as Literals
import qualified Hydra.Impl.Haskell.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 :: (Eq m, Show m) => Module m -> GraphFlow m (Shacl.ShapesGraph, Graph m -> GraphFlow m Rdf.Graph)
shaclCoder :: forall m.
(Eq m, Show m) =>
Module m -> GraphFlow m (ShapesGraph, Graph m -> GraphFlow m Graph)
shaclCoder Module m
mod = do
    Context m
cx <- forall s. Flow s s
getState
    let typeEls :: [Element m]
typeEls = forall a. (a -> Bool) -> [a] -> [a]
L.filter (forall m. Eq m => Context m -> Term m -> Bool
isEncodedType Context m
cx forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Element m -> Term m
elementSchema) forall a b. (a -> b) -> a -> b
$ forall m. Module m -> [Element m]
moduleElements Module m
mod
    [Definition Shape]
shapes <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
CM.mapM forall {m}.
Show m =>
Element m -> Flow (Context m) (Definition Shape)
toShape [Element m]
typeEls
    let sg :: ShapesGraph
sg = Set (Definition Shape) -> ShapesGraph
Shacl.ShapesGraph forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
S.fromList [Definition Shape]
shapes
    let termFlow :: p -> Flow (Context m) a
termFlow = \p
g -> do
          forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not implemented"
    forall (m :: * -> *) a. Monad m => a -> m a
return (ShapesGraph
sg, forall {p} {a}. p -> Flow (Context m) a
termFlow)
  where
    toShape :: Element m -> Flow (Context m) (Definition Shape)
toShape Element m
el = do
      Type m
typ <- forall m. Show m => Term m -> GraphFlow m (Type m)
decodeType forall a b. (a -> b) -> a -> b
$ forall m. Element m -> Term m
elementData Element m
el
      CommonProperties
common <- forall m. Show m => Type m -> GraphFlow m CommonProperties
encodeType Type m
typ
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Iri -> a -> Definition a
Shacl.Definition (forall m. Element m -> Iri
elementIri Element m
el) forall a b. (a -> b) -> a -> b
$ NodeShape -> Shape
Shacl.ShapeNode 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 {
  commonPropertiesConstraints :: Set CommonConstraint
Shacl.commonPropertiesConstraints = forall a. Ord a => [a] -> Set a
S.fromList [CommonConstraint]
constraints}

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

descriptionsToGraph :: [Rdf.Description] -> Rdf.Graph
descriptionsToGraph :: [Description] -> Graph
descriptionsToGraph [Description]
ds = Set Triple -> Graph
Rdf.Graph forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ [Description] -> [Triple]
triplesOf [Description]
ds

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

emptyDescription :: Rdf.Node -> Rdf.Description
emptyDescription :: Node -> Description
emptyDescription Node
node = Node -> Graph -> Description
Rdf.Description Node
node Graph
emptyGraph

emptyGraph :: Rdf.Graph
emptyGraph :: Graph
emptyGraph = Set Triple -> Graph
Rdf.Graph forall a. Set a
S.empty

emptyLangStrings :: Rdf.LangStrings
emptyLangStrings :: LangStrings
emptyLangStrings = Map (Maybe LanguageTag) String -> LangStrings
Rdf.LangStrings forall k a. Map k a
M.empty

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

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

encodeLiteral :: Literal -> GraphFlow m Rdf.Node
encodeLiteral :: forall m. Literal -> GraphFlow m Node
encodeLiteral Literal
lit = Literal -> Node
Rdf.NodeLiteral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Literal
lit of
    LiteralBinary String
s -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"base 64 encoding not yet implemented"
    LiteralBoolean Bool
b -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {t}. (t -> String) -> t -> String -> Literal
xsd (\Bool
b -> if Bool
b then String
"true" else String
"false") Bool
b String
"boolean"
    LiteralFloat FloatValue
f -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case FloatValue
f of
      FloatValueBigfloat Double
v -> forall {t}. (t -> String) -> t -> String -> Literal
xsd forall a. Show a => a -> String
show Double
v String
"decimal"
      FloatValueFloat32 Float
v -> forall {t}. (t -> String) -> t -> String -> Literal
xsd forall a. Show a => a -> String
show Float
v String
"float"
      FloatValueFloat64 Double
v -> forall {t}. (t -> String) -> t -> String -> Literal
xsd forall a. Show a => a -> String
show Double
v String
"double"
    LiteralInteger IntegerValue
i -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case IntegerValue
i of
      IntegerValueBigint Integer
v -> forall {t}. (t -> String) -> t -> String -> Literal
xsd forall a. Show a => a -> String
show Integer
v String
"integer"
      IntegerValueInt8 Int
v   -> forall {t}. (t -> String) -> t -> String -> Literal
xsd forall a. Show a => a -> String
show Int
v String
"byte"
      IntegerValueInt16 Int
v  -> forall {t}. (t -> String) -> t -> String -> Literal
xsd forall a. Show a => a -> String
show Int
v String
"short"
      IntegerValueInt32 Int
v  -> forall {t}. (t -> String) -> t -> String -> Literal
xsd forall a. Show a => a -> String
show Int
v String
"int"
      IntegerValueInt64 Integer
v  -> forall {t}. (t -> String) -> t -> String -> Literal
xsd forall a. Show a => a -> String
show Integer
v String
"long"
      IntegerValueUint8 Int
v  -> forall {t}. (t -> String) -> t -> String -> Literal
xsd forall a. Show a => a -> String
show Int
v String
"unsignedByte"
      IntegerValueUint16 Int
v -> forall {t}. (t -> String) -> t -> String -> Literal
xsd forall a. Show a => a -> String
show Int
v String
"unsignedShort"
      IntegerValueUint32 Integer
v -> forall {t}. (t -> String) -> t -> String -> Literal
xsd forall a. Show a => a -> String
show Integer
v String
"unsignedInt"
      IntegerValueUint64 Integer
v -> forall {t}. (t -> String) -> t -> String -> Literal
xsd forall a. Show a => a -> String
show Integer
v String
"unsignedLong"
    LiteralString String
s -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {t}. (t -> String) -> t -> String -> Literal
xsd forall a. a -> a
id String
s String
"string"
  where
    -- TODO: using Haskell's built-in show function is a cheat, and may not be correct/optimal in all cases
    xsd :: (t -> String) -> t -> String -> Literal
xsd t -> String
ser t
x String
local = String -> Iri -> Maybe LanguageTag -> Literal
Rdf.Literal (t -> String
ser t
x) (String -> Iri
xmlSchemaDatatypeIri String
local) forall a. Maybe a
Nothing

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 forall a b. (a -> b) -> a -> b
$ String -> Iri
xmlSchemaDatatypeIri String
local]

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

encodeType :: Show m => Type m -> GraphFlow m Shacl.CommonProperties
encodeType :: forall m. Show m => Type m -> GraphFlow m CommonProperties
encodeType Type m
typ = case forall m. Type m -> Type m
stripType Type m
typ of
    TypeElement Type m
et -> forall m. Show m => Type m -> GraphFlow m CommonProperties
encodeType Type m
et
    TypeList Type m
_ -> GraphFlow m CommonProperties
any
    TypeLiteral LiteralType
lt -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ LiteralType -> CommonProperties
encodeLiteralType LiteralType
lt
    TypeMap MapType m
_ -> GraphFlow m CommonProperties
any
    TypeNominal Name
name -> GraphFlow m CommonProperties
any -- TODO: include name
    TypeRecord (RowType Name
rname Maybe Name
_ [FieldType m]
fields) -> do
      [Definition PropertyShape]
props <- forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
CM.zipWithM (forall m.
Show m =>
Name
-> Maybe Integer
-> FieldType m
-> GraphFlow m (Definition PropertyShape)
encodeFieldType Name
rname) (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Integer
0..]) [FieldType m]
fields
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [CommonConstraint] -> CommonProperties
common [Set (Reference PropertyShape) -> CommonConstraint
Shacl.CommonConstraintProperty forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
S.fromList (forall a. Definition a -> Reference a
Shacl.ReferenceDefinition forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Definition PropertyShape]
props)]
    TypeSet Type m
_ -> GraphFlow m CommonProperties
any
    TypeUnion (RowType Name
rname Maybe Name
_ [FieldType m]
fields) -> do
        [Definition PropertyShape]
props <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
CM.mapM (forall m.
Show m =>
Name
-> Maybe Integer
-> FieldType m
-> GraphFlow m (Definition PropertyShape)
encodeFieldType Name
rname forall a. Maybe a
Nothing) [FieldType m]
fields
        let shapes :: [Reference Shape]
shapes = (forall a. a -> Reference a
Shacl.ReferenceAnonymous forall b c a. (b -> c) -> (a -> b) -> a -> c
. Definition PropertyShape -> Shape
toShape) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Definition PropertyShape]
props
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [CommonConstraint] -> CommonProperties
common [Set (Reference Shape) -> CommonConstraint
Shacl.CommonConstraintXone forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
S.fromList [forall a. Definition a -> Reference a
Shacl.ReferenceDefinition Definition PropertyShape
prop]]
    Type m
_ -> forall (m :: * -> *) a1 a2.
(MonadFail m, Show a1) =>
String -> a1 -> m a2
unexpected String
"type" Type m
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 :: GraphFlow m CommonProperties
any = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [CommonConstraint] -> CommonProperties
common []

forObjects :: Rdf.Resource -> Rdf.Iri -> [Rdf.Node] -> [Rdf.Triple]
forObjects :: Resource -> Iri -> [Node] -> [Triple]
forObjects Resource
subj Iri
pred [Node]
objs = (Resource -> Iri -> Node -> Triple
Rdf.Triple Resource
subj Iri
pred) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Node]
objs

iri :: String -> String -> Rdf.Iri
iri :: String -> String -> Iri
iri String
ns String
local = String -> Iri
Rdf.Iri forall a b. (a -> b) -> a -> b
$ String
ns forall a. [a] -> [a] -> [a]
++ String
local

keyIri :: String -> Rdf.Iri
keyIri :: String -> Iri
keyIri = String -> String -> Iri
iri String
"urn:key:" -- Note: not an official URN scheme

mergeGraphs :: [Rdf.Graph] -> Rdf.Graph
mergeGraphs :: [Graph] -> Graph
mergeGraphs [Graph]
graphs = Set Triple -> Graph
Rdf.Graph forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl forall a. Ord a => Set a -> Set a -> Set a
S.union forall a. Set a
S.empty (Graph -> Set Triple
Rdf.unGraph forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Graph]
graphs)

nameToIri :: Name -> Rdf.Iri
nameToIri :: Name -> Iri
nameToIri Name
name = String -> Iri
Rdf.Iri forall a b. (a -> b) -> a -> b
$ String
"urn:" forall a. [a] -> [a] -> [a]
++ Name -> String
unName Name
name

nextBlankNode :: Show m => GraphFlow m Rdf.Resource
nextBlankNode :: forall m. Show m => GraphFlow m Resource
nextBlankNode = do
  Int
count <- forall s. String -> Flow s Int
nextCount String
"shaclBlankNodeCounter"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ BlankNode -> Resource
Rdf.ResourceBnode forall a b. (a -> b) -> a -> b
$ String -> BlankNode
Rdf.BlankNode forall a b. (a -> b) -> a -> b
$ String
"b" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
count

node :: [Shacl.CommonConstraint] -> Shacl.Shape
node :: [CommonConstraint] -> Shape
node = NodeShape -> Shape
Shacl.ShapeNode forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommonProperties -> NodeShape
Shacl.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 = forall a. Set a
S.empty,
  propertyShapeDefaultValue :: Maybe Node
Shacl.propertyShapeDefaultValue = forall a. Maybe a
Nothing,
  propertyShapeDescription :: LangStrings
Shacl.propertyShapeDescription = LangStrings
emptyLangStrings,
  propertyShapeName :: LangStrings
Shacl.propertyShapeName = LangStrings
emptyLangStrings,
  propertyShapeOrder :: Maybe Integer
Shacl.propertyShapeOrder = forall a. Maybe a
Nothing,
  propertyShapePath :: Iri
Shacl.propertyShapePath = Iri
iri}

-- Note: these are not "proper" URNs, as they do not use an established URN scheme
propertyIri :: Name -> FieldName -> Rdf.Iri
propertyIri :: Name -> FieldName -> Iri
propertyIri Name
rname FieldName
fname = String -> Iri
Rdf.Iri forall a b. (a -> b) -> a -> b
$ String
"urn:" forall a. [a] -> [a] -> [a]
++ Namespace -> String
unNamespace Namespace
gname forall a. [a] -> [a] -> [a]
++ String
"#" forall a. [a] -> [a] -> [a]
++ String -> String
decapitalize String
local forall a. [a] -> [a] -> [a]
++ String -> String
capitalize (FieldName -> String
unFieldName FieldName
fname)
  where
    (Namespace
gname, String
local) = Name -> (Namespace, String)
toQnameLazy Name
rname

rdfIri :: String -> Rdf.Iri
rdfIri :: String -> Iri
rdfIri = String -> String -> Iri
iri String
"http://www.w3.org/1999/02/22-rdf-syntax-ns#"

resourceToNode :: Rdf.Resource -> Rdf.Node
resourceToNode :: Resource -> Node
resourceToNode Resource
r = case Resource
r of
  Rdf.ResourceIri Iri
i -> Iri -> Node
Rdf.NodeIri Iri
i
  Rdf.ResourceBnode BlankNode
b -> BlankNode -> Node
Rdf.NodeBnode BlankNode
b

subjectsOf :: [Rdf.Description] -> [Rdf.Node]
subjectsOf :: [Description] -> [Node]
subjectsOf [Description]
descs = Description -> Node
Rdf.descriptionSubject forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Description]
descs

triplesOf :: [Rdf.Description] -> [Rdf.Triple]
triplesOf :: [Description] -> [Triple]
triplesOf [Description]
descs = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
L.concat ((forall a. Set a -> [a]
S.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph -> Set Triple
Rdf.unGraph forall b c a. (b -> c) -> (a -> b) -> a -> c
. Description -> Graph
Rdf.descriptionGraph) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Description]
descs)

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 forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ Name -> Iri
nameToIri Name
name)

xmlSchemaDatatypeIri :: String -> Rdf.Iri
xmlSchemaDatatypeIri :: String -> Iri
xmlSchemaDatatypeIri = String -> String -> Iri
iri String
"http://www.w3.org/2001/XMLSchema#"