{-# LANGUAGE OverloadedStrings #-} -------------------------------------------------------------------------------- -- See end of this file for licence information. -------------------------------------------------------------------------------- -- | -- Module : RDFDatatypeXsdInteger -- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke -- Stability : experimental -- Portability : OverloadedStrings -- -- This module defines the structures used by Swish to represent and -- manipulate RDF @xsd:integer@ datatyped literals. -- -------------------------------------------------------------------------------- module Swish.RDF.RDFDatatypeXsdInteger ( rdfDatatypeXsdInteger , rdfDatatypeValXsdInteger , typeNameXsdInteger, namespaceXsdInteger , axiomsXsdInteger, rulesXsdInteger , prefixXsdInteger ) where import Swish.RDF.RDFRuleset ( RDFFormula, RDFRule, RDFRuleset , makeRDFGraphFromN3Builder , makeRDFFormula ) import Swish.RDF.RDFDatatype ( RDFDatatype , RDFDatatypeVal , RDFDatatypeMod , makeRdfDtOpenVarBindingModifiers ) import Swish.RDF.ClassRestrictionRule (makeRDFDatatypeRestrictionRules) import Swish.RDF.MapXsdInteger (mapXsdInteger) import Swish.RDF.Datatype ( Datatype(..) , DatatypeVal(..) , DatatypeRel(..), DatatypeRelPr , altArgs , UnaryFnTable, unaryFnApp , BinaryFnTable, binaryFnApp , BinMaybeFnTable, binMaybeFnApp , DatatypeMod(..) , makeVmod11inv, makeVmod11 , makeVmod21inv, makeVmod21 , makeVmod20 , makeVmod22 ) import Swish.RDF.Ruleset (makeRuleset) import Swish.Utils.Namespace (Namespace, ScopedName, namespaceToBuilder, makeNSScopedName) import Swish.RDF.Vocabulary ( namespaceRDF , namespaceRDFS , namespaceRDFD , namespaceXSD , namespaceXsdType ) import Data.Monoid(Monoid(..)) import Control.Monad (liftM) import Data.Maybe (maybeToList) import qualified Data.Text as T import qualified Data.Text.Lazy.Builder as B ------------------------------------------------------------ -- Misc values ------------------------------------------------------------ -- Local name for Integer datatype nameXsdInteger :: T.Text nameXsdInteger = "integer" -- |Type name for xsd:integer datatype typeNameXsdInteger :: ScopedName typeNameXsdInteger = makeNSScopedName namespaceXSD nameXsdInteger -- |Namespace for xsd:integer datatype functions namespaceXsdInteger :: Namespace namespaceXsdInteger = namespaceXsdType nameXsdInteger -- Compose with function of two arguments c2 :: (b -> c) -> (a -> d -> b) -> a -> d -> c c2 = (.) . (.) -- Integer power (exponentiation) function -- returns Nothing if exponent is negative. -- intPower :: Integer -> Integer -> Maybe Integer intPower a b = if b < 0 then Nothing else Just (intPower1 a b) where intPower1 x y | q == 1 = atopsq*x | p == 0 = 1 | otherwise = atopsq where (p,q) = y `divMod` 2 atop = intPower1 x p atopsq = atop*atop ------------------------------------------------------------ -- Declare exported RDFDatatype value for xsd:integer ------------------------------------------------------------ rdfDatatypeXsdInteger :: RDFDatatype rdfDatatypeXsdInteger = Datatype rdfDatatypeValXsdInteger ------------------------------------------------------------ -- Implmentation of RDFDatatypeVal for xsd:integer ------------------------------------------------------------ -- |Define Datatype value for @xsd:integer@. -- -- Members of this datatype are positive or negative integer values. -- -- The lexical form consists of an optional @+@ or @-@ -- followed by a sequence of decimal digits. -- -- The canonical lexical form has leading zeros and @+@ sign removed. -- rdfDatatypeValXsdInteger :: RDFDatatypeVal Integer rdfDatatypeValXsdInteger = DatatypeVal { tvalName = typeNameXsdInteger , tvalRules = rdfRulesetXsdInteger -- Ruleset RDFGraph , tvalMkRules = makeRDFDatatypeRestrictionRules rdfDatatypeValXsdInteger -- RDFGraph -> [RDFRules] , tvalMkMods = makeRdfDtOpenVarBindingModifiers rdfDatatypeValXsdInteger , tvalMap = mapXsdInteger -- DatatypeMap Integer , tvalRel = relXsdInteger -- [DatatypeRel Integer] , tvalMod = modXsdInteger -- [DatatypeMod Integer] } -- |relXsdInteger contains arithmetic and other relations for xsd:Integer values. -- -- The functions are inspired by those defined by CWM as math: properties -- (). -- relXsdInteger :: [DatatypeRel Integer] relXsdInteger = [ relXsdIntegerAbs , relXsdIntegerNeg , relXsdIntegerSum , relXsdIntegerDiff , relXsdIntegerProd , relXsdIntegerDivMod , relXsdIntegerPower , relXsdIntegerEq , relXsdIntegerNe , relXsdIntegerLt , relXsdIntegerLe , relXsdIntegerGt , relXsdIntegerGe ] mkIntRel2 :: T.Text -> DatatypeRelPr Integer -> UnaryFnTable Integer -> DatatypeRel Integer mkIntRel2 nam pr fns = DatatypeRel { dtRelName = makeNSScopedName namespaceXsdInteger nam , dtRelFunc = altArgs pr fns unaryFnApp } mkIntRel3 :: T.Text -> DatatypeRelPr Integer -> BinaryFnTable Integer -> DatatypeRel Integer mkIntRel3 nam pr fns = DatatypeRel { dtRelName = makeNSScopedName namespaceXsdInteger nam , dtRelFunc = altArgs pr fns binaryFnApp } mkIntRel3maybe :: T.Text -> DatatypeRelPr Integer -> BinMaybeFnTable Integer -> DatatypeRel Integer mkIntRel3maybe nam pr fns = DatatypeRel { dtRelName = makeNSScopedName namespaceXsdInteger nam , dtRelFunc = altArgs pr fns binMaybeFnApp } relXsdIntegerAbs :: DatatypeRel Integer relXsdIntegerAbs = mkIntRel2 "abs" (const True) [ ( (>=0), [ (abs,1) ] ) , ( const True, [ (id,0), (negate,0) ] ) ] relXsdIntegerNeg :: DatatypeRel Integer relXsdIntegerNeg = mkIntRel2 "neg" (const True) [ ( const True, [ (negate,1) ] ) , ( const True, [ (negate,0) ] ) ] relXsdIntegerSum :: DatatypeRel Integer relXsdIntegerSum = mkIntRel3 "sum" (const True) [ ( const True, [ ((+),1,2) ] ) , ( const True, [ ((-),0,2) ] ) , ( const True, [ ((-),0,1) ] ) ] relXsdIntegerDiff :: DatatypeRel Integer relXsdIntegerDiff = mkIntRel3 "diff" (const True) [ ( const True, [ ((-),1,2) ] ) , ( const True, [ ((+),0,2) ] ) , ( const True, [ ((-),1,0) ] ) ] relXsdIntegerProd :: DatatypeRel Integer relXsdIntegerProd = mkIntRel3 "prod" (const True) [ ( const True, [ ((*),1,2) ] ) , ( const True, [ (div,0,2) ] ) , ( const True, [ (div,0,1) ] ) ] relXsdIntegerDivMod :: DatatypeRel Integer relXsdIntegerDivMod = mkIntRel3 "divmod" (const True) [ ( const True, [ (div,2,3) ] ) , ( const True, [ (mod,2,3) ] ) , ( const True, [ ] ) , ( const True, [ ] ) ] relXsdIntegerPower :: DatatypeRel Integer relXsdIntegerPower = mkIntRel3maybe "power" (const True) [ ( const True, [ (liftM (:[]) `c2` intPower,1,2) ] ) , ( const True, [ ] ) , ( (>=0), [ ] ) ] liftL2 :: (a->a->Bool) -> ([a]->a) -> ([a]->a) -> [a] -> Bool liftL2 p i1 i2 as = p (i1 as) (i2 as) lcomp :: (a->a->Bool) -> [a] -> Bool lcomp p = liftL2 p head (head . tail) -- eq relXsdIntegerEq :: DatatypeRel Integer relXsdIntegerEq = mkIntRel2 "eq" (lcomp (==)) ( repeat (const True, []) ) -- ne relXsdIntegerNe :: DatatypeRel Integer relXsdIntegerNe = mkIntRel2 "ne" (lcomp (/=)) ( repeat (const True, []) ) -- lt relXsdIntegerLt :: DatatypeRel Integer relXsdIntegerLt = mkIntRel2 "lt" (lcomp (<)) ( repeat (const True, []) ) -- le relXsdIntegerLe :: DatatypeRel Integer relXsdIntegerLe = mkIntRel2 "le" (lcomp (<=)) ( repeat (const True, []) ) -- gt relXsdIntegerGt :: DatatypeRel Integer relXsdIntegerGt = mkIntRel2 "gt" (lcomp (>)) ( repeat (const True, []) ) -- ge relXsdIntegerGe :: DatatypeRel Integer relXsdIntegerGe = mkIntRel2 "ge" (lcomp (>=)) ( repeat (const True, []) ) -- |modXsdInteger contains variable binding modifiers for xsd:Integer values. -- -- The functions are selected from those defined by CWM as math: -- properties -- (). -- modXsdInteger :: [RDFDatatypeMod Integer] modXsdInteger = [ modXsdIntegerAbs , modXsdIntegerNeg , modXsdIntegerSum , modXsdIntegerDiff , modXsdIntegerProd , modXsdIntegerDivMod , modXsdIntegerPower , modXsdIntegerEq , modXsdIntegerNe , modXsdIntegerLt , modXsdIntegerLe , modXsdIntegerGt , modXsdIntegerGe ] modXsdIntegerAbs :: RDFDatatypeMod Integer modXsdIntegerAbs = DatatypeMod { dmName = makeNSScopedName namespaceXsdInteger "abs" , dmModf = [ f0, f1 ] , dmAppf = makeVmod11 } where f0 vs@[v1,v2] = if v1 == abs v2 then vs else [] f0 _ = [] f1 [v2] = [abs v2] f1 _ = [] modXsdIntegerNeg :: RDFDatatypeMod Integer modXsdIntegerNeg = DatatypeMod { dmName = makeNSScopedName namespaceXsdInteger "neg" , dmModf = [ f0, f1, f1 ] , dmAppf = makeVmod11inv } where f0 vs@[v1,v2] = if v1 == negate v2 then vs else [] f0 _ = [] f1 [vi] = [-vi] f1 _ = [] modXsdIntegerSum :: RDFDatatypeMod Integer modXsdIntegerSum = DatatypeMod { dmName = makeNSScopedName namespaceXsdInteger "sum" , dmModf = [ f0, f1, f2, f2 ] , dmAppf = makeVmod21inv } where f0 vs@[v1,v2,v3] = if v1 == v2+v3 then vs else [] f0 _ = [] f1 [v2,v3] = [v2+v3] f1 _ = [] f2 [v1,vi] = [v1-vi] f2 _ = [] modXsdIntegerDiff :: RDFDatatypeMod Integer modXsdIntegerDiff = DatatypeMod { dmName = makeNSScopedName namespaceXsdInteger "diff" , dmModf = [ f0, f1, f2, f3 ] , dmAppf = makeVmod21inv } where f0 vs@[v1,v2,v3] = if v1 == v2-v3 then vs else [] f0 _ = [] f1 [v2,v3] = [v2-v3] f1 _ = [] f2 [v1,v3] = [v1+v3] f2 _ = [] f3 [v1,v2] = [v2-v1] f3 _ = [] modXsdIntegerProd :: RDFDatatypeMod Integer modXsdIntegerProd = DatatypeMod { dmName = makeNSScopedName namespaceXsdInteger "prod" , dmModf = [ f0, f1, f2, f2 ] , dmAppf = makeVmod21inv } where f0 vs@[v1,v2,v3] = if v1 == v2*v3 then vs else [] f0 _ = [] f1 [v2,v3] = [v2*v3] f1 _ = [] f2 [v1,vi] = if r == 0 then [q] else [] where (q,r) = quotRem v1 vi f2 _ = [] modXsdIntegerDivMod :: RDFDatatypeMod Integer modXsdIntegerDivMod = DatatypeMod { dmName = makeNSScopedName namespaceXsdInteger "divmod" , dmModf = [ f0, f1 ] , dmAppf = makeVmod22 } where f0 vs@[v1,v2,v3,v4] = if (v1,v2) == divMod v3 v4 then vs else [] f0 _ = [] f1 [v3,v4] = [v1,v2] where (v1,v2) = divMod v3 v4 f1 _ = [] modXsdIntegerPower :: RDFDatatypeMod Integer modXsdIntegerPower = DatatypeMod { dmName = makeNSScopedName namespaceXsdInteger "power" , dmModf = [ f0, f1 ] , dmAppf = makeVmod21 } where f0 vs@[v1,v2,v3] = if Just v1 == intPower v2 v3 then vs else [] f0 _ = [] f1 [v2,v3] = maybeToList (intPower v2 v3) f1 _ = [] modXsdIntegerEq, modXsdIntegerNe, modXsdIntegerLt, modXsdIntegerLe, modXsdIntegerGt, modXsdIntegerGe :: RDFDatatypeMod Integer modXsdIntegerEq = modXsdIntegerCompare "eq" (==) modXsdIntegerNe = modXsdIntegerCompare "ne" (/=) modXsdIntegerLt = modXsdIntegerCompare "lt" (<) modXsdIntegerLe = modXsdIntegerCompare "le" (<=) modXsdIntegerGt = modXsdIntegerCompare "gt" (>) modXsdIntegerGe = modXsdIntegerCompare "ge" (>=) modXsdIntegerCompare :: T.Text -> (Integer->Integer->Bool) -> RDFDatatypeMod Integer modXsdIntegerCompare nam rel = DatatypeMod { dmName = makeNSScopedName namespaceXsdInteger nam , dmModf = [ f0 ] , dmAppf = makeVmod20 } where f0 vs@[v1,v2] = if rel v1 v2 then vs else [] f0 _ = [] -- |rulesetXsdInteger contains rules and axioms that allow additional -- deductions when xsd:integer values appear in a graph. -- -- The rules defined here are concerned with basic integer arithmetic -- operations: +, -, *, div, rem -- -- makeRuleset :: Namespace -> [Formula ex] -> [Rule ex] -> Ruleset ex -- rdfRulesetXsdInteger :: RDFRuleset rdfRulesetXsdInteger = makeRuleset namespaceXsdInteger axiomsXsdInteger rulesXsdInteger mkPrefix :: Namespace -> B.Builder mkPrefix = namespaceToBuilder prefixXsdInteger :: B.Builder prefixXsdInteger = mconcat [ mkPrefix namespaceRDF , mkPrefix namespaceRDFS , mkPrefix namespaceRDFD , mkPrefix namespaceXSD , mkPrefix namespaceXsdInteger ] mkAxiom :: T.Text -> B.Builder -> RDFFormula mkAxiom local gr = makeRDFFormula namespaceXsdInteger local (prefixXsdInteger `mappend` gr) axiomsXsdInteger :: [RDFFormula] axiomsXsdInteger = [ mkAxiom "dt" "xsd:integer rdf:type rdfs:Datatype ." ] rulesXsdInteger :: [RDFRule] rulesXsdInteger = makeRDFDatatypeRestrictionRules rdfDatatypeValXsdInteger gr where gr = makeRDFGraphFromN3Builder rulesXsdIntegerBuilder --- I have removed the newline which was added between each line --- to improve the clarity of parser errors. --- rulesXsdIntegerBuilder :: B.Builder rulesXsdIntegerBuilder = mconcat [ prefixXsdInteger , "xsd_integer:Abs a rdfd:GeneralRestriction ; " , " rdfd:onProperties (rdf:_1 rdf:_2) ; " , " rdfd:constraint xsd_integer:abs ; " , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . " , "xsd_integer:Neg a rdfd:GeneralRestriction ; " , " rdfd:onProperties (rdf:_1 rdf:_2) ; " , " rdfd:constraint xsd_integer:neg ; " , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . " , "xsd_integer:Sum a rdfd:GeneralRestriction ; " , " rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3) ; " , " rdfd:constraint xsd_integer:sum ; " , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . " , "xsd_integer:Diff a rdfd:GeneralRestriction ; " , " rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3) ; " , " rdfd:constraint xsd_integer:diff ; " , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . " , "xsd_integer:Prod a rdfd:GeneralRestriction ; " , " rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3) ; " , " rdfd:constraint xsd_integer:prod ; " , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . " , "xsd_integer:DivMod a rdfd:GeneralRestriction ; " , " rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3 rdf:_4) ; " , " rdfd:constraint xsd_integer:divmod ; " , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . " , "xsd_integer:Power a rdfd:GeneralRestriction ; " , " rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3) ; " , " rdfd:constraint xsd_integer:power ; " , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . " , "xsd_integer:Eq a rdfd:GeneralRestriction ; " , " rdfd:onProperties (rdf:_1 rdf:_2) ; " , " rdfd:constraint xsd_integer:eq ; " , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . " , "xsd_integer:Ne a rdfd:GeneralRestriction ; " , " rdfd:onProperties (rdf:_1 rdf:_2) ; " , " rdfd:constraint xsd_integer:ne ; " , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . " , "xsd_integer:Lt a rdfd:GeneralRestriction ; " , " rdfd:onProperties (rdf:_1 rdf:_2) ; " , " rdfd:constraint xsd_integer:lt ; " , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . " , "xsd_integer:Le a rdfd:GeneralRestriction ; " , " rdfd:onProperties (rdf:_1 rdf:_2) ; " , " rdfd:constraint xsd_integer:le ; " , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . " , "xsd_integer:Gt a rdfd:GeneralRestriction ; " , " rdfd:onProperties (rdf:_1 rdf:_2) ; " , " rdfd:constraint xsd_integer:gt ; " , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . " , "xsd_integer:Ge a rdfd:GeneralRestriction ; " , " rdfd:onProperties (rdf:_1 rdf:_2) ; " , " rdfd:constraint xsd_integer:ge ; " , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . " ] -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke -- All rights reserved. -- -- This file is part of Swish. -- -- Swish is free software; you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation; either version 2 of the License, or -- (at your option) any later version. -- -- Swish is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with Swish; if not, write to: -- The Free Software Foundation, Inc., -- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -- --------------------------------------------------------------------------------