{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -------------------------------------------------------------------------------- -- See end of this file for licence information. -------------------------------------------------------------------------------- -- | -- Module : Namespace -- 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 algebraic datatypes for namespaces and scoped names. -- -- For these purposes, a namespace is a prefix and URI used to identify -- a namespace (cf. XML namespaces), and a scoped name is a name that -- is scoped by a specified namespace. -- -------------------------------------------------------------------------------- module Swish.Namespace ( Namespace , makeNamespace, makeNamespaceQName , getNamespacePrefix, getNamespaceURI, getNamespaceTuple -- , nullNamespace , ScopedName , getScopeNamespace, getScopeLocal , getScopePrefix, getScopeURI , getQName, getScopedNameURI , matchName , makeScopedName , makeQNameScopedName , makeURIScopedName , makeNSScopedName , nullScopedName , namespaceToBuilder ) where import Swish.QName (QName, LName, newQName, getLName, emptyLName, getQNameURI, getNamespace, getLocalName) import Data.Maybe (fromMaybe) #if (!defined(__GLASGOW_HASKELL__)) || (__GLASGOW_HASKELL__ < 710) import Data.Monoid (Monoid(..)) #endif import Data.Ord (comparing) import Data.String (IsString(..)) import Network.URI (URI(..), parseURIReference, nullURI) import qualified Data.Text as T import qualified Data.Text.Lazy.Builder as B ------------------------------------------------------------ -- Namespace, having a prefix and a URI ------------------------------------------------------------ -- |A NameSpace value consists of an optional prefix and a corresponding URI. -- data Namespace = Namespace (Maybe T.Text) URI -- data Namespace = Namespace (Maybe T.Text) !URI -- TODO: look at interning the URI -- | Returns the prefix stored in the name space. getNamespacePrefix :: Namespace -> Maybe T.Text getNamespacePrefix (Namespace p _) = p -- | Returns the URI stored in the name space. getNamespaceURI :: Namespace -> URI getNamespaceURI (Namespace _ u) = u -- | Convert the name space to a (prefix, URI) tuple. getNamespaceTuple :: Namespace -> (Maybe T.Text, URI) getNamespaceTuple (Namespace p u) = (p, u) -- | Equality is defined by the URI, not by the prefix -- (so the same URI with different prefixes will be -- considered to be equal). instance Eq Namespace where (Namespace _ u1) == (Namespace _ u2) = u1 == u2 instance Ord Namespace where -- using show for the URI is wasteful (Namespace a1 b1) `compare` (Namespace a2 b2) = (a1, show b1) `compare` (a2, show b2) instance Show Namespace where show (Namespace (Just p) u) = show p ++ ":<" ++ show u ++ ">" show (Namespace _ u) = "<" ++ show u ++ ">" -- | Create a name space from a URI and an optional prefix label. makeNamespace :: Maybe T.Text -- ^ optional prefix. -> URI -- ^ URI. -> Namespace makeNamespace = Namespace -- | Create a qualified name by combining the URI from -- the name space with a local component. makeNamespaceQName :: Namespace -- ^ The name space URI is used in the qualified name -> LName -- ^ local component of the qualified name (can be 'emptyLName') -> QName makeNamespaceQName (Namespace _ uri) = newQName uri {- nullNamespace :: Namespace nullNamespace = Namespace Nothing "" -} -- | Utility routine to create a \@prefix line (matching N3/Turtle) -- grammar for this namespace. -- namespaceToBuilder :: Namespace -> B.Builder namespaceToBuilder (Namespace pre uri) = mconcat $ map B.fromText [ "@prefix ", fromMaybe "" pre, ": <", T.pack (show uri), "> .\n"] ------------------------------------------------------------ -- ScopedName, made from a namespace and a local name ------------------------------------------------------------ -- | A full ScopedName value has a QName prefix, namespace URI -- and a local part. ScopedName values may omit the prefix -- (see 'Namespace') or the local part. -- -- Some applications may handle null namespace URIs as meaning -- the local part is relative to some base URI. -- data ScopedName = ScopedName !QName Namespace LName -- | Returns the local part. getScopeLocal :: ScopedName -> LName getScopeLocal (ScopedName _ _ l) = l -- | Returns the namespace. getScopeNamespace :: ScopedName -> Namespace getScopeNamespace (ScopedName _ ns _) = ns -- | Returns the prefix of the namespace, if set. getScopePrefix :: ScopedName -> Maybe T.Text getScopePrefix = getNamespacePrefix . getScopeNamespace -- | Returns the URI of the namespace. getScopeURI :: ScopedName -> URI getScopeURI = getNamespaceURI . getScopeNamespace -- | This is not total since it will fail if the input string is not a valid 'URI'. instance IsString ScopedName where fromString s = maybe (error ("Unable to convert " ++ s ++ " into a ScopedName")) makeURIScopedName (parseURIReference s) -- | Scoped names are equal if their corresponding 'QName' values are equal. instance Eq ScopedName where sn1 == sn2 = getQName sn1 == getQName sn2 -- | Scoped names are ordered by their 'QName' components. instance Ord ScopedName where compare = comparing getQName -- | If there is a namespace associated then the Show instance -- uses @prefix:local@, otherwise @@. instance Show ScopedName where show (ScopedName qn n l) = case getNamespacePrefix n of Just pre -> T.unpack $ mconcat [pre, ":", getLName l] _ -> show qn -- "<" ++ show (getNamespaceURI n) ++ T.unpack l ++ ">" -- |Get the QName corresponding to a scoped name. getQName :: ScopedName -> QName getQName (ScopedName qn _ _) = qn -- |Get URI corresponding to a scoped name (using RDF conventions). getScopedNameURI :: ScopedName -> URI getScopedNameURI = getQNameURI . getQName -- |Test if supplied string matches the display form of a -- scoped name. matchName :: String -> ScopedName -> Bool matchName str nam = str == show nam -- |Construct a ScopedName. makeScopedName :: Maybe T.Text -- ^ prefix for the namespace -> URI -- ^ namespace -> LName -- ^ local name -> ScopedName makeScopedName pre nsuri local = ScopedName (newQName nsuri local) (Namespace pre nsuri) local -- |Construct a ScopedName from a QName. makeQNameScopedName :: Maybe T.Text -- ^ prefix -> QName -> ScopedName makeQNameScopedName pre qn = ScopedName qn (Namespace pre (getNamespace qn)) (getLocalName qn) -- could use qnameFromURI to find a local name if there is one. -- | Construct a ScopedName for a bare URI (the label is set to \"\"). makeURIScopedName :: URI -> ScopedName makeURIScopedName uri = makeScopedName Nothing uri emptyLName -- | Construct a ScopedName. makeNSScopedName :: Namespace -- ^ namespace -> LName -- ^ local component -> ScopedName makeNSScopedName ns local = ScopedName (newQName (getNamespaceURI ns) local) ns local -- | This should never appear as a valid name nullScopedName :: ScopedName nullScopedName = makeURIScopedName nullURI -------------------------------------------------------------------------------- -- -- 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 -- --------------------------------------------------------------------------------