{-# Language OverloadedStrings #-}
--------------------------------------------------------------------------------
-- See end of this file for licence information.
--------------------------------------------------------------------------------
-- |
-- Module : Swish.RDF.Vocabulary.RDF
-- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke
-- License : GPL V2
--
-- Maintainer : Douglas Burke
-- Stability : experimental
-- Portability : OverloadedStrings
--
-- This module defines some commonly used vocabulary terms from the
-- RDF () and
-- RDF Schema () documents.
--
--------------------------------------------------------------------------------
module Swish.RDF.Vocabulary.RDF
(
-- * Namespaces
namespaceRDF
, namespaceRDFS
-- * RDF terms
--
-- | These terms are described in ;
-- the version used is \"W3C Recommendation 10 February 2004\", .
--
-- Some terms are listed within the RDF Schema terms below since their definition
-- is given within the RDF Schema document.
--
, rdfRDF
, rdfDescription
, rdfID
, rdfAbout
, rdfParseType
, rdfResource
, rdfLi
, rdfNodeID
, rdfDatatype
, rdf1, rdf2, rdfn
-- * RDF Schema terms
--
-- | These are defined by ; the version
-- used is \"W3C Recommendation 10 February 2004\", .
-- ** Classes
--
-- | See the \"Classes\" section at for more information.
, rdfsResource
, rdfsClass
, rdfsLiteral
, rdfsDatatype
, rdfXMLLiteral
, rdfProperty
-- ** Properties
--
-- | See the \"Properties\" section at for more information.
, rdfsRange
, rdfsDomain
, rdfType
, rdfsSubClassOf
, rdfsSubPropertyOf
, rdfsLabel
, rdfsComment
-- ** Containers
--
-- | See the \"Container Classes and Properties\" section at .
, rdfsContainer
, rdfBag
, rdfSeq
, rdfAlt
, rdfsContainerMembershipProperty
, rdfsMember
-- ** Collections
--
-- | See the \"Collections\" section at .
, rdfList
, rdfFirst
, rdfRest
, rdfNil
-- ** Reification Vocabulary
--
-- | See the \"Reification Vocabulary\" section at .
, rdfStatement
, rdfSubject
, rdfPredicate
, rdfObject
-- ** Utility Properties
--
-- | See the \"Utility Properties\" section at .
, rdfsSeeAlso
, rdfsIsDefinedBy
, rdfValue
)
where
import Swish.Namespace (Namespace, makeNamespace, ScopedName, makeNSScopedName)
import Swish.QName (LName, newLName)
import Data.Maybe (fromMaybe, fromJust)
import Data.Word (Word32)
import Network.URI (URI, parseURI)
import qualified Data.Text as T
------------------------------------------------------------
-- Namespaces
------------------------------------------------------------
rdfURI, rdfsURI :: URI
rdfURI = fromMaybe (error "Internal error processing RDF URI") $ parseURI "http://www.w3.org/1999/02/22-rdf-syntax-ns#"
rdfsURI = fromMaybe (error "Internal error processing RDFS URI") $ parseURI "http://www.w3.org/2000/01/rdf-schema#"
-- | Maps @rdf@ to .
namespaceRDF :: Namespace
namespaceRDF = makeNamespace (Just "rdf") rdfURI
-- | Maps @rdfs@ to .
namespaceRDFS :: Namespace
namespaceRDFS = makeNamespace (Just "rdfs") rdfsURI
------------------------------------------------------------
-- Terms
------------------------------------------------------------
toRDF, toRDFS :: LName -> ScopedName
toRDF = makeNSScopedName namespaceRDF
toRDFS = makeNSScopedName namespaceRDFS
-- | @rdf:RDF@.
rdfRDF :: ScopedName
rdfRDF = toRDF "RDF"
-- | @rdf:Description@.
rdfDescription :: ScopedName
rdfDescription = toRDF "Description"
-- | @rdf:datatype@.
rdfDatatype :: ScopedName
rdfDatatype = toRDF "datatype"
-- | @rdf:resource@.
rdfResource :: ScopedName
rdfResource = toRDF "resource"
-- | @rdf:about@.
rdfAbout :: ScopedName
rdfAbout = toRDF "about"
-- | @rdf:ID@.
rdfID :: ScopedName
rdfID = toRDF "ID"
-- | @rdf:parseType@.
rdfParseType :: ScopedName
rdfParseType = toRDF "parseType"
-- | @rdf:li@.
rdfLi :: ScopedName
rdfLi = toRDF "li"
-- | @rdf:nodeID@.
rdfNodeID :: ScopedName
rdfNodeID = toRDF "nodeID"
-- | Create a @rdf:_n@ entity.
--
-- There is no check that the argument is not 0, so it is
-- possible to create the un-defined label @rdf:_0@.
rdfn ::
Word32
-> ScopedName
rdfn = toRDF . fromJust . newLName . T.pack . ("_" ++) . show
-- | @rdf:_1@.
rdf1 :: ScopedName
rdf1 = toRDF "_1"
-- | @rdf:_2@.
rdf2 :: ScopedName
rdf2 = toRDF "_2"
-- | @rdf:first@ from .
rdfFirst :: ScopedName
rdfFirst = toRDF "first"
-- | @rdf:rest@ from .
rdfRest :: ScopedName
rdfRest = toRDF "rest"
-- | @rdf:nil@ from .
rdfNil :: ScopedName
rdfNil = toRDF "nil"
-- | @rdf:type@ from .
rdfType :: ScopedName
rdfType = toRDF "type"
-- | @rdf:Property@ from .
rdfProperty :: ScopedName
rdfProperty = toRDF "Property"
-- | @rdf:XMLLiteral@ from .
rdfXMLLiteral :: ScopedName
rdfXMLLiteral = toRDF "XMLLiteral"
-- | @rdfs:Resource@ from .
rdfsResource :: ScopedName
rdfsResource = toRDFS "Resource"
-- | @rdfs:Class@ from .
rdfsClass :: ScopedName
rdfsClass = toRDFS "Class"
-- | @rdfs:Literal@ from .
rdfsLiteral :: ScopedName
rdfsLiteral = toRDFS "Literal"
-- | @rdfs:Datatype@ from .
rdfsDatatype :: ScopedName
rdfsDatatype = toRDFS "Datatype"
-- | @rdfs:label@ from .
rdfsLabel :: ScopedName
rdfsLabel = toRDFS "label"
-- | @rdfs:comment@ from .
rdfsComment :: ScopedName
rdfsComment = toRDFS "comment"
-- | @rdfs:range@ from .
rdfsRange :: ScopedName
rdfsRange = toRDFS "range"
-- | @rdfs:domain@ from .
rdfsDomain :: ScopedName
rdfsDomain = toRDFS "domain"
-- | @rdfs:subClassOf@ from .
rdfsSubClassOf :: ScopedName
rdfsSubClassOf = toRDFS "subClassOf"
-- | @rdfs:subPropertyOf@ from .
rdfsSubPropertyOf :: ScopedName
rdfsSubPropertyOf = toRDFS "subPropertyOf"
-- | @rdfs:Container@ from .
rdfsContainer :: ScopedName
rdfsContainer = toRDFS "Container"
-- | @rdf:Bag@ from .
rdfBag :: ScopedName
rdfBag = toRDF "Bag"
-- | @rdf:Seq@ from .
rdfSeq :: ScopedName
rdfSeq = toRDF "Seq"
-- | @rdf:Alt@ from .
rdfAlt :: ScopedName
rdfAlt = toRDF "Alt"
-- | @rdfs:ContainerMembershipProperty@ from .
rdfsContainerMembershipProperty :: ScopedName
rdfsContainerMembershipProperty = toRDFS "ContainerMembershipProperty"
-- | @rdfs:member@ from .
rdfsMember :: ScopedName
rdfsMember = toRDFS "member"
-- | @rdf:List@ from .
rdfList :: ScopedName
rdfList = toRDF "List"
-- | @rdf:Statement@ from .
rdfStatement :: ScopedName
rdfStatement = toRDF "Statement"
-- | @rdf:subject@ from .
rdfSubject :: ScopedName
rdfSubject = toRDF "subject"
-- | @rdf:predicate@ from .
rdfPredicate :: ScopedName
rdfPredicate = toRDF "subject"
-- | @rdf:object@ from .
rdfObject :: ScopedName
rdfObject = toRDF "object"
-- | @rdfs:seeAlso@ from .
rdfsSeeAlso :: ScopedName
rdfsSeeAlso = toRDFS "seeAlso"
-- | @rdfs:isDefinedBy@ from .
rdfsIsDefinedBy :: ScopedName
rdfsIsDefinedBy = toRDFS "isDefinedBy"
-- | @rdf:value@ from .
rdfValue :: ScopedName
rdfValue = toRDF "value"
--------------------------------------------------------------------------------
--
-- Copyright (c) 2011 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
--
--------------------------------------------------------------------------------