{-# LANGUAGE OverloadedStrings #-}

--------------------------------------------------------------------------------
--  See end of this file for licence information.
--------------------------------------------------------------------------------
-- |
--  Module      :  String
--  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:string@ datatyped literals.
--
--------------------------------------------------------------------------------

module Swish.RDF.Datatype.XSD.String
    ( rdfDatatypeXsdString
    , rdfDatatypeValXsdString
    , typeNameXsdString, namespaceXsdString
    , axiomsXsdString, rulesXsdString
    )
    where

import Swish.Datatype
    ( Datatype(..)
    , DatatypeVal(..)
    , DatatypeMap(..)
    , DatatypeRel(..), DatatypeRelPr
    , altArgs
    , UnaryFnTable,  unaryFnApp
    , DatatypeMod(..) 
    , makeVmod20
    )

import Swish.Namespace (Namespace, ScopedName)
import Swish.Namespace (namespaceToBuilder, makeNSScopedName)
import Swish.QName (LName)
import Swish.Ruleset (makeRuleset)
import Swish.VarBinding (VarBinding(..), VarBindingModify(..))
import Swish.VarBinding (addVarBinding)

import Swish.RDF.ClassRestrictionRule (makeRDFDatatypeRestrictionRules)
import Swish.RDF.Datatype (RDFDatatype, RDFDatatypeVal, RDFDatatypeMod)
import Swish.RDF.Datatype (makeRdfDtOpenVarBindingModifiers )
import Swish.RDF.Graph (RDFLabel(..))
import Swish.RDF.Ruleset (RDFFormula, RDFRule, RDFRuleset)
import Swish.RDF.Ruleset (makeRDFGraphFromN3Builder, makeRDFFormula, makeN3ClosureRule)
import Swish.RDF.VarBinding (RDFVarBindingModify)

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 Integer datatype
nameXsdString :: LName
nameXsdString = "string"

-- | Type name for @xsd:string@ datatype
typeNameXsdString :: ScopedName
typeNameXsdString  = makeNSScopedName namespaceXSD nameXsdString

-- | Namespace for @xsd:string@ datatype functions
namespaceXsdString :: Namespace
namespaceXsdString = namespaceXsdType nameXsdString

-- | The RDFDatatype value for @xsd:string@.
rdfDatatypeXsdString :: RDFDatatype
rdfDatatypeXsdString = Datatype rdfDatatypeValXsdString

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

-- |Define Datatype value for @xsd:string@.
--
rdfDatatypeValXsdString :: RDFDatatypeVal T.Text
rdfDatatypeValXsdString = DatatypeVal
    { tvalName      = typeNameXsdString
    , tvalRules     = rdfRulesetXsdString
    , tvalMkRules   = makeRDFDatatypeRestrictionRules rdfDatatypeValXsdString
    , tvalMkMods    = makeRdfDtOpenVarBindingModifiers rdfDatatypeValXsdString
    , tvalMap       = mapXsdString
    , tvalRel       = relXsdString
    , tvalMod       = modXsdString
    }

-- |mapXsdString contains functions that perform lexical-to-value
--  and value-to-canonical-lexical mappings for @xsd:string@ values
--
--  These are identity mappings.
--
mapXsdString :: DatatypeMap T.Text
mapXsdString = DatatypeMap
    { mapL2V = Just
    , mapV2L = Just
    }

-- |relXsdString contains useful relations for @xsd:string@ values.
--
relXsdString :: [DatatypeRel T.Text]
relXsdString =
    [ relXsdStringEq
    , relXsdStringNe
    ]

mkStrRel2 ::
    LName -> DatatypeRelPr T.Text -> UnaryFnTable T.Text
    -> DatatypeRel T.Text
mkStrRel2 nam pr fns = 
  DatatypeRel
    { dtRelName = makeNSScopedName namespaceXsdString nam
    , dtRelFunc = altArgs pr fns unaryFnApp
    }

{-
mkStrRel3 ::
    String -> DatatypeRelPr String -> BinaryFnTable String
    -> DatatypeRel String
mkStrRel3 nam pr fns = DatatypeRel
    { dtRelName = ScopedName namespaceXsdString nam
    , dtRelFunc = altArgs pr fns binaryFnApp
    }

mkStrRel3maybe ::
    String -> DatatypeRelPr String -> BinMaybeFnTable String
    -> DatatypeRel String
mkStrRel3maybe nam pr fns = DatatypeRel
    { dtRelName = ScopedName namespaceXsdString nam
    , dtRelFunc = altArgs pr fns binMaybeFnApp
    }
-}

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

relXsdStringEq :: DatatypeRel T.Text
relXsdStringEq = mkStrRel2 "eq" (lcomp (==))
    ( repeat (const True, []) )

-- ne

relXsdStringNe :: DatatypeRel T.Text
relXsdStringNe = mkStrRel2 "ne" (lcomp (/=))
    ( repeat (const True, []) )

-- |modXsdString contains variable binding modifiers for @xsd:string@ values.
--
modXsdString :: [RDFDatatypeMod T.Text]
modXsdString =
    [ modXsdStringEq
    , modXsdStringNe
    ]

modXsdStringEq, modXsdStringNe :: RDFDatatypeMod T.Text
modXsdStringEq = modXsdStringCompare "eq" (==)
modXsdStringNe = modXsdStringCompare "ne" (/=)

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

-- |rulesetXsdString contains rules and axioms that allow additional
--  deductions when xsd:string values appear in a graph.
--
--  makeRuleset :: Namespace -> [Formula ex] -> [Rule ex] -> Ruleset ex
--
rdfRulesetXsdString :: RDFRuleset
rdfRulesetXsdString =
    makeRuleset namespaceXsdString axiomsXsdString rulesXsdString

mkPrefix :: Namespace -> B.Builder
mkPrefix = namespaceToBuilder

prefixXsdString :: B.Builder
prefixXsdString = 
  mconcat
  [ mkPrefix namespaceRDF
  , mkPrefix namespaceRDFS
  , mkPrefix namespaceRDFD
  , mkPrefix namespaceXSD
  , mkPrefix namespaceXsdString
  ]
  
mkAxiom :: LName -> B.Builder -> RDFFormula
mkAxiom local gr =
    makeRDFFormula namespaceXsdString local (prefixXsdString `mappend` gr)

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

-- | The rules for @xsd:string@.
rulesXsdString :: [RDFRule]
rulesXsdString = rulesXsdStringClosure ++ rulesXsdStringRestriction

rulesXsdStringRestriction :: [RDFRule]
rulesXsdStringRestriction =
    makeRDFDatatypeRestrictionRules rdfDatatypeValXsdString gr
    where
        gr = makeRDFGraphFromN3Builder rulesXsdStringBuilder

rulesXsdStringBuilder :: B.Builder
rulesXsdStringBuilder = 
  mconcat
  [ prefixXsdString
    , "xsd_string:Eq a rdfd:GeneralRestriction ; "
    , "  rdfd:onProperties (rdf:_1 rdf:_2) ; "
    , "  rdfd:constraint xsd_string:eq ; "
    , "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
    , "xsd_string:Ne a rdfd:GeneralRestriction ; "
    , "  rdfd:onProperties (rdf:_1 rdf:_2) ; "
    , "  rdfd:constraint xsd_string:ne ; "
    , "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
    ]
  
rulesXsdStringClosure :: [RDFRule]
rulesXsdStringClosure =
    [ xsdstrls
    , xsdstrsl
    ]

--  Infer string from plain literal
xsdstrls :: RDFRule
xsdstrls = makeN3ClosureRule namespaceXsdString "ls"
            "?a ?p ?l ."
            "?a ?p ?s ."
            (stringPlain "s" "l")

--  Infer plain literal from string
xsdstrsl :: RDFRule
xsdstrsl = makeN3ClosureRule namespaceXsdString "sl"
            "?a ?p ?s ."
            "?a ?p ?l ."
            (stringPlain "s" "l")

--  Map between string and plain literal values
stringPlain :: String -> String -> RDFVarBindingModify
stringPlain svar lvar = stringPlainValue (Var svar) (Var lvar)

--  Variable binding modifier to create new binding to a canonical
--  form of a datatyped literal.
stringPlainValue ::
    RDFLabel -> RDFLabel -> RDFVarBindingModify
stringPlainValue svar lvar = VarBindingModify
        { vbmName   = makeNSScopedName namespaceRDFD "stringPlain"
        , vbmApply  = concatMap app1
        , vbmVocab  = [svar,lvar]
        , vbmUsage  = [[svar],[lvar],[]]
        }
    where
        app1 vbind = app2 (vbMap vbind svar) (vbMap vbind lvar) vbind

        -- Going to assume can only get TypedLit here, and assume LangLit
        -- can be ignored.
        app2 (Just (TypedLit s _))
             (Just (Lit l))
             vbind
             | s == l
             = [vbind]
        app2 (Just (TypedLit s _))
             Nothing
             vbind
             = [addVarBinding lvar (Lit s) vbind]
        app2 Nothing
             (Just (Lit l))
             vbind
             = [addVarBinding svar (TypedLit l typeNameXsdString) vbind]
        app2 _ _ _ = []

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