{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -------------------------------------------------------------------------------- -- See end of this file for licence information. -------------------------------------------------------------------------------- -- | -- Module : Decimal -- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, -- 2011 William Waites, 2011, 2012, 2014 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke -- Stability : experimental -- Portability : CPP, OverloadedStrings -- -- This module defines the structures used to represent and -- manipulate RDF @xsd:decimal@ datatyped literals. -- -- Note that in versions @0.6.4@ and @0.6.5@, this module was a mixture -- of support for @xsd:decimal@ and @xsd:double@. In @0.7.0@ the module -- has been changed to @xsd:decimal@, but this may change. -- -------------------------------------------------------------------------------- -- NOTE: William's code is half about xsd:decimal and half xsd:double. -- I have changed it all to xsd:decimal since the rules do not handle some -- of the xsd:double specific conditions (e.g. NaN/Inf values). However, -- the values are mapped to Haskell Double values, which is not a good match -- for xsd:decimal. module Swish.RDF.Datatype.XSD.Decimal ( rdfDatatypeXsdDecimal , rdfDatatypeValXsdDecimal , typeNameXsdDecimal, namespaceXsdDecimal , axiomsXsdDecimal, rulesXsdDecimal ) where import Swish.Datatype ( Datatype(..) , DatatypeVal(..) , DatatypeRel(..), DatatypeRelPr , altArgs , UnaryFnTable, unaryFnApp , BinaryFnTable, binaryFnApp , DatatypeMod(..) , makeVmod11inv, makeVmod11 , makeVmod21inv, makeVmod21 , makeVmod20 ) import Swish.Namespace (Namespace, ScopedName) import Swish.Namespace (namespaceToBuilder, makeNSScopedName) import Swish.QName (LName) import Swish.Ruleset (makeRuleset) import Swish.RDF.Datatype (RDFDatatype, RDFDatatypeVal, RDFDatatypeMod) import Swish.RDF.Datatype (makeRdfDtOpenVarBindingModifiers) import Swish.RDF.Datatype.XSD.MapDecimal (mapXsdDecimal) import Swish.RDF.Ruleset (RDFFormula, RDFRule, RDFRuleset) import Swish.RDF.Ruleset (makeRDFGraphFromN3Builder, makeRDFFormula) import Swish.RDF.ClassRestrictionRule (makeRDFDatatypeRestrictionRules) import Swish.RDF.Vocabulary ( namespaceRDF , namespaceRDFS , namespaceRDFD , namespaceXSD , namespaceXsdType ) #if (!defined(__GLASGOW_HASKELL__)) || (__GLASGOW_HASKELL__ < 710) import Data.Monoid (Monoid(..)) #endif import qualified Data.Text.Lazy.Builder as B ------------------------------------------------------------ -- Misc values ------------------------------------------------------------ nameXsdDecimal :: LName nameXsdDecimal = "decimal" -- |Type name for @xsd:decimal@ datatype. typeNameXsdDecimal :: ScopedName typeNameXsdDecimal = makeNSScopedName namespaceXSD nameXsdDecimal -- | Namespace for @xsd:decimal@ datatype functions. namespaceXsdDecimal :: Namespace namespaceXsdDecimal = namespaceXsdType nameXsdDecimal -- | The RDFDatatype value for @xsd:decimal@. rdfDatatypeXsdDecimal :: RDFDatatype rdfDatatypeXsdDecimal = Datatype rdfDatatypeValXsdDecimal -- |Define Datatype value for @xsd:decimal@. -- -- Members of this datatype decimal values. -- -- The lexical form consists of an optional @+@ or @-@ -- followed by a sequence of decimal digits, an optional -- decimal point and 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:decimal 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 :: LName -> DatatypeRelPr Double -> UnaryFnTable Double -> DatatypeRel Double mkDecRel2 nam pr fns = DatatypeRel { dtRelName = makeNSScopedName namespaceXsdDecimal nam , dtRelFunc = altArgs pr fns unaryFnApp } mkDecRel3 :: LName -> 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:decimal 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 :: LName -> (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:decimal 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 prefixXsdDecimal :: B.Builder prefixXsdDecimal = mconcat $ map namespaceToBuilder [ namespaceRDF , namespaceRDFS , namespaceRDFD , namespaceXSD , namespaceXsdDecimal ] mkAxiom :: LName -> B.Builder -> RDFFormula mkAxiom local gr = makeRDFFormula namespaceXsdDecimal local (prefixXsdDecimal `mappend` gr) -- | The axioms for @xsd:decimal@, which are -- -- > xsd:decimal a rdfs:Datatype . -- axiomsXsdDecimal :: [RDFFormula] axiomsXsdDecimal = [ mkAxiom "dt" "xsd:decimal rdf:type rdfs:Datatype ." -- "xsd:double rdf:type rdfs:Datatype ." ] -- | The rules for @xsd:decimal@. -- 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 William Waites, 2011, 2012 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 -- --------------------------------------------------------------------------------