{-# LANGUAGE OverloadedStrings #-} -------------------------------------------------------------------------------- -- See end of this file for licence information. -------------------------------------------------------------------------------- -- | -- Module : RDFDatatypeXsdDecimal -- 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:double@ datatyped literals. -- -------------------------------------------------------------------------------- module Swish.RDF.RDFDatatypeXsdDecimal ( rdfDatatypeXsdDecimal , rdfDatatypeValXsdDecimal , typeNameXsdDecimal, namespaceXsdDecimal , axiomsXsdDecimal, rulesXsdDecimal , prefixXsdDecimal ) 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.MapXsdDecimal (mapXsdDecimal) import Swish.RDF.Datatype ( Datatype(..) , DatatypeVal(..) , DatatypeRel(..), DatatypeRelPr , altArgs , UnaryFnTable, unaryFnApp , BinaryFnTable, binaryFnApp , DatatypeMod(..) , makeVmod11inv, makeVmod11 , makeVmod21inv, makeVmod21 , makeVmod20 ) 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 qualified Data.Text as T import qualified Data.Text.Lazy.Builder as B ------------------------------------------------------------ -- Misc values ------------------------------------------------------------ -- Local name for Double datatype nameXsdDecimal :: T.Text nameXsdDecimal = "decimal" -- |Type name for xsd:double datatype typeNameXsdDecimal :: ScopedName typeNameXsdDecimal = makeNSScopedName namespaceXSD nameXsdDecimal -- |Namespace for xsd:double datatype functions namespaceXsdDecimal :: Namespace namespaceXsdDecimal = namespaceXsdType nameXsdDecimal ------------------------------------------------------------ -- Declare exported RDFDatatype value for xsd:double ------------------------------------------------------------ rdfDatatypeXsdDecimal :: RDFDatatype rdfDatatypeXsdDecimal = Datatype rdfDatatypeValXsdDecimal ------------------------------------------------------------ -- Implmentation of RDFDatatypeVal for xsd:double ------------------------------------------------------------ -- |Define Datatype value for @xsd:double@. -- -- Members of this datatype decimal 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. -- rdfDatatypeValXsdDecimal :: RDFDatatypeVal Double rdfDatatypeValXsdDecimal = DatatypeVal { tvalName = typeNameXsdDecimal , tvalRules = rdfRulesetXsdDecimal -- Ruleset RDFGraph , tvalMkRules = makeRDFDatatypeRestrictionRules rdfDatatypeValXsdDecimal -- RDFGraph -> [RDFRules] , tvalMkMods = makeRdfDtOpenVarBindingModifiers rdfDatatypeValXsdDecimal , tvalMap = mapXsdDecimal -- DatatypeMap Double , tvalRel = relXsdDecimal -- [DatatypeRel Double] , tvalMod = modXsdDecimal -- [DatatypeMod Double] } -- |relXsdDecimal contains arithmetic and other relations for xsd:double values. -- -- The functions are inspired by those defined by CWM as math: properties -- (). -- relXsdDecimal :: [DatatypeRel Double] relXsdDecimal = [ relXsdDecimalAbs , relXsdDecimalNeg , relXsdDecimalSum , relXsdDecimalDiff , relXsdDecimalProd , relXsdDecimalPower , relXsdDecimalEq , relXsdDecimalNe , relXsdDecimalLt , relXsdDecimalLe , relXsdDecimalGt , relXsdDecimalGe ] mkDecRel2 :: T.Text -> DatatypeRelPr Double -> UnaryFnTable Double -> DatatypeRel Double mkDecRel2 nam pr fns = DatatypeRel { dtRelName = makeNSScopedName namespaceXsdDecimal nam , dtRelFunc = altArgs pr fns unaryFnApp } mkDecRel3 :: T.Text -> DatatypeRelPr Double -> BinaryFnTable Double -> DatatypeRel Double mkDecRel3 nam pr fns = DatatypeRel { dtRelName = makeNSScopedName namespaceXsdDecimal nam , dtRelFunc = altArgs pr fns binaryFnApp } relXsdDecimalAbs :: DatatypeRel Double relXsdDecimalAbs = mkDecRel2 "abs" (const True) [ ( (>=0), [ (abs,1) ] ) , ( const True, [ (id,0), (negate,0) ] ) ] relXsdDecimalNeg :: DatatypeRel Double relXsdDecimalNeg = mkDecRel2 "neg" (const True) [ ( const True, [ (negate,1) ] ) , ( const True, [ (negate,0) ] ) ] relXsdDecimalSum :: DatatypeRel Double relXsdDecimalSum = mkDecRel3 "sum" (const True) [ ( const True, [ ((+),1,2) ] ) , ( const True, [ ((-),0,2) ] ) , ( const True, [ ((-),0,1) ] ) ] relXsdDecimalDiff :: DatatypeRel Double relXsdDecimalDiff = mkDecRel3 "diff" (const True) [ ( const True, [ ((-),1,2) ] ) , ( const True, [ ((+),0,2) ] ) , ( const True, [ ((-),1,0) ] ) ] relXsdDecimalProd :: DatatypeRel Double relXsdDecimalProd = mkDecRel3 "prod" (const True) [ ( const True, [ ((*),1,2) ] ) , ( const True, [ ((/),0,2) ] ) , ( const True, [ ((/),0,1) ] ) ] relXsdDecimalPower :: DatatypeRel Double relXsdDecimalPower = mkDecRel3 "power" (const True) [ ( const True, [ ((**),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 relXsdDecimalEq :: DatatypeRel Double relXsdDecimalEq = mkDecRel2 "eq" (lcomp (==)) ( repeat (const True, []) ) -- ne relXsdDecimalNe :: DatatypeRel Double relXsdDecimalNe = mkDecRel2 "ne" (lcomp (/=)) ( repeat (const True, []) ) -- lt relXsdDecimalLt :: DatatypeRel Double relXsdDecimalLt = mkDecRel2 "lt" (lcomp (<)) ( repeat (const True, []) ) -- le relXsdDecimalLe :: DatatypeRel Double relXsdDecimalLe = mkDecRel2 "le" (lcomp (<=)) ( repeat (const True, []) ) -- gt relXsdDecimalGt :: DatatypeRel Double relXsdDecimalGt = mkDecRel2 "gt" (lcomp (>)) ( repeat (const True, []) ) -- ge relXsdDecimalGe :: DatatypeRel Double relXsdDecimalGe = mkDecRel2 "ge" (lcomp (>=)) ( repeat (const True, []) ) -- |modXsdDecimal contains variable binding modifiers for xsd:double values. -- -- The functions are selected from those defined by CWM as math: -- properties -- (). -- modXsdDecimal :: [RDFDatatypeMod Double] modXsdDecimal = [ modXsdDecimalAbs , modXsdDecimalNeg , modXsdDecimalSum , modXsdDecimalDiff , modXsdDecimalProd , modXsdDecimalPower , modXsdDecimalEq , modXsdDecimalNe , modXsdDecimalLt , modXsdDecimalLe , modXsdDecimalGt , modXsdDecimalGe ] modXsdDecimalAbs :: RDFDatatypeMod Double modXsdDecimalAbs = DatatypeMod { dmName = makeNSScopedName namespaceXsdDecimal "abs" , dmModf = [ f0, f1 ] , dmAppf = makeVmod11 } where f0 vs@[v1,v2] = if v1 == abs v2 then vs else [] f0 _ = [] f1 [v2] = [abs v2] f1 _ = [] modXsdDecimalNeg :: RDFDatatypeMod Double modXsdDecimalNeg = DatatypeMod { dmName = makeNSScopedName namespaceXsdDecimal "neg" , dmModf = [ f0, f1, f1 ] , dmAppf = makeVmod11inv } where f0 vs@[v1,v2] = if v1 == negate v2 then vs else [] f0 _ = [] f1 [vi] = [-vi] f1 _ = [] modXsdDecimalSum :: RDFDatatypeMod Double modXsdDecimalSum = DatatypeMod { dmName = makeNSScopedName namespaceXsdDecimal "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 _ = [] modXsdDecimalDiff :: RDFDatatypeMod Double modXsdDecimalDiff = DatatypeMod { dmName = makeNSScopedName namespaceXsdDecimal "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 _ = [] modXsdDecimalProd :: RDFDatatypeMod Double modXsdDecimalProd = DatatypeMod { dmName = makeNSScopedName namespaceXsdDecimal "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] = [v1/vi] f2 _ = [] modXsdDecimalPower :: RDFDatatypeMod Double modXsdDecimalPower = DatatypeMod { dmName = makeNSScopedName namespaceXsdDecimal "power" , dmModf = [ f0, f1 ] , dmAppf = makeVmod21 } where f0 vs@[v1,v2,v3] = if v1 == (v2**v3 :: Double) then vs else [] f0 _ = [] f1 [v2,v3] = [v2**v3 :: Double] f1 _ = [] modXsdDecimalEq, modXsdDecimalNe, modXsdDecimalLt, modXsdDecimalLe, modXsdDecimalGt, modXsdDecimalGe :: RDFDatatypeMod Double modXsdDecimalEq = modXsdDecimalCompare "eq" (==) modXsdDecimalNe = modXsdDecimalCompare "ne" (/=) modXsdDecimalLt = modXsdDecimalCompare "lt" (<) modXsdDecimalLe = modXsdDecimalCompare "le" (<=) modXsdDecimalGt = modXsdDecimalCompare "gt" (>) modXsdDecimalGe = modXsdDecimalCompare "ge" (>=) modXsdDecimalCompare :: T.Text -> (Double->Double->Bool) -> RDFDatatypeMod Double modXsdDecimalCompare nam rel = DatatypeMod { dmName = makeNSScopedName namespaceXsdDecimal nam , dmModf = [ f0 ] , dmAppf = makeVmod20 } where f0 vs@[v1,v2] = if rel v1 v2 then vs else [] f0 _ = [] -- |rulesetXsdDecimal contains rules and axioms that allow additional -- deductions when xsd:double values appear in a graph. -- -- The rules defined here are concerned with basic decimal arithmetic -- operations: +, -, *, /, ** -- -- makeRuleset :: Namespace -> [Formula ex] -> [Rule ex] -> Ruleset ex -- rdfRulesetXsdDecimal :: RDFRuleset rdfRulesetXsdDecimal = makeRuleset namespaceXsdDecimal axiomsXsdDecimal rulesXsdDecimal mkPrefix :: Namespace -> B.Builder mkPrefix = namespaceToBuilder prefixXsdDecimal :: B.Builder prefixXsdDecimal = mconcat [ mkPrefix namespaceRDF , mkPrefix namespaceRDFS , mkPrefix namespaceRDFD , mkPrefix namespaceXSD , mkPrefix namespaceXsdDecimal ] mkAxiom :: T.Text -> B.Builder -> RDFFormula mkAxiom local gr = makeRDFFormula namespaceXsdDecimal local (prefixXsdDecimal `mappend` gr) axiomsXsdDecimal :: [RDFFormula] axiomsXsdDecimal = [ mkAxiom "dt" "xsd:double rdf:type rdfs:Datatype ." ] rulesXsdDecimal :: [RDFRule] rulesXsdDecimal = makeRDFDatatypeRestrictionRules rdfDatatypeValXsdDecimal gr where gr = makeRDFGraphFromN3Builder rulesXsdDecimalBuilder --- I have removed the newline which was added between each line --- to improve the clarity of parser errors. --- rulesXsdDecimalBuilder :: B.Builder rulesXsdDecimalBuilder = mconcat [ prefixXsdDecimal , "xsd_decimal:Abs a rdfd:GeneralRestriction ; " , " rdfd:onProperties (rdf:_1 rdf:_2) ; " , " rdfd:constraint xsd_decimal:abs ; " , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . " , "xsd_decimal:Neg a rdfd:GeneralRestriction ; " , " rdfd:onProperties (rdf:_1 rdf:_2) ; " , " rdfd:constraint xsd_decimal:neg ; " , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . " , "xsd_decimal:Sum a rdfd:GeneralRestriction ; " , " rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3) ; " , " rdfd:constraint xsd_decimal:sum ; " , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . " , "xsd_decimal:Diff a rdfd:GeneralRestriction ; " , " rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3) ; " , " rdfd:constraint xsd_decimal:diff ; " , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . " , "xsd_decimal:Prod a rdfd:GeneralRestriction ; " , " rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3) ; " , " rdfd:constraint xsd_decimal:prod ; " , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . " , "xsd_decimal:DivMod a rdfd:GeneralRestriction ; " , " rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3 rdf:_4) ; " , " rdfd:constraint xsd_decimal:divmod ; " , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . " , "xsd_decimal:Power a rdfd:GeneralRestriction ; " , " rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3) ; " , " rdfd:constraint xsd_decimal:power ; " , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . " , "xsd_decimal:Eq a rdfd:GeneralRestriction ; " , " rdfd:onProperties (rdf:_1 rdf:_2) ; " , " rdfd:constraint xsd_decimal:eq ; " , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . " , "xsd_decimal:Ne a rdfd:GeneralRestriction ; " , " rdfd:onProperties (rdf:_1 rdf:_2) ; " , " rdfd:constraint xsd_decimal:ne ; " , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . " , "xsd_decimal:Lt a rdfd:GeneralRestriction ; " , " rdfd:onProperties (rdf:_1 rdf:_2) ; " , " rdfd:constraint xsd_decimal:lt ; " , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . " , "xsd_decimal:Le a rdfd:GeneralRestriction ; " , " rdfd:onProperties (rdf:_1 rdf:_2) ; " , " rdfd:constraint xsd_decimal:le ; " , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . " , "xsd_decimal:Gt a rdfd:GeneralRestriction ; " , " rdfd:onProperties (rdf:_1 rdf:_2) ; " , " rdfd:constraint xsd_decimal:gt ; " , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . " , "xsd_decimal:Ge a rdfd:GeneralRestriction ; " , " rdfd:onProperties (rdf:_1 rdf:_2) ; " , " rdfd:constraint xsd_decimal:ge ; " , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . " ] -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, -- 2011 Douglas Burke, 2011 William Waites -- 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 -- --------------------------------------------------------------------------------