{-# 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 -> Maybe Text
getNamespacePrefix (Namespace p :: Maybe Text
p _) = Maybe Text
p

-- | Returns the URI stored in the name space.
getNamespaceURI :: Namespace -> URI
getNamespaceURI :: Namespace -> URI
getNamespaceURI (Namespace _ u :: URI
u) = URI
u

-- | Convert the name space to a (prefix, URI) tuple.
getNamespaceTuple :: Namespace -> (Maybe T.Text, URI)
getNamespaceTuple :: Namespace -> (Maybe Text, URI)
getNamespaceTuple (Namespace p :: Maybe Text
p u :: URI
u) = (Maybe Text
p, URI
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 :: URI
u1) == :: Namespace -> Namespace -> Bool
== (Namespace _ u2 :: URI
u2) = URI
u1 URI -> URI -> Bool
forall a. Eq a => a -> a -> Bool
== URI
u2

instance Ord Namespace where
    -- using show for the URI is wasteful
    (Namespace a1 :: Maybe Text
a1 b1 :: URI
b1) compare :: Namespace -> Namespace -> Ordering
`compare` (Namespace a2 :: Maybe Text
a2 b2 :: URI
b2) =
        (Maybe Text
a1, URI -> String
forall a. Show a => a -> String
show URI
b1) (Maybe Text, String) -> (Maybe Text, String) -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (Maybe Text
a2, URI -> String
forall a. Show a => a -> String
show URI
b2)

instance Show Namespace where
    show :: Namespace -> String
show (Namespace (Just p :: Text
p) u :: URI
u) = Text -> String
forall a. Show a => a -> String
show Text
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ ":<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ URI -> String
forall a. Show a => a -> String
show URI
u String -> ShowS
forall a. [a] -> [a] -> [a]
++ ">"
    show (Namespace _ u :: URI
u)        = "<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ URI -> String
forall a. Show a => a -> String
show URI
u String -> ShowS
forall a. [a] -> [a] -> [a]
++ ">"

-- | Create a name space from a URI and an optional prefix label.
makeNamespace :: 
    Maybe T.Text  -- ^ optional prefix.
    -> URI        -- ^ URI.
    -> Namespace
makeNamespace :: Maybe Text -> URI -> Namespace
makeNamespace = Maybe Text -> URI -> Namespace
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 -> LName -> QName
makeNamespaceQName (Namespace _ uri :: URI
uri) = URI -> LName -> QName
newQName URI
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 -> Builder
namespaceToBuilder (Namespace pre :: Maybe Text
pre uri :: URI
uri) =
  [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ (Text -> Builder) -> [Text] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Builder
B.fromText 
  [ "@prefix ", Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "" Maybe Text
pre, ": <", String -> Text
T.pack (URI -> String
forall a. Show a => a -> String
show URI
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 -> LName
getScopeLocal (ScopedName _ _ l :: LName
l) = LName
l

-- | Returns the namespace.
getScopeNamespace :: ScopedName -> Namespace
getScopeNamespace :: ScopedName -> Namespace
getScopeNamespace (ScopedName _ ns :: Namespace
ns _) = Namespace
ns

-- | Returns the prefix of the namespace, if set.
getScopePrefix :: ScopedName -> Maybe T.Text
getScopePrefix :: ScopedName -> Maybe Text
getScopePrefix = Namespace -> Maybe Text
getNamespacePrefix (Namespace -> Maybe Text)
-> (ScopedName -> Namespace) -> ScopedName -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScopedName -> Namespace
getScopeNamespace

-- | Returns the URI of the namespace.
getScopeURI :: ScopedName -> URI
getScopeURI :: ScopedName -> URI
getScopeURI = Namespace -> URI
getNamespaceURI (Namespace -> URI)
-> (ScopedName -> Namespace) -> ScopedName -> URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScopedName -> Namespace
getScopeNamespace

-- | This is not total since it will fail if the input string is not a valid 'URI'.
instance IsString ScopedName where
  fromString :: String -> ScopedName
fromString s :: String
s =
    ScopedName -> (URI -> ScopedName) -> Maybe URI -> ScopedName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> ScopedName
forall a. HasCallStack => String -> a
error ("Unable to convert " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ " into a ScopedName"))
          URI -> ScopedName
makeURIScopedName (String -> Maybe URI
parseURIReference String
s)
    
-- | Scoped names are equal if their corresponding 'QName' values are equal.
instance Eq ScopedName where
    sn1 :: ScopedName
sn1 == :: ScopedName -> ScopedName -> Bool
== sn2 :: ScopedName
sn2 = ScopedName -> QName
getQName ScopedName
sn1 QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
== ScopedName -> QName
getQName ScopedName
sn2

-- | Scoped names are ordered by their 'QName' components.
instance Ord ScopedName where
    compare :: ScopedName -> ScopedName -> Ordering
compare = (ScopedName -> QName) -> ScopedName -> ScopedName -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ScopedName -> QName
getQName

-- | If there is a namespace associated then the Show instance
-- uses @prefix:local@, otherwise @<url>@.
instance Show ScopedName where
    show :: ScopedName -> String
show (ScopedName qn :: QName
qn n :: Namespace
n l :: LName
l) = case Namespace -> Maybe Text
getNamespacePrefix Namespace
n of
      Just pre :: Text
pre -> Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
pre, ":", LName -> Text
getLName LName
l]
      _        -> QName -> String
forall a. Show a => a -> String
show QName
qn -- "<" ++ show (getNamespaceURI n) ++ T.unpack l ++ ">"

-- |Get the QName corresponding to a scoped name.
getQName :: ScopedName -> QName
getQName :: ScopedName -> QName
getQName (ScopedName qn :: QName
qn _ _) = QName
qn

-- |Get URI corresponding to a scoped name (using RDF conventions).
getScopedNameURI :: ScopedName -> URI
getScopedNameURI :: ScopedName -> URI
getScopedNameURI = QName -> URI
getQNameURI (QName -> URI) -> (ScopedName -> QName) -> ScopedName -> URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScopedName -> QName
getQName

-- |Test if supplied string matches the display form of a
--  scoped name.
matchName :: String -> ScopedName -> Bool
matchName :: String -> ScopedName -> Bool
matchName str :: String
str nam :: ScopedName
nam = String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== ScopedName -> String
forall a. Show a => a -> String
show ScopedName
nam

-- |Construct a ScopedName.
pan class="annot">makeScoe>langTag,
 and isLang    -comment">--an>
-- "<" ++ show (getNamespaceURI n) ++ T.unpack l ++ ">"-- |Construct a ScopedName.
getScopedNameURI = span> span> [exitcode :: SwishStatus
>-6989586621679152292">sn1  -- | Represenclass="annot"-- |Construct a er hs-var">nam = getScopedNameURI :: ScopedName 
="annot">RDFFormula   String -title="Swish.RDF.mpty (lb, GraphPartition lb)
p2sString -title="Swish.RDF.mpty (lb, GraphPartition lb)
$nam
b, span> span> [ (GraphPartition nam
bbScopedName
nam
(p2sString -> Namespace
GenLabelEntry comps
        comps
        GenLabelEntry 

(p2sString -> Namespactifier hs-var">comps
  • < local Namepan>">-> Prelude.show Word32 -- | Scoped names are ordered by their 'QName' componeName">getLName]r">_) = --ScopedName app2 :: [Maybe vn] -> garBinding lb vn -> [VarBinding lb vn]>ScopedName b a l2 == l class="hs-identifier hs-type">lb>#

    Arguments

    let (= $ [GraphPartition lb] ph[GraphPartition lb] -> [GraphPartition lb] -> [GraphPartition lb] forall a. [a] -> [a] -> [a">ph[GraphPartition lb] -> [GraphPartition lb] -> [GraphPartition lb] forall a. [a] ->(1679151545">d@b [GraphPartition lb] -> [GraphPartition lb] -> [GraphPartition lb] forall a. [a] -> [a] -> [a">phgraphMatch1 Bool False -- also appear in any number of 'PartObj' constructors. -- 0 ss="annottext">span> [(Maybe [d], [a]) -> Maybe al-6989586621679an class="annottext">Namepan>[GraphPartition lb] ph< -> URI span class=dentifier hs-var">ph<9586 -t; URI span class=dentifier hs-var">ph<9586 -t; URI span class=dentifier">ph< -> URI span class=dentifier hs-var">ph<9586 -t; U title="Swish.RDF.Vocabulary.RDF">Swish.RDF.Vocabulary.RDF, Swish.RDF.Vocabulary
    rdfsLiteralph<9586 -t; U title="Swish.RDF.Vocabulary.RDF">Swish.RDF.Vocabulary.RDF, Swish.RDF.Vocabulary
    nam str Word32 nam = String str String -> String -> Bonnottetails-toggle" data-2167915226 --an> -- "<" ++ show (getNamespaceURI n) ++ T.unpack l ++ ">"-- |Construct a ScopedName. nottext">String -> Namespactifier hs-var">comps
  • < local Naan> nottext">String -> String -> String -> Bonnottetails-toggle" data-2167915226 Naan> nottext">String -> String -> String -> Bonnottetails-toggle" data-2167915226 ":"span id="local-698958662167915184lass="hs-string">&qb vn]>ScopedName ":"span id="local-698958662167 hs-var">comps [ lmap621679an class="annottext">Naan> nottext">String -> S-comment">-- * Nodes that are the subject of at least one statement appear as pan> , lb, Eq , Eq?ss="tanot">Eq?ss="tanot">Eq?ss="tanot">Eq?s Eq?ss="tanot">Eq?ss="tanot">Eq?ss="tanot">Eq?s VarBinding lb vn vbind) [lb] removeBy fmap (Iclass="hs-identifier hs-type">SwishState -> , Eq?ss="tanot">Just ss="annot">lbremoveBy63/span>removeBy63/span>removeBy63/span>removeBy63/span>QNameremoveBy63/span>QNameremoveBy63/span>(Bool -> Bool) -> ((lb, b) -> Bool) -> (lb, b) -> Bool foemoveBy63/span>(Bool -&Ford">where -- | Scoped names are equal if their corresponding 'QName' values are equal.