{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}

--------------------------------------------------------------------------------
--  See end of this file for licence information.
--------------------------------------------------------------------------------
-- |
--  Module      :  String
--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012, 2014, 2024 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: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
    )

#if (!defined(__GLASGOW_HASKELL__)) || (__GLASGOW_HASKELL__ < 710)
import Data.Monoid(Monoid(..))
#endif

import qualified Data.Text as T
import qualified Data.Text.Lazy.Builder as B

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

--  Local name for Integer datatype
nameXsdString :: LName
nameXsdString :: LName
nameXsdString = LName
"string"

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

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

-- | The RDFDatatype value for @xsd:string@.
rdfDatatypeXsdString :: RDFDatatype
rdfDatatypeXsdString :: RDFDatatype
rdfDatatypeXsdString = DatatypeVal RDFGraph Text RDFLabel RDFLabel -> RDFDatatype
forall ex lb vn vt. DatatypeVal ex vt lb vn -> Datatype ex lb vn
Datatype DatatypeVal RDFGraph Text RDFLabel RDFLabel
rdfDatatypeValXsdString

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

-- |Define Datatype value for @xsd:string@.
--
rdfDatatypeValXsdString :: RDFDatatypeVal T.Text
rdfDatatypeValXsdString :: DatatypeVal RDFGraph Text RDFLabel RDFLabel
rdfDatatypeValXsdString = DatatypeVal
    { tvalName :: ScopedName
tvalName      = ScopedName
typeNameXsdString
    , tvalRules :: Ruleset RDFGraph
tvalRules     = Ruleset RDFGraph
rdfRulesetXsdString
    , tvalMkRules :: RDFGraph -> [Rule RDFGraph]
tvalMkRules   = DatatypeVal RDFGraph Text RDFLabel RDFLabel
-> RDFGraph -> [Rule RDFGraph]
forall vt. RDFDatatypeVal vt -> RDFGraph -> [Rule RDFGraph]
makeRDFDatatypeRestrictionRules DatatypeVal RDFGraph Text RDFLabel RDFLabel
rdfDatatypeValXsdString
    , tvalMkMods :: [OpenVarBindingModify RDFLabel RDFLabel]
tvalMkMods    = DatatypeVal RDFGraph Text RDFLabel RDFLabel
-> [OpenVarBindingModify RDFLabel RDFLabel]
forall vt.
RDFDatatypeVal vt -> [OpenVarBindingModify RDFLabel RDFLabel]
makeRdfDtOpenVarBindingModifiers DatatypeVal RDFGraph Text RDFLabel RDFLabel
rdfDatatypeValXsdString
    , tvalMap :: DatatypeMap Text
tvalMap       = DatatypeMap Text
mapXsdString
    , tvalRel :: [DatatypeRel Text]
tvalRel       = [DatatypeRel Text]
relXsdString
    , tvalMod :: [DatatypeMod Text RDFLabel RDFLabel]
tvalMod       = [DatatypeMod Text RDFLabel RDFLabel]
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 Text
mapXsdString = DatatypeMap
    { mapL2V :: Text -> Maybe Text
mapL2V = Text -> Maybe Text
forall a. a -> Maybe a
Just
    , mapV2L :: Text -> Maybe Text
mapV2L = Text -> Maybe Text
forall a. a -> Maybe a
Just
    }

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

mkStrRel2 ::
    LName -> DatatypeRelPr T.Text -> UnaryFnTable T.Text
    -> DatatypeRel T.Text
mkStrRel2 :: LName
-> DatatypeRelPr Text -> UnaryFnTable Text -> DatatypeRel Text
mkStrRel2 LName
nam DatatypeRelPr Text
pr UnaryFnTable Text
fns = 
  DatatypeRel
    { dtRelName :: ScopedName
dtRelName = Namespace -> LName -> ScopedName
makeNSScopedName Namespace
namespaceXsdString LName
nam
    , dtRelFunc :: DatatypeRelFn Text
dtRelFunc = DatatypeRelPr Text
-> UnaryFnTable Text
-> ((Text -> Bool)
    -> UnaryFnDescr Text -> [Maybe Text] -> Maybe [Text])
-> DatatypeRelFn Text
forall vt b.
Eq vt =>
DatatypeRelPr vt
-> [(vt -> Bool, [b])]
-> ((vt -> Bool) -> b -> [Maybe vt] -> Maybe [vt])
-> DatatypeRelFn vt
altArgs DatatypeRelPr Text
pr UnaryFnTable Text
fns (Text -> Bool) -> UnaryFnDescr Text -> [Maybe Text] -> Maybe [Text]
forall a. UnaryFnApply a
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
    }
-}

lcomp ::
  (a -> a -> Bool)
  -> [a] -- ^ this list must have at least two elements
  -> Bool
lcomp :: forall a. (a -> a -> Bool) -> [a] -> Bool
lcomp a -> a -> Bool
p (a
a1:a
a2:[a]
_) = a -> a -> Bool
p a
a1 a
a2
lcomp a -> a -> Bool
_ [a]
_ = [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"internal error"


-- eq

relXsdStringEq :: DatatypeRel T.Text
relXsdStringEq :: DatatypeRel Text
relXsdStringEq = LName
-> DatatypeRelPr Text -> UnaryFnTable Text -> DatatypeRel Text
mkStrRel2 LName
"eq" ((Text -> Text -> Bool) -> DatatypeRelPr Text
forall a. (a -> a -> Bool) -> [a] -> Bool
lcomp Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==))
    ( (Text -> Bool, [UnaryFnDescr Text]) -> UnaryFnTable Text
forall a. a -> [a]
repeat (Bool -> Text -> Bool
forall a b. a -> b -> a
const Bool
True, []) )

-- ne

relXsdStringNe :: DatatypeRel T.Text
relXsdStringNe :: DatatypeRel Text
relXsdStringNe = LName
-> DatatypeRelPr Text -> UnaryFnTable Text -> DatatypeRel Text
mkStrRel2 LName
"ne" ((Text -> Text -> Bool) -> DatatypeRelPr Text
forall a. (a -> a -> Bool) -> [a] -> Bool
lcomp Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(/=))
    ( (Text -> Bool, [UnaryFnDescr Text]) -> UnaryFnTable Text
forall a. a -> [a]
repeat (Bool -> Text -> Bool
forall a b. a -> b -> a
const Bool
True, []) )

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

modXsdStringEq, modXsdStringNe :: RDFDatatypeMod T.Text
modXsdStringEq :: DatatypeMod Text RDFLabel RDFLabel
modXsdStringEq = LName
-> (Text -> Text -> Bool) -> DatatypeMod Text RDFLabel RDFLabel
modXsdStringCompare LName
"eq" Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==)
modXsdStringNe :: DatatypeMod Text RDFLabel RDFLabel
modXsdStringNe = LName
-> (Text -> Text -> Bool) -> DatatypeMod Text RDFLabel RDFLabel
modXsdStringCompare LName
"ne" Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(/=)

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

-- |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 :: Ruleset RDFGraph
rdfRulesetXsdString =
    Namespace
-> [Formula RDFGraph] -> [Rule RDFGraph] -> Ruleset RDFGraph
forall ex. Namespace -> [Formula ex] -> [Rule ex] -> Ruleset ex
makeRuleset Namespace
namespaceXsdString [Formula RDFGraph]
axiomsXsdString [Rule RDFGraph]
rulesXsdString

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

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

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

-- | The rules for @xsd:string@.
rulesXsdString :: [RDFRule]
rulesXsdString :: [Rule RDFGraph]
rulesXsdString = [Rule RDFGraph]
rulesXsdStringClosure [Rule RDFGraph] -> [Rule RDFGraph] -> [Rule RDFGraph]
forall a. [a] -> [a] -> [a]
++ [Rule RDFGraph]
rulesXsdStringRestriction

rulesXsdStringRestriction :: [RDFRule]
rulesXsdStringRestriction :: [Rule RDFGraph]
rulesXsdStringRestriction =
    DatatypeVal RDFGraph Text RDFLabel RDFLabel
-> RDFGraph -> [Rule RDFGraph]
forall vt. RDFDatatypeVal vt -> RDFGraph -> [Rule RDFGraph]
makeRDFDatatypeRestrictionRules DatatypeVal RDFGraph Text RDFLabel RDFLabel
rdfDatatypeValXsdString RDFGraph
gr
    where
        gr :: RDFGraph
gr = Builder -> RDFGraph
makeRDFGraphFromN3Builder Builder
rulesXsdStringBuilder

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

--  Infer string from plain literal
xsdstrls :: RDFRule
xsdstrls :: Rule RDFGraph
xsdstrls = Namespace
-> LName
-> Builder
-> Builder
-> RDFVarBindingModify
-> Rule RDFGraph
makeN3ClosureRule Namespace
namespaceXsdString LName
"ls"
            Builder
"?a ?p ?l ."
            Builder
"?a ?p ?s ."
            ([Char] -> [Char] -> RDFVarBindingModify
stringPlain [Char]
"s" [Char]
"l")

--  Infer plain literal from string
xsdstrsl :: RDFRule
xsdstrsl :: Rule RDFGraph
xsdstrsl = Namespace
-> LName
-> Builder
-> Builder
-> RDFVarBindingModify
-> Rule RDFGraph
makeN3ClosureRule Namespace
namespaceXsdString LName
"sl"
            Builder
"?a ?p ?s ."
            Builder
"?a ?p ?l ."
            ([Char] -> [Char] -> RDFVarBindingModify
stringPlain [Char]
"s" [Char]
"l")

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

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

        -- Going to assume can only get TypedLit here, and assume LangLit
        -- can be ignored.
        app2 :: Maybe RDFLabel
-> Maybe RDFLabel
-> VarBinding RDFLabel RDFLabel
-> [VarBinding RDFLabel RDFLabel]
app2 (Just (TypedLit Text
s ScopedName
_))
             (Just (Lit Text
l))
             VarBinding RDFLabel RDFLabel
vbind
             | Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
l
             = [VarBinding RDFLabel RDFLabel
vbind]
        app2 (Just (TypedLit Text
s ScopedName
_))
             Maybe RDFLabel
Nothing
             VarBinding RDFLabel RDFLabel
vbind
             = [RDFLabel
-> RDFLabel
-> VarBinding RDFLabel RDFLabel
-> VarBinding RDFLabel RDFLabel
forall a b.
(Ord a, Ord b) =>
a -> b -> VarBinding a b -> VarBinding a b
addVarBinding RDFLabel
lvar (Text -> RDFLabel
Lit Text
s) VarBinding RDFLabel RDFLabel
vbind]
        app2 Maybe RDFLabel
Nothing
             (Just (Lit Text
l))
             VarBinding RDFLabel RDFLabel
vbind
             = [RDFLabel
-> RDFLabel
-> VarBinding RDFLabel RDFLabel
-> VarBinding RDFLabel RDFLabel
forall a b.
(Ord a, Ord b) =>
a -> b -> VarBinding a b -> VarBinding a b
addVarBinding RDFLabel
svar (Text -> ScopedName -> RDFLabel
TypedLit Text
l ScopedName
typeNameXsdString) VarBinding RDFLabel RDFLabel
vbind]
        app2 Maybe RDFLabel
_ Maybe RDFLabel
_ VarBinding RDFLabel RDFLabel
_ = []

--------------------------------------------------------------------------------
--
--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,
--    2011, 2012, 2014, 2024 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
--
--------------------------------------------------------------------------------