module Swish.RDF.RDFDatatypeXsdString
( rdfDatatypeXsdString
, rdfDatatypeValXsdString
, typeNameXsdString, namespaceXsdString
, axiomsXsdString, rulesXsdString
, prefixXsdString
)
where
import Swish.RDF.RDFRuleset
( RDFFormula, RDFRule, RDFRuleset
, makeRDFGraphFromN3Builder
, makeRDFFormula
, makeN3ClosureRule
)
import Swish.RDF.RDFVarBinding (RDFVarBindingModify)
import Swish.RDF.RDFDatatype
( RDFDatatype
, RDFDatatypeVal
, RDFDatatypeMod
, makeRdfDtOpenVarBindingModifiers
)
import Swish.RDF.RDFGraph (RDFLabel(..))
import Swish.RDF.ClassRestrictionRule (makeRDFDatatypeRestrictionRules)
import Swish.RDF.Datatype
( Datatype(..)
, DatatypeVal(..)
, DatatypeMap(..)
, DatatypeRel(..), DatatypeRelPr
, altArgs
, UnaryFnTable, unaryFnApp
, DatatypeMod(..)
, makeVmod20
)
import Swish.RDF.Ruleset (makeRuleset)
import Swish.Utils.Namespace (Namespace, ScopedName, namespaceToBuilder, makeNSScopedName)
import Swish.RDF.Vocabulary
( namespaceRDF
, namespaceRDFS
, namespaceRDFD
, namespaceXSD
, namespaceXsdType
)
import Swish.RDF.VarBinding (VarBinding(..), addVarBinding, VarBindingModify(..))
import Data.Monoid(Monoid(..))
import qualified Data.Text as T
import qualified Data.Text.Lazy.Builder as B
nameXsdString :: T.Text
nameXsdString = "string"
typeNameXsdString :: ScopedName
typeNameXsdString = makeNSScopedName namespaceXSD nameXsdString
namespaceXsdString :: Namespace
namespaceXsdString = namespaceXsdType nameXsdString
rdfDatatypeXsdString :: RDFDatatype
rdfDatatypeXsdString = Datatype rdfDatatypeValXsdString
rdfDatatypeValXsdString :: RDFDatatypeVal T.Text
rdfDatatypeValXsdString = DatatypeVal
{ tvalName = typeNameXsdString
, tvalRules = rdfRulesetXsdString
, tvalMkRules = makeRDFDatatypeRestrictionRules rdfDatatypeValXsdString
, tvalMkMods = makeRdfDtOpenVarBindingModifiers rdfDatatypeValXsdString
, tvalMap = mapXsdString
, tvalRel = relXsdString
, tvalMod = modXsdString
}
mapXsdString :: DatatypeMap T.Text
mapXsdString = DatatypeMap
{ mapL2V = Just
, mapV2L = Just
}
relXsdString :: [DatatypeRel T.Text]
relXsdString =
[ relXsdStringEq
, relXsdStringNe
]
mkStrRel2 ::
T.Text -> DatatypeRelPr T.Text -> UnaryFnTable T.Text
-> DatatypeRel T.Text
mkStrRel2 nam pr fns =
DatatypeRel
{ dtRelName = makeNSScopedName namespaceXsdString nam
, dtRelFunc = altArgs pr fns unaryFnApp
}
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)
relXsdStringEq :: DatatypeRel T.Text
relXsdStringEq = mkStrRel2 "eq" (lcomp (==))
( repeat (const True, []) )
relXsdStringNe :: DatatypeRel T.Text
relXsdStringNe = mkStrRel2 "ne" (lcomp (/=))
( repeat (const True, []) )
modXsdString :: [RDFDatatypeMod T.Text]
modXsdString =
[ modXsdStringEq
, modXsdStringNe
]
modXsdStringEq, modXsdStringNe :: RDFDatatypeMod T.Text
modXsdStringEq = modXsdStringCompare "eq" (==)
modXsdStringNe = modXsdStringCompare "ne" (/=)
modXsdStringCompare ::
T.Text -> (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 _ = []
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 :: T.Text -> B.Builder -> RDFFormula
mkAxiom local gr =
makeRDFFormula namespaceXsdString local (prefixXsdString `mappend` gr)
axiomsXsdString :: [RDFFormula]
axiomsXsdString =
[ mkAxiom "dt" "xsd:string rdf:type rdfs:Datatype ."
]
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
]
xsdstrls :: RDFRule
xsdstrls = makeN3ClosureRule namespaceXsdString "ls"
"?a ?p ?l ."
"?a ?p ?s ."
(stringPlain "s" "l")
xsdstrsl :: RDFRule
xsdstrsl = makeN3ClosureRule namespaceXsdString "sl"
"?a ?p ?s ."
"?a ?p ?l ."
(stringPlain "s" "l")
stringPlain :: String -> String -> RDFVarBindingModify
stringPlain svar lvar = stringPlainValue (Var svar) (Var lvar)
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
app2 (Just (Lit s (Just _)))
(Just (Lit l Nothing))
vbind
| s == l
= [vbind]
app2 (Just (Lit s (Just _)))
Nothing
vbind
= [addVarBinding lvar (Lit s Nothing) vbind]
app2 Nothing
(Just (Lit l Nothing))
vbind
= [addVarBinding svar (Lit l (Just typeNameXsdString)) vbind]
app2 _ _ _ = []