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
nameXsdInteger :: T.Text
nameXsdInteger = "integer"
typeNameXsdInteger :: ScopedName
typeNameXsdInteger = makeNSScopedName namespaceXSD nameXsdInteger
namespaceXsdInteger :: Namespace
namespaceXsdInteger = namespaceXsdType nameXsdInteger
c2 :: (b -> c) -> (a -> d -> b) -> a -> d -> c
c2 = (.) . (.)
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
rdfDatatypeXsdInteger :: RDFDatatype
rdfDatatypeXsdInteger = Datatype rdfDatatypeValXsdInteger
rdfDatatypeValXsdInteger :: RDFDatatypeVal Integer
rdfDatatypeValXsdInteger = DatatypeVal
{ tvalName = typeNameXsdInteger
, tvalRules = rdfRulesetXsdInteger
, tvalMkRules = makeRDFDatatypeRestrictionRules rdfDatatypeValXsdInteger
, tvalMkMods = makeRdfDtOpenVarBindingModifiers rdfDatatypeValXsdInteger
, tvalMap = mapXsdInteger
, tvalRel = relXsdInteger
, tvalMod = modXsdInteger
}
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)
relXsdIntegerEq :: DatatypeRel Integer
relXsdIntegerEq = mkIntRel2 "eq" (lcomp (==))
( repeat (const True, []) )
relXsdIntegerNe :: DatatypeRel Integer
relXsdIntegerNe = mkIntRel2 "ne" (lcomp (/=))
( repeat (const True, []) )
relXsdIntegerLt :: DatatypeRel Integer
relXsdIntegerLt = mkIntRel2 "lt" (lcomp (<))
( repeat (const True, []) )
relXsdIntegerLe :: DatatypeRel Integer
relXsdIntegerLe = mkIntRel2 "le" (lcomp (<=))
( repeat (const True, []) )
relXsdIntegerGt :: DatatypeRel Integer
relXsdIntegerGt = mkIntRel2 "gt" (lcomp (>))
( repeat (const True, []) )
relXsdIntegerGe :: DatatypeRel Integer
relXsdIntegerGe = mkIntRel2 "ge" (lcomp (>=))
( repeat (const True, []) )
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] = [v1vi]
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 == v2v3 then vs else []
f0 _ = []
f1 [v2,v3] = [v2v3]
f1 _ = []
f2 [v1,v3] = [v1+v3]
f2 _ = []
f3 [v1,v2] = [v2v1]
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 _ = []
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
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 . "
]