{-# 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, 2022 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 :: LName
nameXsdDecimal = LName
"decimal"

-- |Type name for @xsd:decimal@ datatype.
typeNameXsdDecimal :: ScopedName
typeNameXsdDecimal :: ScopedName
typeNameXsdDecimal  = Namespace -> LName -> ScopedName
makeNSScopedName Namespace
namespaceXSD LName
nameXsdDecimal

-- | Namespace for @xsd:decimal@ datatype functions.
namespaceXsdDecimal :: Namespace
namespaceXsdDecimal :: Namespace
namespaceXsdDecimal = LName -> Namespace
namespaceXsdType LName
nameXsdDecimal

-- | The RDFDatatype value for @xsd:decimal@.
rdfDatatypeXsdDecimal :: RDFDatatype
rdfDatatypeXsdDecimal :: RDFDatatype
rdfDatatypeXsdDecimal = forall ex lb vn vt. DatatypeVal ex vt lb vn -> Datatype ex lb vn
Datatype RDFDatatypeVal Double
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 :: RDFDatatypeVal Double
rdfDatatypeValXsdDecimal = DatatypeVal
    { tvalName :: ScopedName
tvalName      = ScopedName
typeNameXsdDecimal
    , tvalRules :: Ruleset RDFGraph
tvalRules     = Ruleset RDFGraph
rdfRulesetXsdDecimal  -- Ruleset RDFGraph
    , tvalMkRules :: RDFGraph -> [Rule RDFGraph]
tvalMkRules   = forall vt. RDFDatatypeVal vt -> RDFGraph -> [Rule RDFGraph]
makeRDFDatatypeRestrictionRules RDFDatatypeVal Double
rdfDatatypeValXsdDecimal
                                            -- RDFGraph -> [RDFRules]
    , tvalMkMods :: [OpenVarBindingModify RDFLabel RDFLabel]
tvalMkMods    = forall vt.
RDFDatatypeVal vt -> [OpenVarBindingModify RDFLabel RDFLabel]
makeRdfDtOpenVarBindingModifiers RDFDatatypeVal Double
rdfDatatypeValXsdDecimal
    , tvalMap :: DatatypeMap Double
tvalMap       = DatatypeMap Double
mapXsdDecimal         -- DatatypeMap Double
    , tvalRel :: [DatatypeRel Double]
tvalRel       = [DatatypeRel Double]
relXsdDecimal         -- [DatatypeRel Double]
    , tvalMod :: [DatatypeMod Double RDFLabel RDFLabel]
tvalMod       = [DatatypeMod Double RDFLabel RDFLabel]
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
--  (<http://www.w3.org/2000/10/swap/doc/CwmBuiltins.html>).
--
relXsdDecimal :: [DatatypeRel Double]
relXsdDecimal :: [DatatypeRel Double]
relXsdDecimal =
    [ DatatypeRel Double
relXsdDecimalAbs
    , DatatypeRel Double
relXsdDecimalNeg
    , DatatypeRel Double
relXsdDecimalSum
    , DatatypeRel Double
relXsdDecimalDiff
    , DatatypeRel Double
relXsdDecimalProd
    , DatatypeRel Double
relXsdDecimalPower
    , DatatypeRel Double
relXsdDecimalEq
    , DatatypeRel Double
relXsdDecimalNe
    , DatatypeRel Double
relXsdDecimalLt
    , DatatypeRel Double
relXsdDecimalLe
    , DatatypeRel Double
relXsdDecimalGt
    , DatatypeRel Double
relXsdDecimalGe
    ]

mkDecRel2 ::
    LName -> DatatypeRelPr Double -> UnaryFnTable Double
    -> DatatypeRel Double
mkDecRel2 :: LName
-> DatatypeRelPr Double
-> UnaryFnTable Double
-> DatatypeRel Double
mkDecRel2 LName
nam DatatypeRelPr Double
pr UnaryFnTable Double
fns = DatatypeRel
    { dtRelName :: ScopedName
dtRelName = Namespace -> LName -> ScopedName
makeNSScopedName Namespace
namespaceXsdDecimal LName
nam
    , dtRelFunc :: DatatypeRelFn Double
dtRelFunc = forall vt b.
Eq vt =>
DatatypeRelPr vt
-> [(vt -> Bool, [b])]
-> ((vt -> Bool) -> b -> [Maybe vt] -> Maybe [vt])
-> DatatypeRelFn vt
altArgs DatatypeRelPr Double
pr UnaryFnTable Double
fns forall a. UnaryFnApply a
unaryFnApp
    }

mkDecRel3 ::
    LName -> DatatypeRelPr Double -> BinaryFnTable Double
    -> DatatypeRel Double
mkDecRel3 :: LName
-> DatatypeRelPr Double
-> BinaryFnTable Double
-> DatatypeRel Double
mkDecRel3 LName
nam DatatypeRelPr Double
pr BinaryFnTable Double
fns = DatatypeRel
    { dtRelName :: ScopedName
dtRelName = Namespace -> LName -> ScopedName
makeNSScopedName Namespace
namespaceXsdDecimal LName
nam
    , dtRelFunc :: DatatypeRelFn Double
dtRelFunc = forall vt b.
Eq vt =>
DatatypeRelPr vt
-> [(vt -> Bool, [b])]
-> ((vt -> Bool) -> b -> [Maybe vt] -> Maybe [vt])
-> DatatypeRelFn vt
altArgs DatatypeRelPr Double
pr BinaryFnTable Double
fns forall a. BinaryFnApply a
binaryFnApp
    }

relXsdDecimalAbs :: DatatypeRel Double
relXsdDecimalAbs :: DatatypeRel Double
relXsdDecimalAbs = LName
-> DatatypeRelPr Double
-> UnaryFnTable Double
-> DatatypeRel Double
mkDecRel2 LName
"abs" (forall a b. a -> b -> a
const Bool
True)
    [ ( (forall a. Ord a => a -> a -> Bool
>= Double
0),     [ (forall a. Num a => a -> a
abs,Int
1) ] )
    , ( forall a b. a -> b -> a
const Bool
True, [ (forall a. a -> a
id,Int
0), (forall a. Num a => a -> a
negate,Int
0) ] )
    ]

relXsdDecimalNeg :: DatatypeRel Double
relXsdDecimalNeg :: DatatypeRel Double
relXsdDecimalNeg = LName
-> DatatypeRelPr Double
-> UnaryFnTable Double
-> DatatypeRel Double
mkDecRel2 LName
"neg" (forall a b. a -> b -> a
const Bool
True)
    [ ( forall a b. a -> b -> a
const Bool
True, [ (forall a. Num a => a -> a
negate,Int
1) ] )
    , ( forall a b. a -> b -> a
const Bool
True, [ (forall a. Num a => a -> a
negate,Int
0) ] )
    ]

relXsdDecimalSum :: DatatypeRel Double
relXsdDecimalSum :: DatatypeRel Double
relXsdDecimalSum = LName
-> DatatypeRelPr Double
-> BinaryFnTable Double
-> DatatypeRel Double
mkDecRel3 LName
"sum" (forall a b. a -> b -> a
const Bool
True)
    [ ( forall a b. a -> b -> a
const Bool
True, [ (forall a. Num a => a -> a -> a
(+),Int
1,Int
2) ] )
    , ( forall a b. a -> b -> a
const Bool
True, [ ((-),Int
0,Int
2) ] )
    , ( forall a b. a -> b -> a
const Bool
True, [ ((-),Int
0,Int
1) ] )
    ]

relXsdDecimalDiff :: DatatypeRel Double
relXsdDecimalDiff :: DatatypeRel Double
relXsdDecimalDiff = LName
-> DatatypeRelPr Double
-> BinaryFnTable Double
-> DatatypeRel Double
mkDecRel3 LName
"diff" (forall a b. a -> b -> a
const Bool
True)
    [ ( forall a b. a -> b -> a
const Bool
True, [ ((-),Int
1,Int
2) ] )
    , ( forall a b. a -> b -> a
const Bool
True, [ (forall a. Num a => a -> a -> a
(+),Int
0,Int
2) ] )
    , ( forall a b. a -> b -> a
const Bool
True, [ ((-),Int
1,Int
0) ] )
    ]

relXsdDecimalProd :: DatatypeRel Double
relXsdDecimalProd :: DatatypeRel Double
relXsdDecimalProd = LName
-> DatatypeRelPr Double
-> BinaryFnTable Double
-> DatatypeRel Double
mkDecRel3 LName
"prod" (forall a b. a -> b -> a
const Bool
True)
    [ ( forall a b. a -> b -> a
const Bool
True, [ (forall a. Num a => a -> a -> a
(*),Int
1,Int
2) ] )
    , ( forall a b. a -> b -> a
const Bool
True, [ (forall a. Fractional a => a -> a -> a
(/),Int
0,Int
2) ] )
    , ( forall a b. a -> b -> a
const Bool
True, [ (forall a. Fractional a => a -> a -> a
(/),Int
0,Int
1) ] )
    ]

relXsdDecimalPower :: DatatypeRel Double
relXsdDecimalPower :: DatatypeRel Double
relXsdDecimalPower = LName
-> DatatypeRelPr Double
-> BinaryFnTable Double
-> DatatypeRel Double
mkDecRel3 LName
"power" (forall a b. a -> b -> a
const Bool
True)
    [ ( forall a b. a -> b -> a
const Bool
True, [ (forall a. Floating a => a -> a -> a
(**),Int
1,Int
2) ] )
    , ( forall a b. a -> b -> a
const Bool
True, [ ] )
    , ( (forall a. Ord a => a -> a -> Bool
>= Double
0),     [ ] )
    ]

liftL2 :: (a->a->Bool) -> ([a]->a) -> ([a]->a) -> [a] -> Bool
liftL2 :: forall a.
(a -> a -> Bool) -> ([a] -> a) -> ([a] -> a) -> [a] -> Bool
liftL2 a -> a -> Bool
p [a] -> a
i1 [a] -> a
i2 [a]
as = a -> a -> Bool
p ([a] -> a
i1 [a]
as) ([a] -> a
i2 [a]
as)

lcomp :: (a->a->Bool) -> [a] -> Bool
lcomp :: forall a. (a -> a -> Bool) -> [a] -> Bool
lcomp a -> a -> Bool
p = forall a.
(a -> a -> Bool) -> ([a] -> a) -> ([a] -> a) -> [a] -> Bool
liftL2 a -> a -> Bool
p forall a. [a] -> a
head (forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
tail)

-- eq

relXsdDecimalEq :: DatatypeRel Double
relXsdDecimalEq :: DatatypeRel Double
relXsdDecimalEq = LName
-> DatatypeRelPr Double
-> UnaryFnTable Double
-> DatatypeRel Double
mkDecRel2 LName
"eq" (forall a. (a -> a -> Bool) -> [a] -> Bool
lcomp forall a. Eq a => a -> a -> Bool
(==))
    ( forall a. a -> [a]
repeat (forall a b. a -> b -> a
const Bool
True, []) )

-- ne

relXsdDecimalNe :: DatatypeRel Double
relXsdDecimalNe :: DatatypeRel Double
relXsdDecimalNe = LName
-> DatatypeRelPr Double
-> UnaryFnTable Double
-> DatatypeRel Double
mkDecRel2 LName
"ne" (forall a. (a -> a -> Bool) -> [a] -> Bool
lcomp forall a. Eq a => a -> a -> Bool
(/=))
    ( forall a. a -> [a]
repeat (forall a b. a -> b -> a
const Bool
True, []) )

-- lt

relXsdDecimalLt :: DatatypeRel Double
relXsdDecimalLt :: DatatypeRel Double
relXsdDecimalLt = LName
-> DatatypeRelPr Double
-> UnaryFnTable Double
-> DatatypeRel Double
mkDecRel2 LName
"lt" (forall a. (a -> a -> Bool) -> [a] -> Bool
lcomp forall a. Ord a => a -> a -> Bool
(<))
    ( forall a. a -> [a]
repeat (forall a b. a -> b -> a
const Bool
True, []) )

-- le

relXsdDecimalLe :: DatatypeRel Double
relXsdDecimalLe :: DatatypeRel Double
relXsdDecimalLe = LName
-> DatatypeRelPr Double
-> UnaryFnTable Double
-> DatatypeRel Double
mkDecRel2 LName
"le" (forall a. (a -> a -> Bool) -> [a] -> Bool
lcomp forall a. Ord a => a -> a -> Bool
(<=))
    ( forall a. a -> [a]
repeat (forall a b. a -> b -> a
const Bool
True, []) )

-- gt

relXsdDecimalGt :: DatatypeRel Double
relXsdDecimalGt :: DatatypeRel Double
relXsdDecimalGt = LName
-> DatatypeRelPr Double
-> UnaryFnTable Double
-> DatatypeRel Double
mkDecRel2 LName
"gt" (forall a. (a -> a -> Bool) -> [a] -> Bool
lcomp forall a. Ord a => a -> a -> Bool
(>))
    ( forall a. a -> [a]
repeat (forall a b. a -> b -> a
const Bool
True, []) )

-- ge

relXsdDecimalGe :: DatatypeRel Double
relXsdDecimalGe :: DatatypeRel Double
relXsdDecimalGe = LName
-> DatatypeRelPr Double
-> UnaryFnTable Double
-> DatatypeRel Double
mkDecRel2 LName
"ge" (forall a. (a -> a -> Bool) -> [a] -> Bool
lcomp forall a. Ord a => a -> a -> Bool
(>=))
    ( forall a. a -> [a]
repeat (forall a b. a -> b -> a
const Bool
True, []) )

-- |modXsdDecimal contains variable binding modifiers for xsd:decimal 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 :: [DatatypeMod Double RDFLabel RDFLabel]
modXsdDecimal =
    [ DatatypeMod Double RDFLabel RDFLabel
modXsdDecimalAbs
    , DatatypeMod Double RDFLabel RDFLabel
modXsdDecimalNeg
    , DatatypeMod Double RDFLabel RDFLabel
modXsdDecimalSum
    , DatatypeMod Double RDFLabel RDFLabel
modXsdDecimalDiff
    , DatatypeMod Double RDFLabel RDFLabel
modXsdDecimalProd
    , DatatypeMod Double RDFLabel RDFLabel
modXsdDecimalPower
    , DatatypeMod Double RDFLabel RDFLabel
modXsdDecimalEq
    , DatatypeMod Double RDFLabel RDFLabel
modXsdDecimalNe
    , DatatypeMod Double RDFLabel RDFLabel
modXsdDecimalLt
    , DatatypeMod Double RDFLabel RDFLabel
modXsdDecimalLe
    , DatatypeMod Double RDFLabel RDFLabel
modXsdDecimalGt
    , DatatypeMod Double RDFLabel RDFLabel
modXsdDecimalGe
    ]

modXsdDecimalAbs :: RDFDatatypeMod Double
modXsdDecimalAbs :: DatatypeMod Double RDFLabel RDFLabel
modXsdDecimalAbs = DatatypeMod
    { dmName :: ScopedName
dmName = Namespace -> LName -> ScopedName
makeNSScopedName Namespace
namespaceXsdDecimal LName
"abs"
    , dmModf :: [ModifierFn Double]
dmModf = [ forall {a}. (Eq a, Num a) => [a] -> [a]
f0, forall {a}. Num a => [a] -> [a]
f1 ]
    , dmAppf :: ApplyModifier RDFLabel RDFLabel
dmAppf = forall lb vn. (Ord lb, Ord vn) => ApplyModifier lb vn
makeVmod11
    }
    where
        f0 :: [a] -> [a]
f0 vs :: [a]
vs@[a
v1,a
v2] = if a
v1 forall a. Eq a => a -> a -> Bool
== forall a. Num a => a -> a
abs a
v2 then [a]
vs else []
        f0 [a]
_          = []
        f1 :: [a] -> [a]
f1 [a
v2]       = [forall a. Num a => a -> a
abs a
v2]
        f1 [a]
_          = []

modXsdDecimalNeg :: RDFDatatypeMod Double
modXsdDecimalNeg :: DatatypeMod Double RDFLabel RDFLabel
modXsdDecimalNeg = DatatypeMod
    { dmName :: ScopedName
dmName = Namespace -> LName -> ScopedName
makeNSScopedName Namespace
namespaceXsdDecimal LName
"neg"
    , dmModf :: [ModifierFn Double]
dmModf = [ forall {a}. (Eq a, Num a) => [a] -> [a]
f0, forall {a}. Num a => [a] -> [a]
f1, forall {a}. Num a => [a] -> [a]
f1 ]
    , dmAppf :: ApplyModifier RDFLabel RDFLabel
dmAppf = forall lb vn. (Ord lb, Ord vn) => ApplyModifier lb vn
makeVmod11inv
    }
    where
        f0 :: [a] -> [a]
f0 vs :: [a]
vs@[a
v1,a
v2] = if a
v1 forall a. Eq a => a -> a -> Bool
== forall a. Num a => a -> a
negate a
v2 then [a]
vs else []
        f0 [a]
_          = []
        f1 :: [a] -> [a]
f1 [a
vi]       = [-a
vi]
        f1 [a]
_          = []

modXsdDecimalSum :: RDFDatatypeMod Double
modXsdDecimalSum :: DatatypeMod Double RDFLabel RDFLabel
modXsdDecimalSum = DatatypeMod
    { dmName :: ScopedName
dmName = Namespace -> LName -> ScopedName
makeNSScopedName Namespace
namespaceXsdDecimal LName
"sum"
    , dmModf :: [ModifierFn Double]
dmModf = [ forall {a}. (Eq a, Num a) => [a] -> [a]
f0, forall {a}. Num a => [a] -> [a]
f1, forall {a}. Num a => [a] -> [a]
f2, forall {a}. Num a => [a] -> [a]
f2 ]
    , dmAppf :: ApplyModifier RDFLabel RDFLabel
dmAppf = forall lb vn. (Ord lb, Ord vn) => ApplyModifier lb vn
makeVmod21inv
    }
    where
        f0 :: [a] -> [a]
f0 vs :: [a]
vs@[a
v1,a
v2,a
v3] = if a
v1 forall a. Eq a => a -> a -> Bool
== a
v2 forall a. Num a => a -> a -> a
+ a
v3 then [a]
vs else []
        f0 [a]
_             = []
        f1 :: [a] -> [a]
f1 [a
v2,a
v3]       = [a
v2 forall a. Num a => a -> a -> a
+ a
v3]
        f1 [a]
_             = []
        f2 :: [a] -> [a]
f2 [a
v1,a
vi]       = [a
v1 forall a. Num a => a -> a -> a
- a
vi]
        f2 [a]
_             = []

modXsdDecimalDiff :: RDFDatatypeMod Double
modXsdDecimalDiff :: DatatypeMod Double RDFLabel RDFLabel
modXsdDecimalDiff = DatatypeMod
    { dmName :: ScopedName
dmName = Namespace -> LName -> ScopedName
makeNSScopedName Namespace
namespaceXsdDecimal LName
"diff"
    , dmModf :: [ModifierFn Double]
dmModf = [ forall {a}. (Eq a, Num a) => [a] -> [a]
f0, forall {a}. Num a => [a] -> [a]
f1, forall {a}. Num a => [a] -> [a]
f2, forall {a}. Num a => [a] -> [a]
f3 ]
    , dmAppf :: ApplyModifier RDFLabel RDFLabel
dmAppf = forall lb vn. (Ord lb, Ord vn) => ApplyModifier lb vn
makeVmod21inv
    }
    where
        f0 :: [a] -> [a]
f0 vs :: [a]
vs@[a
v1,a
v2,a
v3] = if a
v1 forall a. Eq a => a -> a -> Bool
== a
v2 forall a. Num a => a -> a -> a
- a
v3 then [a]
vs else []
        f0 [a]
_             = []
        f1 :: [a] -> [a]
f1 [a
v2,a
v3]       = [a
v2 forall a. Num a => a -> a -> a
- a
v3]
        f1 [a]
_             = []
        f2 :: [a] -> [a]
f2 [a
v1,a
v3]       = [a
v1 forall a. Num a => a -> a -> a
+ a
v3]
        f2 [a]
_             = []
        f3 :: [a] -> [a]
f3 [a
v1,a
v2]       = [a
v2 forall a. Num a => a -> a -> a
- a
v1]
        f3 [a]
_             = []

modXsdDecimalProd :: RDFDatatypeMod Double
modXsdDecimalProd :: DatatypeMod Double RDFLabel RDFLabel
modXsdDecimalProd = DatatypeMod
    { dmName :: ScopedName
dmName = Namespace -> LName -> ScopedName
makeNSScopedName Namespace
namespaceXsdDecimal LName
"prod"
    , dmModf :: [ModifierFn Double]
dmModf = [ forall {a}. (Eq a, Num a) => [a] -> [a]
f0, forall {a}. Num a => [a] -> [a]
f1, forall {a}. Fractional a => [a] -> [a]
f2, forall {a}. Fractional a => [a] -> [a]
f2 ]
    , dmAppf :: ApplyModifier RDFLabel RDFLabel
dmAppf = forall lb vn. (Ord lb, Ord vn) => ApplyModifier lb vn
makeVmod21inv
    }
    where
        f0 :: [a] -> [a]
f0 vs :: [a]
vs@[a
v1,a
v2,a
v3] = if a
v1 forall a. Eq a => a -> a -> Bool
== a
v2 forall a. Num a => a -> a -> a
* a
v3 then [a]
vs else []
        f0 [a]
_             = []
        f1 :: [a] -> [a]
f1 [a
v2,a
v3]       = [a
v2 forall a. Num a => a -> a -> a
* a
v3]
        f1 [a]
_             = []
        f2 :: [a] -> [a]
f2 [a
v1,a
vi]       = [a
v1 forall a. Fractional a => a -> a -> a
/ a
vi]
        f2 [a]
_             = []

modXsdDecimalPower :: RDFDatatypeMod Double
modXsdDecimalPower :: DatatypeMod Double RDFLabel RDFLabel
modXsdDecimalPower = DatatypeMod
    { dmName :: ScopedName
dmName = Namespace -> LName -> ScopedName
makeNSScopedName Namespace
namespaceXsdDecimal LName
"power"
    , dmModf :: [ModifierFn Double]
dmModf = [ ModifierFn Double
f0, ModifierFn Double
f1 ]
    , dmAppf :: ApplyModifier RDFLabel RDFLabel
dmAppf = forall lb vn. (Ord lb, Ord vn) => ApplyModifier lb vn
makeVmod21
    }
    where
        f0 :: ModifierFn Double
f0 vs :: [Double]
vs@[Double
v1,Double
v2,Double
v3] = if Double
v1 forall a. Eq a => a -> a -> Bool
== (Double
v2 forall a. Floating a => a -> a -> a
** Double
v3 :: Double) then [Double]
vs else []
        f0 [Double]
_             = []
        f1 :: ModifierFn Double
f1 [Double
v2,Double
v3]       = [Double
v2 forall a. Floating a => a -> a -> a
** Double
v3 :: Double]
        f1 [Double]
_             = []

modXsdDecimalEq, modXsdDecimalNe, modXsdDecimalLt, modXsdDecimalLe, modXsdDecimalGt, modXsdDecimalGe :: RDFDatatypeMod Double 
modXsdDecimalEq :: DatatypeMod Double RDFLabel RDFLabel
modXsdDecimalEq = LName
-> (Double -> Double -> Bool)
-> DatatypeMod Double RDFLabel RDFLabel
modXsdDecimalCompare LName
"eq" forall a. Eq a => a -> a -> Bool
(==)
modXsdDecimalNe :: DatatypeMod Double RDFLabel RDFLabel
modXsdDecimalNe = LName
-> (Double -> Double -> Bool)
-> DatatypeMod Double RDFLabel RDFLabel
modXsdDecimalCompare LName
"ne" forall a. Eq a => a -> a -> Bool
(/=)
modXsdDecimalLt :: DatatypeMod Double RDFLabel RDFLabel
modXsdDecimalLt = LName
-> (Double -> Double -> Bool)
-> DatatypeMod Double RDFLabel RDFLabel
modXsdDecimalCompare LName
"lt" forall a. Ord a => a -> a -> Bool
(<)
modXsdDecimalLe :: DatatypeMod Double RDFLabel RDFLabel
modXsdDecimalLe = LName
-> (Double -> Double -> Bool)
-> DatatypeMod Double RDFLabel RDFLabel
modXsdDecimalCompare LName
"le" forall a. Ord a => a -> a -> Bool
(<=)
modXsdDecimalGt :: DatatypeMod Double RDFLabel RDFLabel
modXsdDecimalGt = LName
-> (Double -> Double -> Bool)
-> DatatypeMod Double RDFLabel RDFLabel
modXsdDecimalCompare LName
"gt" forall a. Ord a => a -> a -> Bool
(>)
modXsdDecimalGe :: DatatypeMod Double RDFLabel RDFLabel
modXsdDecimalGe = LName
-> (Double -> Double -> Bool)
-> DatatypeMod Double RDFLabel RDFLabel
modXsdDecimalCompare LName
"ge" forall a. Ord a => a -> a -> Bool
(>=)

modXsdDecimalCompare ::
    LName -> (Double->Double->Bool) -> RDFDatatypeMod Double
modXsdDecimalCompare :: LName
-> (Double -> Double -> Bool)
-> DatatypeMod Double RDFLabel RDFLabel
modXsdDecimalCompare LName
nam Double -> Double -> Bool
rel = DatatypeMod
    { dmName :: ScopedName
dmName = Namespace -> LName -> ScopedName
makeNSScopedName Namespace
namespaceXsdDecimal LName
nam
    , dmModf :: [ModifierFn Double]
dmModf = [ ModifierFn Double
f0 ]
    , dmAppf :: ApplyModifier RDFLabel RDFLabel
dmAppf = forall lb vn.
(Eq lb, Show lb, Eq vn, Show vn) =>
ApplyModifier lb vn
makeVmod20
    }
    where
        f0 :: ModifierFn Double
f0 vs :: [Double]
vs@[Double
v1,Double
v2] = if Double -> Double -> Bool
rel Double
v1 Double
v2 then [Double]
vs else []
        f0 [Double]
_          = []

-- |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 :: Ruleset RDFGraph
rdfRulesetXsdDecimal =
    forall ex. Namespace -> [Formula ex] -> [Rule ex] -> Ruleset ex
makeRuleset Namespace
namespaceXsdDecimal [RDFFormula]
axiomsXsdDecimal [Rule RDFGraph]
rulesXsdDecimal

prefixXsdDecimal :: B.Builder
prefixXsdDecimal :: Builder
prefixXsdDecimal = 
  forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Namespace -> Builder
namespaceToBuilder
              [ Namespace
namespaceRDF
              , Namespace
namespaceRDFS
              , Namespace
namespaceRDFD
              , Namespace
namespaceXSD
              , Namespace
namespaceXsdDecimal
              ]

mkAxiom :: LName -> B.Builder -> RDFFormula
mkAxiom :: LName -> Builder -> RDFFormula
mkAxiom LName
local Builder
gr =
    Namespace -> LName -> Builder -> RDFFormula
makeRDFFormula Namespace
namespaceXsdDecimal LName
local (Builder
prefixXsdDecimal forall a. Monoid a => a -> a -> a
`mappend` Builder
gr)

-- | The axioms for @xsd:decimal@, which are
--
-- > xsd:decimal a rdfs:Datatype .
--
axiomsXsdDecimal :: [RDFFormula]
axiomsXsdDecimal :: [RDFFormula]
axiomsXsdDecimal =
    [ LName -> Builder -> RDFFormula
mkAxiom LName
"dt"
                  Builder
"xsd:decimal rdf:type rdfs:Datatype ."
                  -- "xsd:double rdf:type rdfs:Datatype ."
    ]

-- | The rules for @xsd:decimal@.
--
rulesXsdDecimal :: [RDFRule]
rulesXsdDecimal :: [Rule RDFGraph]
rulesXsdDecimal = forall vt. RDFDatatypeVal vt -> RDFGraph -> [Rule RDFGraph]
makeRDFDatatypeRestrictionRules RDFDatatypeVal Double
rdfDatatypeValXsdDecimal RDFGraph
gr
    where
        gr :: RDFGraph
gr = Builder -> RDFGraph
makeRDFGraphFromN3Builder Builder
rulesXsdDecimalBuilder

--- I have removed the newline which was added between each line
--- to improve the clarity of parser errors.
---
rulesXsdDecimalBuilder :: B.Builder
rulesXsdDecimalBuilder :: Builder
rulesXsdDecimalBuilder = 
  forall a. Monoid a => [a] -> a
mconcat
  [ Builder
prefixXsdDecimal
    , Builder
"xsd_decimal:Abs a rdfd:GeneralRestriction ; "
    , Builder
"  rdfd:onProperties (rdf:_1 rdf:_2) ; "
    , Builder
"  rdfd:constraint xsd_decimal:abs ; "
    , Builder
"  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
    , Builder
"xsd_decimal:Neg a rdfd:GeneralRestriction ; "
    , Builder
"  rdfd:onProperties (rdf:_1 rdf:_2) ; "
    , Builder
"  rdfd:constraint xsd_decimal:neg ; "
    , Builder
"  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
    , Builder
"xsd_decimal:Sum a rdfd:GeneralRestriction ; "
    , Builder
"  rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3) ; "
    , Builder
"  rdfd:constraint xsd_decimal:sum ; "
    , Builder
"  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
    , Builder
"xsd_decimal:Diff a rdfd:GeneralRestriction ; "
    , Builder
"  rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3) ; "
    , Builder
"  rdfd:constraint xsd_decimal:diff ; "
    , Builder
"  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
    , Builder
"xsd_decimal:Prod a rdfd:GeneralRestriction ; "
    , Builder
"  rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3) ; "
    , Builder
"  rdfd:constraint xsd_decimal:prod ; "
    , Builder
"  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
    , Builder
"xsd_decimal:DivMod a rdfd:GeneralRestriction ; "
    , Builder
"  rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3 rdf:_4) ; "
    , Builder
"  rdfd:constraint xsd_decimal:divmod ; "
    , Builder
"  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
    , Builder
"xsd_decimal:Power a rdfd:GeneralRestriction ; "
    , Builder
"  rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3) ; "
    , Builder
"  rdfd:constraint xsd_decimal:power ; "
    , Builder
"  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
    , Builder
"xsd_decimal:Eq a rdfd:GeneralRestriction ; "
    , Builder
"  rdfd:onProperties (rdf:_1 rdf:_2) ; "
    , Builder
"  rdfd:constraint xsd_decimal:eq ; "
    , Builder
"  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
    , Builder
"xsd_decimal:Ne a rdfd:GeneralRestriction ; "
    , Builder
"  rdfd:onProperties (rdf:_1 rdf:_2) ; "
    , Builder
"  rdfd:constraint xsd_decimal:ne ; "
    , Builder
"  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
    , Builder
"xsd_decimal:Lt a rdfd:GeneralRestriction ; "
    , Builder
"  rdfd:onProperties (rdf:_1 rdf:_2) ; "
    , Builder
"  rdfd:constraint xsd_decimal:lt ; "
    , Builder
"  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
    , Builder
"xsd_decimal:Le a rdfd:GeneralRestriction ; "
    , Builder
"  rdfd:onProperties (rdf:_1 rdf:_2) ; "
    , Builder
"  rdfd:constraint xsd_decimal:le ; "
    , Builder
"  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
    , Builder
"xsd_decimal:Gt a rdfd:GeneralRestriction ; "
    , Builder
"  rdfd:onProperties (rdf:_1 rdf:_2) ; "
    , Builder
"  rdfd:constraint xsd_decimal:gt ; "
    , Builder
"  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
    , Builder
"xsd_decimal:Ge a rdfd:GeneralRestriction ; "
    , Builder
"  rdfd:onProperties (rdf:_1 rdf:_2) ; "
    , Builder
"  rdfd:constraint xsd_decimal:ge ; "
    , Builder
"  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
    ]
  
--------------------------------------------------------------------------------
--
--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,
--                2011 William Waites, 2011, 2012, 2014, 2022 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
--
--------------------------------------------------------------------------------