{-# 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 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 = forall ex lb vn vt. DatatypeVal ex vt lb vn -> Datatype ex lb vn
Datatype RDFDatatypeVal Text
rdfDatatypeValXsdString

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

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

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

relXsdStringEq :: DatatypeRel T.Text
relXsdStringEq :: DatatypeRel Text
relXsdStringEq = LName
-> DatatypeRelPr Text -> UnaryFnTable Text -> DatatypeRel Text
mkStrRel2 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

relXsdStringNe :: DatatypeRel T.Text
relXsdStringNe :: DatatypeRel Text
relXsdStringNe = LName
-> DatatypeRelPr Text -> UnaryFnTable Text -> DatatypeRel Text
mkStrRel2 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, []) )

-- |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" forall a. Eq a => a -> a -> Bool
(==)
modXsdStringNe :: DatatypeMod Text RDFLabel RDFLabel
modXsdStringNe = LName
-> (Text -> Text -> Bool) -> DatatypeMod Text RDFLabel RDFLabel
modXsdStringCompare LName
"ne" 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 = 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 =
    forall ex. Namespace -> [Formula ex] -> [Rule ex] -> Ruleset ex
makeRuleset Namespace
namespaceXsdString [RDFFormula]
axiomsXsdString [Rule RDFGraph]
rulesXsdString

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

prefixXsdString :: B.Builder
prefixXsdString :: Builder
prefixXsdString = 
  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 -> RDFFormula
mkAxiom LName
local Builder
gr =
    Namespace -> LName -> Builder -> RDFFormula
makeRDFFormula Namespace
namespaceXsdString LName
local (Builder
prefixXsdString 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 :: [RDFFormula]
axiomsXsdString =
    [ LName -> Builder -> RDFFormula
mkAxiom LName
"dt"      Builder
"xsd:string rdf:type rdfs:Datatype ."
    ]

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

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

rulesXsdStringBuilder :: B.Builder
rulesXsdStringBuilder :: Builder
rulesXsdStringBuilder = 
  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 ."
            (String -> String -> RDFVarBindingModify
stringPlain String
"s" String
"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 ."
            (String -> String -> RDFVarBindingModify
stringPlain String
"s" String
"l")

--  Map between string and plain literal values
stringPlain :: String -> String -> RDFVarBindingModify
stringPlain :: String -> String -> RDFVarBindingModify
stringPlain String
svar String
lvar = RDFLabel -> RDFLabel -> RDFVarBindingModify
stringPlainValue (String -> RDFLabel
Var String
svar) (String -> RDFLabel
Var String
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  = 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 (forall a b. VarBinding a b -> a -> Maybe b
vbMap VarBinding RDFLabel RDFLabel
vbind RDFLabel
svar) (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 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
             = [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
             = [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 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
--
--------------------------------------------------------------------------------