{-# LANGUAGE OverloadedStrings #-}

--------------------------------------------------------------------------------
--  See end of this file for licence information.
--------------------------------------------------------------------------------
-- |
--  Module      :  Integer
--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012 Douglas Burke
--  License     :  GPL V2
--
--  Maintainer  :  Douglas Burke
--  Stability   :  experimental
--  Portability :  OverloadedStrings
--
--  This module defines the structures used to represent and
--  manipulate RDF @xsd:integer@ datatyped literals.
--
--------------------------------------------------------------------------------

module Swish.RDF.Datatype.XSD.Integer
    ( rdfDatatypeXsdInteger
    , rdfDatatypeValXsdInteger
    , typeNameXsdInteger, namespaceXsdInteger
    , axiomsXsdInteger, rulesXsdInteger
    )
where

import Swish.Datatype
    ( Datatype(..)
    , DatatypeVal(..)
    , DatatypeRel(..), DatatypeRelPr
    , altArgs
    , UnaryFnTable,    unaryFnApp
    , BinaryFnTable,   binaryFnApp
    , BinMaybeFnTable, binMaybeFnApp
    , DatatypeMod(..) 
    , makeVmod11inv, makeVmod11
    , makeVmod21inv, makeVmod21
    , makeVmod20
    , makeVmod22
    )
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.MapInteger (mapXsdInteger)

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
    )

import Data.Monoid(Monoid(..))
import Control.Monad (liftM)
import Data.Maybe (maybeToList)

import qualified Data.Text.Lazy.Builder as B

------------------------------------------------------------
--  Misc values
------------------------------------------------------------

--  Local name for Integer datatype
nameXsdInteger :: LName
nameXsdInteger = "integer"

-- |Type name for @xsd:integer@ datatype.
typeNameXsdInteger :: ScopedName
typeNameXsdInteger  = makeNSScopedName namespaceXSD nameXsdInteger

-- |Namespace for @xsd:integer@ datatype functions.
namespaceXsdInteger :: Namespace
namespaceXsdInteger = namespaceXsdType nameXsdInteger

-- | The RDFDatatype value for @xsd:integer@.
rdfDatatypeXsdInteger :: RDFDatatype
rdfDatatypeXsdInteger = Datatype rdfDatatypeValXsdInteger

--  Integer power (exponentiation) function
--  returns Nothing if exponent is negative.
--
intPower :: Integer -> Integer -> Maybe Integer
intPower a b = if b < 0 then Nothing else Just (intPower1 a b)
    where
        intPower1 x y
            | q == 1           = atopsq*x
            | p == 0           = 1
            | otherwise        = atopsq
            where
                (p,q)  = y `divMod` 2
                atop   = intPower1 x p
                atopsq = atop*atop

------------------------------------------------------------
--  Implmentation of RDFDatatypeVal for xsd:integer
------------------------------------------------------------

-- |Define Datatype value for @xsd:integer@.
--
--  Members of this datatype are positive or negative integer 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.
--
rdfDatatypeValXsdInteger :: RDFDatatypeVal Integer
rdfDatatypeValXsdInteger = DatatypeVal
    { tvalName      = typeNameXsdInteger
    , tvalRules     = rdfRulesetXsdInteger  -- Ruleset RDFGraph
    , tvalMkRules   = makeRDFDatatypeRestrictionRules rdfDatatypeValXsdInteger
                                            -- RDFGraph -> [RDFRules]
    , tvalMkMods    = makeRdfDtOpenVarBindingModifiers rdfDatatypeValXsdInteger
    , tvalMap       = mapXsdInteger         -- DatatypeMap Integer
    , tvalRel       = relXsdInteger         -- [DatatypeRel Integer]
    , tvalMod       = modXsdInteger         -- [DatatypeMod Integer]
    }

-- |relXsdInteger contains arithmetic and other relations for xsd:Integer values.
--
--  The functions are inspired by those defined by CWM as math: properties
--  (<http://www.w3.org/2000/10/swap/doc/CwmBuiltins.html>).
--
relXsdInteger :: [DatatypeRel Integer]
relXsdInteger =
    [ relXsdIntegerAbs
    , relXsdIntegerNeg
    , relXsdIntegerSum
    , relXsdIntegerDiff
    , relXsdIntegerProd
    , relXsdIntegerDivMod
    , relXsdIntegerPower
    , relXsdIntegerEq
    , relXsdIntegerNe
    , relXsdIntegerLt
    , relXsdIntegerLe
    , relXsdIntegerGt
    , relXsdIntegerGe
    ]

mkIntRel2 ::
    LName -> DatatypeRelPr Integer -> UnaryFnTable Integer
    -> DatatypeRel Integer
mkIntRel2 nam pr fns = DatatypeRel
    { dtRelName = makeNSScopedName namespaceXsdInteger nam
    , dtRelFunc = altArgs pr fns unaryFnApp
    }

mkIntRel3 ::
    LName -> DatatypeRelPr Integer -> BinaryFnTable Integer
    -> DatatypeRel Integer
mkIntRel3 nam pr fns = DatatypeRel
    { dtRelName = makeNSScopedName namespaceXsdInteger nam
    , dtRelFunc = altArgs pr fns binaryFnApp
    }

mkIntRel3maybe ::
    LName -> DatatypeRelPr Integer -> BinMaybeFnTable Integer
    -> DatatypeRel Integer
mkIntRel3maybe nam pr fns = DatatypeRel
    { dtRelName = makeNSScopedName namespaceXsdInteger nam
    , dtRelFunc = altArgs pr fns binMaybeFnApp
    }

relXsdIntegerAbs :: DatatypeRel Integer
relXsdIntegerAbs = mkIntRel2 "abs" (const True)
    [ ( (>=0),      [ (abs,1) ] )
    , ( const True, [ (id,0), (negate,0) ] )
    ]

relXsdIntegerNeg :: DatatypeRel Integer
relXsdIntegerNeg = mkIntRel2 "neg" (const True)
    [ ( const True, [ (negate,1) ] )
    , ( const True, [ (negate,0) ] )
    ]

relXsdIntegerSum :: DatatypeRel Integer
relXsdIntegerSum = mkIntRel3 "sum" (const True)
    [ ( const True, [ ((+),1,2) ] )
    , ( const True, [ ((-),0,2) ] )
    , ( const True, [ ((-),0,1) ] )
    ]

relXsdIntegerDiff :: DatatypeRel Integer
relXsdIntegerDiff = mkIntRel3 "diff" (const True)
    [ ( const True, [ ((-),1,2) ] )
    , ( const True, [ ((+),0,2) ] )
    , ( const True, [ ((-),1,0) ] )
    ]

relXsdIntegerProd :: DatatypeRel Integer
relXsdIntegerProd = mkIntRel3 "prod" (const True)
    [ ( const True, [ ((*),1,2) ] )
    , ( const True, [ (div,0,2) ] )
    , ( const True, [ (div,0,1) ] )
    ]

relXsdIntegerDivMod :: DatatypeRel Integer
relXsdIntegerDivMod = mkIntRel3 "divmod" (const True)
    [ ( const True, [ (div,2,3) ] )
    , ( const True, [ (mod,2,3) ] )
    , ( const True, [ ] )
    , ( const True, [ ] )
    ]

--  Compose with function of two arguments
c2 :: (b -> c) -> (a -> d -> b) -> a -> d -> c
c2 = (.) . (.)

relXsdIntegerPower :: DatatypeRel Integer
relXsdIntegerPower = mkIntRel3maybe "power" (const True)
    [ ( const True, [ (liftM (:[]) `c2` intPower,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

relXsdIntegerEq :: DatatypeRel Integer
relXsdIntegerEq = mkIntRel2 "eq" (lcomp (==))
    ( repeat (const True, []) )

-- ne

relXsdIntegerNe :: DatatypeRel Integer
relXsdIntegerNe = mkIntRel2 "ne" (lcomp (/=))
    ( repeat (const True, []) )

-- lt

relXsdIntegerLt :: DatatypeRel Integer
relXsdIntegerLt = mkIntRel2 "lt" (lcomp (<))
    ( repeat (const True, []) )

-- le

relXsdIntegerLe :: DatatypeRel Integer
relXsdIntegerLe = mkIntRel2 "le" (lcomp (<=))
    ( repeat (const True, []) )

-- gt

relXsdIntegerGt :: DatatypeRel Integer
relXsdIntegerGt = mkIntRel2 "gt" (lcomp (>))
    ( repeat (const True, []) )

-- ge

relXsdIntegerGe :: DatatypeRel Integer
relXsdIntegerGe = mkIntRel2 "ge" (lcomp (>=))
    ( repeat (const True, []) )

-- |modXsdInteger contains variable binding modifiers for xsd:Integer values.
--
--  The functions are selected from those defined by CWM as math:
--  properties
--  (<http://www.w3.org/2000/10/swap/doc/CwmBuiltins.html>).
--
modXsdInteger :: [RDFDatatypeMod Integer]
modXsdInteger =
    [ modXsdIntegerAbs
    , modXsdIntegerNeg
    , modXsdIntegerSum
    , modXsdIntegerDiff
    , modXsdIntegerProd
    , modXsdIntegerDivMod
    , modXsdIntegerPower
    , modXsdIntegerEq
    , modXsdIntegerNe
    , modXsdIntegerLt
    , modXsdIntegerLe
    , modXsdIntegerGt
    , modXsdIntegerGe
    ]

modXsdIntegerAbs :: RDFDatatypeMod Integer
modXsdIntegerAbs = DatatypeMod
    { dmName = makeNSScopedName namespaceXsdInteger "abs"
    , dmModf = [ f0, f1 ]
    , dmAppf = makeVmod11
    }
    where
        f0 vs@[v1,v2] = if v1 == abs v2 then vs else []
        f0 _          = []
        f1 [v2]       = [abs v2]
        f1 _          = []

modXsdIntegerNeg :: RDFDatatypeMod Integer
modXsdIntegerNeg = DatatypeMod
    { dmName = makeNSScopedName namespaceXsdInteger "neg"
    , dmModf = [ f0, f1, f1 ]
    , dmAppf = makeVmod11inv
    }
    where
        f0 vs@[v1,v2] = if v1 == negate v2 then vs else []
        f0 _          = []
        f1 [vi]       = [-vi]
        f1 _          = []

modXsdIntegerSum :: RDFDatatypeMod Integer
modXsdIntegerSum = DatatypeMod
    { dmName = makeNSScopedName namespaceXsdInteger "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 _             = []

modXsdIntegerDiff :: RDFDatatypeMod Integer
modXsdIntegerDiff = DatatypeMod
    { dmName = makeNSScopedName namespaceXsdInteger "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 _             = []

modXsdIntegerProd :: RDFDatatypeMod Integer
modXsdIntegerProd = DatatypeMod
    { dmName = makeNSScopedName namespaceXsdInteger "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]       = [q | r == 0]
            where (q,r)  = quotRem v1 vi
        f2 _             = []

modXsdIntegerDivMod :: RDFDatatypeMod Integer
modXsdIntegerDivMod = DatatypeMod
    { dmName = makeNSScopedName namespaceXsdInteger "divmod"
    , dmModf = [ f0, f1 ]
    , dmAppf = makeVmod22
    }
    where
        f0 vs@[v1,v2,v3,v4] = if (v1,v2) == divMod v3 v4 then vs else []
        f0 _                = []
        f1 [v3,v4]          = [v1,v2] where (v1,v2) = divMod v3 v4
        f1 _                = []

modXsdIntegerPower :: RDFDatatypeMod Integer
modXsdIntegerPower = DatatypeMod
    { dmName = makeNSScopedName namespaceXsdInteger "power"
    , dmModf = [ f0, f1 ]
    , dmAppf = makeVmod21
    }
    where
        f0 vs@[v1,v2,v3] = if Just v1 == intPower v2 v3 then vs else []
        f0 _             = []
        f1 [v2,v3]       = maybeToList (intPower v2 v3)
        f1 _             = []

modXsdIntegerEq, modXsdIntegerNe, modXsdIntegerLt, modXsdIntegerLe, modXsdIntegerGt, modXsdIntegerGe :: RDFDatatypeMod Integer 
modXsdIntegerEq = modXsdIntegerCompare "eq" (==)
modXsdIntegerNe = modXsdIntegerCompare "ne" (/=)
modXsdIntegerLt = modXsdIntegerCompare "lt" (<)
modXsdIntegerLe = modXsdIntegerCompare "le" (<=)
modXsdIntegerGt = modXsdIntegerCompare "gt" (>)
modXsdIntegerGe = modXsdIntegerCompare "ge" (>=)

modXsdIntegerCompare ::
    LName -> (Integer->Integer->Bool) -> RDFDatatypeMod Integer
modXsdIntegerCompare nam rel = DatatypeMod
    { dmName = makeNSScopedName namespaceXsdInteger nam
    , dmModf = [ f0 ]
    , dmAppf = makeVmod20
    }
    where
        f0 vs@[v1,v2] = if rel v1 v2 then vs else []
        f0 _          = []

-- |rulesetXsdInteger contains rules and axioms that allow additional
--  deductions when xsd:integer values appear in a graph.
--
--  The rules defined here are concerned with basic integer arithmetic
--  operations: +, -, *, div, rem
--
--  makeRuleset :: Namespace -> [Formula ex] -> [Rule ex] -> Ruleset ex
--
rdfRulesetXsdInteger :: RDFRuleset
rdfRulesetXsdInteger =
    makeRuleset namespaceXsdInteger axiomsXsdInteger rulesXsdInteger

prefixXsdInteger :: B.Builder
prefixXsdInteger = 
  mconcat $ map namespaceToBuilder
              [ namespaceRDF
              , namespaceRDFS
              , namespaceRDFD
              , namespaceXSD
              , namespaceXsdInteger
              ]

mkAxiom :: LName -> B.Builder -> RDFFormula
mkAxiom local gr =
    makeRDFFormula namespaceXsdInteger local (prefixXsdInteger `mappend` gr)

-- | The axioms for @xsd:integer@, which are
--
-- > xsd:integer a rdfs:Datatype .
--
axiomsXsdInteger :: [RDFFormula]
axiomsXsdInteger =
    [ mkAxiom "dt"      "xsd:integer rdf:type rdfs:Datatype ."
    ]

-- | The rules for @xsd:integer@.
rulesXsdInteger :: [RDFRule]
rulesXsdInteger = makeRDFDatatypeRestrictionRules rdfDatatypeValXsdInteger gr
    where
        gr = makeRDFGraphFromN3Builder rulesXsdIntegerBuilder

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