{-# 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
--
--------------------------------------------------------------------------------