    {-# 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 Maybe Text
    p URI
    _) = Maybe Text
    p

    -- | Returns the URI stored in the name space.
    getNamespaceURI :: Namespace -> URI
    getNamespaceURI :: Namespace -> URI
    getNamespaceURI (Namespace Maybe Text
    _ 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 Maybe Text
    p 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 Maybe Text
    _ URI
    u1) == :: Namespace -> Namespace -> Bool
    == (Namespace Maybe Text
    _ 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 Maybe Text
    a1 URI
    b1) compare :: Namespace -> Namespace -> Ordering
    `compare` (Namespace Maybe Text
    a2 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 Text
    p) URI
    u) = Text -> String
    forall a. Show a => a -> String
    show Text
    p String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ":<" 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]
    ++ String
    ">"
        show (Namespace Maybe Text
    _ URI
    u)        = String
    "<" 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]
    ++ String
    ">"

    -- | 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 Maybe Text
    _ 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 Maybe Text
    pre 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
      [ Text
    "@prefix ", Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe Text
    "" Maybe Text
    pre, Text
    ": <", String -> Text
    T.pack (URI -> String
    forall a. Show a => a -> String
    show URI
    uri), Text
    "> .\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 QName
    _ Namespace
    _ LName
    l) = LName
    l

    -- | Returns the namespace.
    getScopeNamespace :: ScopedName -> Namespace
    getScopeNamespace :: ScopedName -> Namespace
    getScopeNamespace (ScopedName QName
    _ Namespace
    ns LName
    _) = 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 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 (String
    "Unable to convert " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    s String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " 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
        ScopedName
    sn1 == :: ScopedName -> ScopedName -> Bool
    == 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 QName
    qn Namespace
    n LName
    l) = case Namespace -> Maybe Text
    getNamespacePrefix Namespace
    n of
          Just 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, Text
    ":", LName -> Text
    getLName LName
    l]
          Maybe Text
    _        -> 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 QName
    qn Namespace
    _ LName
    _) = 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 String
    str 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.
    makeScopedName ::
        Maybe T.Text  -- ^ prefix for the namespace
        -> URI        -- ^ namespace
        -> LName      -- ^ local name
        -> ScopedName
    makeScopedName :: Maybe Text -> URI -> LName -> ScopedName
    makeScopedName Maybe Text
    pre URI
    nsuri LName
    local =
        QName -> Namespace -> LName -> ScopedName
    ScopedName (URI -> LName -> QName
    newQName URI
    nsuri LName
    local)
                   (Maybe Text -> URI -> Namespace
    Namespace Maybe Text
    pre URI
    nsuri)
                   LName
    local

    -- |Construct a ScopedName from a QName.
    makeQNameScopedName ::
        Maybe T.Text   -- ^ prefix
        -> QName
        -> ScopedName
    makeQNameScopedName :: Maybe Text -> QName -> ScopedName
    makeQNameScopedName Maybe Text
    pre QName
    qn = QName -> Namespace -> LName -> ScopedName
    ScopedName QName
    qn (Maybe Text -> URI -> Namespace
    Namespace Maybe Text
    pre (QName -> URI
    getNamespace QName
    qn)) (QName -> LName
    getLocalName QName
    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 -> ScopedName
    makeURIScopedName URI
    uri = Maybe Text -> URI -> LName -> ScopedName
    makeScopedName Maybe Text
    forall a. Maybe a
    Nothing URI
    uri LName
    emptyLName

    -- | Construct a ScopedName.
    makeNSScopedName ::
        Namespace     -- ^ namespace
        -> LName      -- ^ local component
        -> ScopedName
    makeNSScopedName :: Namespace -> LName -> ScopedName
    makeNSScopedName Namespace
    ns LName
    local =
        QName -> Namespace -> LName -> ScopedName
    ScopedName (URI -> LName -> QName
    newQName (Namespace -> URI
    getNamespaceURI Namespace
    ns) LName
    local) Namespace
    ns LName
    local

    -- | This should never appear as a valid name
    nullScopedName :: ScopedName
    nullScopedName :: ScopedName
    nullScopedName = URI -> ScopedName
    makeURIScopedName URI
    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
    --
    --------------------------------------------------------------------------------