swish-0.6.4.0: src/Swish/RDF/RDFDatatypeXsdDecimal.hs
{-# 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
-- (<http://www.w3.org/2000/10/swap/doc/CwmBuiltins.html>).
--
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
-- (<http://www.w3.org/2000/10/swap/doc/CwmBuiltins.html>).
--
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
--
--------------------------------------------------------------------------------