{-# LANGUAGE OverloadedStrings #-}
--------------------------------------------------------------------------------
-- See end of this file for licence information.
--------------------------------------------------------------------------------
-- |
-- Module : Swish.RDF.Vocabulary.FOAF
-- Copyright : (c) 2011 Douglas Burke
-- License : GPL V2
--
-- Maintainer : Douglas Burke
-- Stability : experimental
-- Portability : OverloadedStrings
--
-- This module defines some commonly used vocabulary terms from the FOAF
-- vocabulary ().
--
-- Note that unlike some of the existing vocabularies in Swish, the FOAF
-- one matches the case and spelling of the RDF terms; so we
-- use 'foafbased_near'
-- rather than @foafBasedNear@. This is partly because some terms would
-- end up with the same Haskell label if a conversion to camel-case wer
-- used.
--
--------------------------------------------------------------------------------
module Swish.RDF.Vocabulary.FOAF
(
-- | The version used for this module is
-- \"FOAF Vocabulary Specification 0.98 Namespace Document 9 August 2010 - /Marco Polo Edition/\",
-- .
namespaceFOAF
-- * Classes
, foafAgent
, foafDocument
, foafGroup
, foafImage
, foafLabelProperty
, foafOnlineAccount
, foafOnlineChatAccount
, foafOnlineEcommerceAccount
, foafOnlineGamingAccount
, foafOrganization
, foafPerson
, foafPersonalProfileDocument
, foafProject
-- * Properties
, foafaccount
, foafaccountName
, foafaccountServiceHomepage
, foafage
, foafaimChatID
, foafbased_near
, foafbirthday
, foafcurrentProject
, foafdepiction
, foafdepicts
, foafdnaChecksum
, foaffamilyName
, foaffamily_name
, foaffirstName
, foaffocus
, foaffundedBy
, foafgeekcode
, foafgender
, foafgivenName
, foafgivenname
, foafholdsAccount
, foafhomepage
, foaficqChatID
, foafimg
, foafinterest
, foafisPrimaryTopicOf
, foafjabberID
, foafknows
, foaflastName
, foaflogo
, foafmade
, foafmaker
, foafmbox
, foafmbox_sha1sum
, foafmember
, foafmembershipClass
, foafmsnChatID
, foafmyersBriggs
, foafname
, foafnick
, foafopenid
, foafpage
, foafpastProject
, foafphone
, foafplan
, foafprimaryTopic
, foafpublications
, foafschoolHomepage
, foafsha1
, foafskypeID
, foafstatus
, foafsurname
, foaftheme
, foafthumbnail
, foaftipjar
, foaftitle
, foaftopic
, foaftopic_interest
, foafweblog
, foafworkInfoHomepage
, foafworkplaceHomepage
, foafyahooChatID
)
where
import Swish.Namespace (Namespace, makeNamespace, ScopedName, makeNSScopedName)
import Swish.QName (LName)
import Data.Maybe (fromMaybe)
import Network.URI (URI, parseURI)
------------------------------------------------------------
-- Namespace
------------------------------------------------------------
foafURI :: URI
foafURI = fromMaybe (error "Internal error processing FOAF URI") $ parseURI "http://xmlns.com/foaf/0.1/"
-- | Maps @foaf@ to .
namespaceFOAF :: Namespace
namespaceFOAF = makeNamespace (Just "foaf") foafURI
------------------------------------------------------------
-- Terms
------------------------------------------------------------
toF :: LName -> ScopedName
toF = makeNSScopedName namespaceFOAF
-- Classes
-- | @foaf:Agent@ from .
foafAgent :: ScopedName
foafAgent = toF "Agent"
-- | @foaf:Document@ from .
foafDocument :: ScopedName
foafDocument = toF "Document"
-- | @foaf:Group@ from .
foafGroup :: ScopedName
foafGroup = toF "Group"
-- | @foaf:Image@ from .
foafImage :: ScopedName
foafImage = toF "Image"
-- | @foaf:LabelProperty@ from .
foafLabelProperty :: ScopedName
foafLabelProperty = toF "LabelProperty"
-- | @foaf:OnlineAccount@ from .
foafOnlineAccount :: ScopedName
foafOnlineAccount = toF "OnlineAccount"
-- | @foaf:OnlineChatAccount@ from .
foafOnlineChatAccount :: ScopedName
foafOnlineChatAccount = toF "OnlineChatAccount"
-- | @foaf:OnlineEcommerceAccount@ from .
foafOnlineEcommerceAccount :: ScopedName
foafOnlineEcommerceAccount = toF "OnlineEcommerceAccount"
-- | @foaf:OnlineGamingAccount@ from .
foafOnlineGamingAccount :: ScopedName
foafOnlineGamingAccount = toF "OnlineGamingAccount"
-- | @foaf:Organization@ from .
foafOrganization :: ScopedName
foafOrganization = toF "Organization"
-- | @foaf:Person@ from .
foafPerson :: ScopedName
foafPerson = toF "Person"
-- | @foaf:PersonalProfileDocument@ from .
foafPersonalProfileDocument :: ScopedName
foafPersonalProfileDocument = toF "PersonalProfileDocument"
-- | @foaf:Project@ from .
foafProject :: ScopedName
foafProject = toF "Project"
-- Properties
-- | @foaf:account@ from .
foafaccount :: ScopedName
foafaccount = toF "account"
-- | @foaf:accountName@ from .
foafaccountName :: ScopedName
foafaccountName = toF "accountName"
-- | @foaf:accountServiceHomepage@ from .
foafaccountServiceHomepage :: ScopedName
foafaccountServiceHomepage = toF "accountServiceHomepage"
-- | @foaf:age@ from .
foafage :: ScopedName
foafage = toF "age"
-- | @foaf:aimChatID@ from .
foafaimChatID :: ScopedName
foafaimChatID = toF "aimChatID"
-- | @foaf:based_near@ from .
foafbased_near :: ScopedName
foafbased_near = toF "based_near"
-- | @foaf:birthday@ from .
foafbirthday :: ScopedName
foafbirthday = toF "birthday"
-- | @foaf:currentProject@ from .
foafcurrentProject :: ScopedName
foafcurrentProject = toF "currentProject"
-- | @foaf:depiction@ from .
foafdepiction :: ScopedName
foafdepiction = toF "depiction"
-- | @foaf:depicts@ from .
foafdepicts :: ScopedName
foafdepicts = toF "depicts"
-- | @foaf:dnaChecksum@ from .
foafdnaChecksum :: ScopedName
foafdnaChecksum = toF "dnaChecksum"
-- | @foaf:familyName@ from .
foaffamilyName :: ScopedName
foaffamilyName = toF "familyName"
-- | @foaf:family_name@ from .
foaffamily_name :: ScopedName
foaffamily_name = toF "family_name"
-- | @foaf:firstName@ from .
foaffirstName :: ScopedName
foaffirstName = toF "firstName"
-- | @foaf:focus@ from .
foaffocus :: ScopedName
foaffocus = toF "focus"
-- | @foaf:fundedBy@ from .
foaffundedBy :: ScopedName
foaffundedBy = toF "fundedBy"
-- | @foaf:geekcode@ from .
foafgeekcode :: ScopedName
foafgeekcode = toF "geekcode"
-- | @foaf:gender@ from .
foafgender :: ScopedName
foafgender = toF "gender"
-- | @foaf:givenName@ from .
foafgivenName :: ScopedName
foafgivenName = toF "givenName"
-- | @foaf:givenname@ from .
foafgivenname :: ScopedName
foafgivenname = toF "givenname"
-- | @foaf:holdsAccount@ from .
foafholdsAccount :: ScopedName
foafholdsAccount = toF "holdsAccount"
-- | @foaf:homepage@ from .
foafhomepage :: ScopedName
foafhomepage = toF "homepage"
-- | @foaf:icqChatID@ from .
foaficqChatID :: ScopedName
foaficqChatID = toF "icqChatID"
-- | @foaf:img@ from .
foafimg :: ScopedName
foafimg = toF "img"
-- | @foaf:interest@ from .
foafinterest :: ScopedName
foafinterest = toF "interest"
-- | @foaf:isPrimaryTopicOf@ from .
foafisPrimaryTopicOf :: ScopedName
foafisPrimaryTopicOf = toF "isPrimaryTopicOf"
-- | @foaf:jabberID@ from .
foafjabberID :: ScopedName
foafjabberID = toF "jabberID"
-- | @foaf:knows@ from .
foafknows :: ScopedName
foafknows = toF "knows"
-- | @foaf:lastName@ from .
foaflastName :: ScopedName
foaflastName = toF "lastName"
-- | @foaf:logo@ from .
foaflogo :: ScopedName
foaflogo = toF "logo"
-- | @foaf:made@ from .
foafmade :: ScopedName
foafmade = toF "made"
-- | @foaf:maker@ from .
foafmaker :: ScopedName
foafmaker = toF "maker"
-- | @foaf:mbox@ from .
foafmbox :: ScopedName
foafmbox = toF "mbox"
-- | @foaf:mbox_sha1sum@ from .
foafmbox_sha1sum :: ScopedName
foafmbox_sha1sum = toF "mbox_sha1sum"
-- | @foaf:member@ from .
foafmember :: ScopedName
foafmember = toF "member"
-- | @foaf:membershipClass@ from .
foafmembershipClass :: ScopedName
foafmembershipClass = toF "membershipClass"
-- | @foaf:msnChatID@ from .
foafmsnChatID :: ScopedName
foafmsnChatID = toF "msnChatID"
-- | @foaf:myersBriggs@ from .
foafmyersBriggs :: ScopedName
foafmyersBriggs = toF "myersBriggs"
-- | @foaf:name@ from .
foafname :: ScopedName
foafname = toF "name"
-- | @foaf:nick@ from .
foafnick :: ScopedName
foafnick = toF "nick"
-- | @foaf:openid@ from .
foafopenid :: ScopedName
foafopenid = toF "openid"
-- | @foaf:page@ from .
foafpage :: ScopedName
foafpage = toF "page"
-- | @foaf:pastProject@ from .
foafpastProject :: ScopedName
foafpastProject = toF "pastProject"
-- | @foaf:phone@ from .
foafphone :: ScopedName
foafphone = toF "phone"
-- | @foaf:plan@ from .
foafplan :: ScopedName
foafplan = toF "plan"
-- | @foaf:primaryTopic@ from .
foafprimaryTopic :: ScopedName
foafprimaryTopic = toF "primaryTopic"
-- | @foaf:publications@ from .
foafpublications :: ScopedName
foafpublications = toF "publications"
-- | @foaf:schoolHomepage@ from .
foafschoolHomepage :: ScopedName
foafschoolHomepage = toF "schoolHomepage"
-- | @foaf:sha1@ from .
foafsha1 :: ScopedName
foafsha1 = toF "sha1"
-- | @foaf:skypeID@ from .
foafskypeID :: ScopedName
foafskypeID = toF "skypeID"
-- | @foaf:status@ from .
foafstatus :: ScopedName
foafstatus = toF "status"
-- | @foaf:surname@ from .
foafsurname :: ScopedName
foafsurname = toF "surname"
-- | @foaf:theme@ from .
foaftheme :: ScopedName
foaftheme = toF "theme"
-- | @foaf:thumbnail@ from .
foafthumbnail :: ScopedName
foafthumbnail = toF "thumbnail"
-- | @foaf:tipjar@ from .
foaftipjar :: ScopedName
foaftipjar = toF "tipjar"
-- | @foaf:title@ from .
foaftitle :: ScopedName
foaftitle = toF "title"
-- | @foaf:topic@ from .
foaftopic :: ScopedName
foaftopic = toF "topic"
-- | @foaf:topic_interest@ from .
foaftopic_interest :: ScopedName
foaftopic_interest = toF "topic_interest"
-- | @foaf:weblog@ from .
foafweblog :: ScopedName
foafweblog = toF "weblog"
-- | @foaf:workInfoHomepage@ from .
foafworkInfoHomepage :: ScopedName
foafworkInfoHomepage = toF "workInfoHomepage"
-- | @foaf:workplaceHomepage@ from .
foafworkplaceHomepage :: ScopedName
foafworkplaceHomepage = toF "workplaceHomepage"
-- | @foaf:yahooChatID@ from .
foafyahooChatID :: ScopedName
foafyahooChatID = toF "yahooChatID"
--------------------------------------------------------------------------------
--
-- 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
--
--------------------------------------------------------------------------------