function.datashape.api.define.rq Maven / Gradle / Ivy

Go to download
#
# SHACL Interpreter 
#
# API for defining shacl shapes by program in complement to shacl graph
# shape format is lisp-like expression
#
# Olivier Corby - Wimmics Inria I3S - 2016-2020
#

prefix sh:    
prefix xsh:   
prefix h:    

@import   

function sh:fundefine(shapeList) {
    sh:startDefine();
    map (sh:defShaclShape, shapeList) 
}

function sh:defShacl(shapeList) {
    sh:fundefine(shapeList)
}

# input format is a list, lisp-like expression:
# (sh:shape us:test (sh:targetClass h:Person)
# (sh:property (sh:path h:hasFriend) (sh:class h:Person))
# )
#
function sh:defShaclShape(exp) {
    #xt:print("defShaclShape:", exp);
    let ((oper name | list) = exp) {
        sh:defShaclShape(name, list, exp)
    } 
}

# subshape where local name is useless and  must be overloaded by given name
# use case: (sh:and (e1 e2) e3) -> (sh:and (sh:shape _:b e1 e2) e3)
# this is generated by parser pr:defMerge
#
function sh:defShaclShape(name, exp) {
    sh:apitrace("defShaclShape:", name, exp);
    let ((oper localName | list) = exp) {
        sh:defShaclShape(name, list, exp)
    } 
}


function sh:defShaclShape(name, list, exp) {
    sh:apitrace("defShaclShape:", exp);
    let (deactivated = coalesce(sh:getListValue(sh:deactivated, list), false)) {
        if (deactivated) {
            # skip deactivated shape
            sh:setConstraint(sh:deactivated, name, true)
        }
        else {
            map(sh:defShaclShapeExp, name, list, xt:list(exp)) ;
            sh:defSibling(name) ;
            return (name)
        }
    }
}



function sh:defShaclShapeExp(name, exp, main) {
    sh:apitrace("defShaclShape:", name, exp);
    let ((oper) = exp) {
        if (sh:isTarget(oper), sh:defTarget(name, exp),
        if (sh:isHeader(oper), sh:defHeader(name, exp, main),
        sh:defShaclShapeConstraint(name, exp)))
    } 
}


function sh:isTarget(name) {
    name in (sh:targetClass, sh:targetNode, sh:targetSubjectsOf, sh:targetObjectsOf)
}

function sh:isHeader(name) {
    name in (sh:closed, sh:ignoredProperties, sh:deactivated)
}

# exp = sh:target (sh:targetClass C1 .. Cn)
#
function sh:defTarget(name, exp) {
    let ((oper | list) = exp) {
        sh:defTarget(name, oper, list)
    }
}

function sh:defTarget(name, oper, list) {
}

# (sh:closed true)
# (sh:ignoredProperties p1 .. pn)
#
function sh:defHeader(name, exp, main) {
    let ((oper value) = exp) {
        #xt:print("header:", name, oper, value)
    } 
    ; sh:defHeaderBasic(name, exp, main)
}

function sh:defHeaderBasic(name, exp, main) {
    let ((oper value) = exp) {
        if (oper = sh:closed) {
            if (value) {
                sh:setConstraint(sh:isclosedcore, name, true)
                #; xt:print("main:", main)
                #; xt:print("closed:", coalesce(sh:getPredicateList(main), "undef"))
                ; sh:addConstraint(sh:closedcore, name, sh:getPredicateList(main))
            }
        }
        else if (oper = sh:ignoredProperties) {
            #xt:print("ignored:", value);
            sh:addConstraint(sh:closedcore, name, value)
        }
        else if (oper = sh:deactivated) {
        
        }
    }
}

# list of closed predicates of exp
#
function sh:getPredicateList(exp) {
    #xt:print("get pred1:", exp);
    let (list = xt:list()) {
        for (cst in exp) {
            if (isExtension(cst)) {
                let ((oper | value) = cst) {
                        if (oper = sh:property) {
                            let (path = sh:getListValue(sh:path, value)) {
                                if (isURI(path)) {
                                    xt:add(list, path)
                                }
                            }
                        }
                        else if (oper = sh:path) {
                        
                        }
                }
            }
        } ;
        return (list)
    }
}


# Top level function for defining a shape constraint exp
#
function sh:defShaclShapeConstraint(exp) {
    let (bn = bnode()) {
        sh:defShaclShapeConstraint(bn, exp) ;
        return (bn)
    }
}

function sh:defShaclShapeConstraint(name, exp) {
    sh:apitrace("defShaclShapeConstraint:", name, exp);
    let ((oper value) = exp) {
        if (oper = sh:shape) {
            sh:defShaclShape(name, exp)
        }
        else if (oper = sh:property) {
            sh:defPropertyShape(name, exp)
        }
        else if (oper = sh:node) {
            sh:defNodeShape(name, exp)
        }
        else if (sh:isBoolean(oper)) {
            sh:defBooleanShape(name, exp)
        }
        else if (sh:isHeader(oper)) {
            sh:defHeaderBasic(name, exp, xt:list())
        }
        else {
            sh:defBasicShape(name, exp)
        }
    }
}


# Boolean Node Shape
#
function sh:defBooleanShape(name, exp) {
    let ((oper) = exp, bn = bnode()) {
        sh:define(bn, exp);
        sh:defConstraint(name, sh:booleancore, oper, bn) ;
        sh:defBooleanConstraint(bn, sh:coreboolean, exp) ;
        return (name)
    }
}


# Basic shape constraint
# exp = (sh:pattern value)
#
function sh:defBasicShape(name, exp) {
    sh:apitrace("defBasicShape:", name, exp);
    let ((oper value) = exp,
         class = sh:getConstraintClass(oper)) {
        sh:defConstraint(name, class, exp, oper, value)
    }
}

# Node Shape sh:node
# exp = (sh:node (sh:pattern value)) | (sh:node URI)
#
function sh:defNodeShape(name, exp) {
    sh:apitrace("defNodeShape:", name, exp);
   let ((oper value) = exp,
        sh = if (isURI(value), value, bnode())) {
        if (sh:isDefined(sh)) {
            return (sh)
        }
        else {
            sh:define(sh, exp);
            sh:defConstraint(name, sh:getConstraintClass(oper),     oper, sh) ;
            sh:defConstraint(name, sh:getPathConstraintClass(oper), oper, sh) ;
            if (isURI(sh), true, sh:defShaclShapeConstraint(sh, value)) ;
            return (sh)
        }
    }
}


# Property Shape
# name = main shape name
# exp = (sh:property [name] (sh:path path) ...)
#
function sh:defPropertyShape(name, exp) {
    #xt:print("define:", name, exp);
    let ((oper arg) = exp) {
        if (isExtension(arg), # arg is path
            sh:defPropertyShapeWithoutName(name, exp), 
            sh:defPropertyShapeWithName(name, exp))
    }
}

function sh:defPropertyShapeWithoutName(name, exp) {
    sh:apitrace("defPropertyShape:", name, exp);
    let ((oper path | list) = exp, sh = bnode()) {
        #xt:print("defprop:", name, sh, path, list);
        sh:defPropertyShape(name, sh, path, list, exp) ;
        return (sh)
    }
}

# property definition with a name
# exp = (sh:property ex:mycst (sh:path path) ...)
#
function sh:defPropertyShapeWithName(name, exp) {
    sh:apitrace("defPropertyShape:", name, exp);
    let ((oper sh path | list) = exp) {
        #xt:print("defprop:", name, sh, path, list);
        sh:defPropertyShape(name, sh, path, list, exp);
        return (sh)
    }
}
    
    
function sh:defPropertyShape(name, sh, path, list, exp) {
    #xt:print("define:", name, sh, exp);
    sh:defPropertyPath(name, sh, path) ; 
    if (! sh:isDefined(sh)) {
        sh:define(sh, exp);
        for (stmt in list) {
            sh:defPropertyConstraint(name, sh, stmt)
        }
    };
    return (sh)
}


# Define path of property shape
# exp = (sh:path path)
#
function sh:defPropertyPath(name, sh, exp) {
    sh:apitrace("defPropertyPath:", name, exp);
    let ((oper path) = exp) {
        #if (isExtension(path), xt:print("path:", path, sh:fun2rdf(path)), true) ;
        sh:setConstraint(sh:path, path, path);
        sh:defConstraint(name, sh:pathcore, sh, path) ;
        return (sh)
    }
}

# Define constraint of property shape
# name: main shape ; sh: property shape
#
function sh:defPropertyConstraint(name, sh, stmt) {
    sh:apitrace("defPropertyConstraint:", name, sh, stmt);
    let ((oper value) = stmt,
         class = sh:getPathConstraintClass(oper)) {
        if (oper = sh:qualifiedValueShape) {
            sh:defQualifiedValueShape(name, sh, class, stmt)
        } 
        else if (oper = sh:property) { 
            let (bn = bnode()) {
                sh:define(bn, stmt);
                sh:defConstraint(sh, class, sh:property, bn) ;
                sh:defShaclShapeConstraint(bn, stmt)
            }
        }
        else if (oper = sh:node) { 
            sh:defShaclShapeConstraint(sh, stmt)
        }
        else if (sh:isBoolean(oper)) {
            let (bn = bnode()) {
                sh:define(bn, stmt);
                sh:defConstraint(sh, class, oper, bn) ;
                sh:defBooleanConstraint(bn, sh:pathboolean, stmt)
            }
        }
        else {
            sh:defConstraint(sh, class, stmt, oper, value)
        }
    }
}


# exp = (sh:qualifiedValueShape (shape) (disjoint) (min) (max) )
# res = (sh:qualifiedValueShape bn disjoint min max)
#
function sh:defQualifiedValueShape(name, sh, class, exp) {
    #xt:print("qualif:", name, sh, class, exp);
    let ((oper shape | list) = exp, 
        bn = sh:defShaclShapeConstraint(bnode(), shape),
        res = xt:list(sh:qualifiedValueShape, bn, 
            coalesce(sh:getListValue(sh:qualifiedValueShapesDisjoint, list), false),
            coalesce(sh:getListValue(sh:qualifiedMinCount, list), 0),
            coalesce(sh:getListValue(qualifiedMaxCount, list), -1))) {
        sh:define(bn, exp);
        sh:addConstraint(class, sh, xt:list(res)) 
    }
}


#
# Compute sibling  qualified values shapes if any
# For each such shape store the list of siblings in table
#
function sh:defSibling(name) {
    let (list = sh:getAllSibling(name)) {
        if (xt:size(list) > 0) {
            for ((sh path) in sh:getConstraintDefault(sh:pathcore, name)) {
                # property shapes
                for ((oper qsh disjoint) in sh:getConstraintDefault(sh:path3, sh)) {    
                    # qualified value shape
                    if (disjoint) {
                        sh:setConstraint(sh:sibling, qsh, sh:defSibling(list, qsh))
                    }
                }
            }
        }
    }
}

function sh:getConstraintDefault(class, name) {
     coalesce(sh:getConstraint(class, name), xt:list())   
}

#
# All sibling  qualified values shapes if any
#
function sh:getAllSibling(name) {
    let (list = xt:list()) {
        for ((sh path) in sh:getConstraintDefault(sh:pathcore, name)) {
            # property shapes
            for ((oper qsh2) in sh:getConstraintDefault(sh:path3, sh)) {
                # qualified value shape
                xt:add(list, xt:list(qsh2, path))
            }
        } ; 
        return(list)
    }
}

#
# qsh sibling  qualified values shapes 
# list: list of candidate siblings
# remove qsh from list
# qsh:  qualified values shape
#
function sh:defSibling(list, qsh) {
    let (res = xt:list()) {
        for (pair in list) {
            let ((qsh2 path) = pair) {
                if (qsh2 != qsh) {
                    xt:add(res, pair)
                }
            }
        } ;
        return(res)
    }
}



function sh:getListValue(name, list) {
    for (exp in list) {
        if (isExtension(exp)) {
            let ((oper val) = exp) {
                if (oper = name, return (val), true)
            }
        }
    } ;
    return (error())
    
}


# Boolean shape, Property or Node Shape
# class = sh:pathboolean | sh:coreboolean
# exp = (sh:and exp1 .. expn)
#
function sh:defBooleanConstraint(name, class, exp) {
    sh:apitrace("defPropertyConstraint:", name, exp);
    let ((oper | list) = exp) {
        if (oper = sh:not) {
            let ((cst) = list){
                sh:defShaclShapeConstraint(name, cst)
            }
        }
        else {
            let (shList = sh:defConstraintList(name, list)) {
                sh:setConstraint(class, name, shList) 
            }
        }
    } ;
    return (name)
}

# Define list of constraints of a boolean operator
# return list of compiled constraints as a list of fresh bnodes
#
function sh:defConstraintList(name, list) {
    maplist(lambda(cst) { 
        let (sh = bnode()) {
            sh:define(sh, cst);
            sh:defShaclShapeConstraint(sh, cst) ;
            sh
        }
    }, list)
}

function sh:isBoolean(oper) {
    let (bool = @(sh:not sh:and sh:or sh:xone)) {
        xt:member(oper, bool)
    }
}




function sh:defConstraint(sh, class, oper, value) {
    sh:defConstraint(sh, class, sh:null, oper, value)
}

# Define a constraint in the input format of the interpreter
# sh is the ID of the shape, class is the kind of constraint,
# oper = sh:class ; value = foaf:Person
# exp  = (sh:class foaf:Person)
# 
function sh:defConstraint(sh, class, exp, oper, value) {
    if (oper = sh:pattern) {
        let ((op | rest) = exp) {
            sh:addConstraint(class, sh, sh:parameter(class, oper, rest)) 
        }
    }
    else if (oper = xsh:function) {
        let ((name param) = value) {
            sh:addConstraint(class, sh, xt:list(xt:list(oper, name, param, true)))
        }
    }
    else {        
        #xt:print(sh:defConstraint, sh, class, oper, value) ;
        sh:addConstraint(class, sh, sh:parameter(class, oper, value)) 
    } ;
    return (sh)
}





function sh:apitrace(mes, arg) {
    #xt:print(mes, arg)
}

function sh:apitrace(mes, arg1, arg2) {
    #xt:print(mes, arg1, arg2)
}

function sh:apitrace(mes, arg1, arg2, arg3) {
    #xt:print(mes, arg1, arg2, arg3)
}

function sh:startDefine() {
    set (mapdef = xt:map())
}

function sh:define(name, exp) {
    xt:set(mapdef, name, exp)
}

function sh:getDefinition(name) {
    xt:get(mapdef, name)
}

function sh:isDefined(name) {
    xt:has(mapdef, name)
}


function sh:testDefine() {
    let (shape = @(
        sh:shape us:test
        (sh:target (sh:targetClass h:Person))
        (sh:property (sh:path h:hasFriend) (sh:node (sh:class h:Person)))
    )) {
        shape
    }
}

function sh:testDefShape() {
    if (bound(?defshape), 
        sh:defShaclShape(?defshape),
        sh:defShaclShape(sh:testDefine()))
}