    {-# LANGUAGE CPP #-}
    {-# LANGUAGE OverloadedStrings #-}

    --------------------------------------------------------------------------------
    --  See end of this file for licence information.
    --------------------------------------------------------------------------------
    -- |
    --  Module      :  Vocabulary
    --  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2014, 2021 Douglas Burke
    --  License     :  GPL V2
    --
    --  Maintainer  :  Douglas Burke
    --  Stability   :  experimental
    --  Portability :  CPP, OverloadedStrings
    --
    --  This module defines some commonly used vocabulary terms,
    --  using the 'Namespace' and 'ScopedName' data types. Additional vocabularies
    --  are available in the set of @Swish.RDF.Vocabulary.*@ modules, parts of
    --  which are re-exported by this module
    --
    --------------------------------------------------------------------------------

    module Swish.RDF.Vocabulary
        (
          -- * Namespaces

          namespaceRDFD
        , namespaceXsdType
        , namespaceMATH
        , namespaceLOG
        , namespaceDAML
        , namespaceDefault
        , namespaceSwish

        -- ** RDF rules
        -- | The namespaces refer to RDF rules and axioms.
        , scopeRDF
        , scopeRDFS
        , scopeRDFD

        -- * Language tags
        --
        -- | Support for language tags that follow RFC 3066.
        --
        -- This replaces the use of @ScopedName@ and @langName@, @langTag@,
        -- and @isLang@ in versions prior to @0.7.0.0@.
        --
        , LanguageTag
        , toLangTag
        , fromLangTag
        , isBaseLang

        -- * Miscellaneous routines
        , swishName
        , rdfdGeneralRestriction
        , rdfdOnProperties, rdfdConstraint, rdfdMaxCardinality
        , logImplies
        , defaultBase

        -- * Re-exported modules
        , module Swish.RDF.Vocabulary.RDF
        , module Swish.RDF.Vocabulary.OWL
        , module Swish.RDF.Vocabulary.XSD
        )
    where

    import Swish.Namespace (Namespace, ScopedName, makeNamespace, makeNSScopedName)
    import Swish.QName (LName, getLName)

    import Swish.RDF.Vocabulary.RDF
    import Swish.RDF.Vocabulary.OWL
    import Swish.RDF.Vocabulary.XSD

    import Control.Monad (guard)

    import Data.Char (isDigit, isAsciiLower)
    import Data.List (isPrefixOf)
    import Data.List.NonEmpty (NonEmpty(..))
    #if (!defined(__GLASGOW_HASKELL__)) || (__GLASGOW_HASKELL__ < 710)
    import Data.Monoid (mappend, mconcat)
    #endif
    import Data.Maybe (fromJust, fromMaybe)
    import Data.String (IsString(..))

    import Network.URI (URI, parseURI)

    import qualified Data.List.NonEmpty as NE
    import qualified Data.Text as T

    ------------------------------------------------------------
    --  Define some common namespace values
    ------------------------------------------------------------

    toNS :: T.Text -> T.Text -> Namespace
    toNS :: Text -> Text -> Namespace
    toNS p :: Text
    p utxt :: Text
    utxt =
      let ustr :: String
    ustr = Text -> String
    T.unpack Text
    utxt
          uri :: URI
    uri = URI -> Maybe URI -> URI
    forall a. a -> Maybe a -> a
    fromMaybe (String -> URI
    forall a. HasCallStack => String -> a
    error ("Unable to convert " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ustr String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " to a URI")) (Maybe URI -> URI) -> Maybe URI -> URI
    forall a b. (a -> b) -> a -> b
    $
                String -> Maybe URI
    parseURI String
    ustr
      in Maybe Text -> URI -> Namespace
    makeNamespace (Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    p) URI
    uri

    toNSU :: T.Text -> URI -> Namespace
    toNSU :: Text -> URI -> Namespace
    toNSU p :: Text
    p = Maybe Text -> URI -> Namespace
    makeNamespace (Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    p)

    -- | Create a namespace for the datatype family schema used by Swish.
    namespaceXsdType ::
      LName        -- ^ local name
      -> Namespace
      -- ^ Namespace has prefix @xsd_lbl@ and
      -- URI of @http:\/\/id.ninebynine.org\/2003\/XMLSchema\/lbl#@.
    namespaceXsdType :: LName -> Namespace
    namespaceXsdType lbl :: LName
    lbl =
        let dtn :: Text
    dtn = LName -> Text
    getLName LName
    lbl
        in Text -> Text -> Namespace
    toNS ("xsd_" Text -> Text -> Text
    forall a. Monoid a => a -> a -> a
    `mappend` Text
    dtn)
               ([Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat ["http://id.ninebynine.org/2003/XMLSchema/", Text
    dtn, "#"])

    -- | Maps @rdfd@ to @http:\/\/id.ninebynine.org\/2003\/rdfext\/rdfd#@.
    namespaceRDFD :: Namespace
    namespaceRDFD :: Namespace
    namespaceRDFD    = Text -> URI -> Namespace
    toNSU "rdfd"   URI
    namespaceRDFDURI

    -- | Maps @math@ to <http://www.w3.org/2000/10/swap/math#>.
    namespaceMATH :: Namespace
    namespaceMATH :: Namespace
    namespaceMATH    = Text -> Text -> Namespace
    toNS "math"    "http://www.w3.org/2000/10/swap/math#"

    -- | Maps @log@ to <http://www.w3.org/2000/10/swap/log#>.
    namespaceLOG :: Namespace
    namespaceLOG :: Namespace
    namespaceLOG     = Text -> URI -> Namespace
    toNSU "log"    URI
    namespaceLOGURI

    -- | Maps @daml@ to <http://www.daml.org/2000/10/daml-ont#>.
    namespaceDAML :: Namespace
    namespaceDAML :: Namespace
    namespaceDAML    = Text -> Text -> Namespace
    toNS "daml"    "http://www.daml.org/2000/10/daml-ont#"

    -- | Maps @swish@ to @http:\/\/id.ninebynine.org\/2003\/Swish\/@.
    namespaceSwish :: Namespace
    namespaceSwish :: Namespace
    namespaceSwish   = Text -> URI -> Namespace
    toNSU "swish"  URI
    namespaceSwishURI

    -- | Maps @default@ to @http:\/\/id.ninebynine.org\/default\/@.
    namespaceDefault :: Namespace
    namespaceDefault :: Namespace
    namespaceDefault = Text -> URI -> Namespace
    toNSU "default" URI
    namespaceDefaultURI

    tU :: String -> URI
    tU :: String -> URI
    tU = URI -> Maybe URI -> URI
    forall a. a -> Maybe a -> a
    fromMaybe (String -> URI
    forall a. HasCallStack => String -> a
    error "Internal error processing namespace URI") (Maybe URI -> URI) -> (String -> Maybe URI) -> String -> URI
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Maybe URI
    parseURI

    namespaceRDFDURI,
      namespaceLOGURI,
      namespaceSwishURI,
      namespaceDefaultURI :: URI
    namespaceRDFDURI :: URI
    namespaceRDFDURI  = String -> URI
    tU "http://id.ninebynine.org/2003/rdfext/rdfd#"
    namespaceLOGURI :: URI
    namespaceLOGURI   = String -> URI
    tU "http://www.w3.org/2000/10/swap/log#"
    namespaceSwishURI :: URI
    namespaceSwishURI = String -> URI
    tU "http://id.ninebynine.org/2003/Swish/"
    namespaceDefaultURI :: URI
    namespaceDefaultURI = String -> URI
    tU "http://id.ninebynine.org/default/"

    -- | Convert a local name to a scoped name in the @swish@ namespace (`namespaceSwish`).
    swishName :: LName -> ScopedName
    swishName :: LName -> ScopedName
    swishName = Namespace -> LName -> ScopedName
    makeNSScopedName Namespace
    namespaceSwish

    -----------------------------------------------------------
    --  Language tags
    ------------------------------------------------------------
    --
    --  Note:  simple language tag URIs may be abbreviated as lang:tag,
    --  but if the tag contains a hyphen, this would not be valid QName
    --  form in Notation3, even though it is a valid QName component.
    --  Fortunately, they do not currently need to appear in Notation3 as
    --  distinct labels (but future developments may change that).

    -- | Represent the language tag for a literal string, following
    -- RFC 3066 <http://www.ietf.org/rfc/rfc3066.txt>.
    --
    -- Use 'toLangTag' to create a tag and 'fromLangTag' to
    -- convert back. The case is preserved for the tag, although
    -- comparison (both the 'Eq' instance and 'compareLangTag')
    -- is done using the lower-case form of the tags.
    --
    -- As an example:
    --
    -- > Prelude> :set prompt "swish> "
    -- > swish> :set -XOverloadedStrings
    -- > swish> :m + Swish.RDF.Vocabulary
    -- > swish> let en = "en" :: LanguageTag
    -- > swish> let us = "en-us" :: LanguageTag
    -- > swish> let gb = "en-GB" :: LanguageTag
    -- > swish> gb
    -- > en-GB
    -- > swish> gb == "en-gb"
    -- > True
    -- > swish> en == us
    -- > False
    -- > swish> en `isBaseLang` us
    -- > True
    -- > swish> us `isBaseLang` en
    -- > False
    -- > swish> us `isBaseLang` gb
    -- > False
    --
    data LanguageTag =
        LanguageTag T.Text (NonEmpty T.Text)
        -- store full value, then the tags

    instance Show LanguageTag where
        show :: LanguageTag -> String
    show = Text -> String
    T.unpack (Text -> String) -> (LanguageTag -> Text) -> LanguageTag -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LanguageTag -> Text
    fromLangTag

    -- | The 'IsString' instance is not total since it will fail
    -- given a syntactically-invalid language tag.
    instance IsString LanguageTag where
        fromString :: String -> LanguageTag
    fromString = Maybe LanguageTag -> LanguageTag
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe LanguageTag -> LanguageTag)
    -> (String -> Maybe LanguageTag) -> String -> LanguageTag
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Maybe LanguageTag
    toLangTag (Text -> Maybe LanguageTag)
    -> (String -> Text) -> String -> Maybe LanguageTag
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text
    T.pack

    -- | The equality test matches on the full definition, so
    -- @en-GB@ does not match @en@. See also 'isBaseLang'.
    instance Eq LanguageTag where
        LanguageTag _ t1 :: NonEmpty Text
    t1 == :: LanguageTag -> LanguageTag -> Bool
    == LanguageTag _ t2 :: NonEmpty Text
    t2 = NonEmpty Text
    t1 NonEmpty Text -> NonEmpty Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == NonEmpty Text
    t2

    instance Ord LanguageTag where
        LanguageTag _ t1 :: NonEmpty Text
    t1 compare :: LanguageTag -> LanguageTag -> Ordering
    `compare` LanguageTag _ t2 :: NonEmpty Text
    t2 = NonEmpty Text
    t1 NonEmpty Text -> NonEmpty Text -> Ordering
    forall a. Ord a => a -> a -> Ordering
    `compare` NonEmpty Text
    t2

    -- | Create a 'LanguageTag' element from the label.
    --
    -- Valid tags follow the ABNF from RCF 3066, which is
    --
    -- >   Language-Tag = Primary-subtag *( "-" Subtag )
    -- >   Primary-subtag = 1*8ALPHA
    -- >   Subtag = 1*8(ALPHA / DIGIT)
    --
    -- There are no checks that the primary or secondary sub tag
    -- values are defined in any standard, such as ISO 639,
    -- or obey any other syntactical restriction than given above.
    --
    toLangTag :: T.Text -> Maybe LanguageTag
    toLangTag :: Text -> Maybe LanguageTag
    toLangTag lbl :: Text
    lbl = do
      let tag :: Text
    tag = Text -> Text
    T.toLower Text
    lbl
          toks :: [Text]
    toks = (Char -> Bool) -> Text -> [Text]
    T.split (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    =='-') Text
    tag
      Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard ((Text -> Bool) -> [Text] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (\s :: Text
    s -> let l :: Int
    l = Text -> Int
    T.length Text
    s in Int
    l Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0 Bool -> Bool -> Bool
    && Int
    l Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 9) [Text]
    toks)

      -- T.split can't return [] but the compiler doesn't know this
      case [Text]
    toks of
        primtag :: Text
    primtag : subtags :: [Text]
    subtags -> do
          Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard ((Char -> Bool) -> Text -> Bool
    T.all Char -> Bool
    isAsciiLower Text
    primtag Bool -> Bool -> Bool
    && (Text -> Bool) -> [Text] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ((Char -> Bool) -> Text -> Bool
    T.all (\c :: Char
    c -> Char -> Bool
    isAsciiLower Char
    c Bool -> Bool -> Bool
    || Char -> Bool
    isDigit Char
    c)) [Text]
    subtags)
          LanguageTag -> Maybe LanguageTag
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (LanguageTag -> Maybe LanguageTag)
    -> LanguageTag -> Maybe LanguageTag
    forall a b. (a -> b) -> a -> b
    $ Text -> NonEmpty Text -> LanguageTag
    LanguageTag Text
    lbl ([Text] -> NonEmpty Text
    forall a. [a] -> NonEmpty a
    NE.fromList [Text]
    toks)

        [] -> Maybe LanguageTag
    forall a. Maybe a
    Nothing

    -- | Convert a language tag back into text form.
    fromLangTag :: LanguageTag -> T.Text
    fromLangTag :: LanguageTag -> Text
    fromLangTag (LanguageTag f :: Text
    f _) = Text
    f

    -- | Compare language tags using the Language-range specification
    -- in section 2.5 of RFC 3066.
    --
    -- 'True' is returned if the comparison tag is the same as, or
    -- matches a prefix of, the base tag (where the match must be
    -- over complete sub tags).
    --
    -- Note that
    --
    -- > l1 `isBaseLang` l2 == l2 `isBaseLang` l1
    --
    -- only when
    --
    -- > l1 == l2
    --
    isBaseLang ::
        LanguageTag     -- ^ base language
        -> LanguageTag  -- ^ comparison language
        -> Bool
    isBaseLang :: LanguageTag -> LanguageTag -> Bool
    isBaseLang (LanguageTag _ (a :: Text
    a :| as :: [Text]
    as))
                   (LanguageTag _ (b :: Text
    b :| bs :: [Text]
    bs))
                       | Text
    a Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    b    = [Text]
    as [Text] -> [Text] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` [Text]
    bs
                       | Bool
    otherwise = Bool
    False

    ------------------------------------------------------------
    --  Define namespaces for RDF rules, axioms, etc
    ------------------------------------------------------------

    -- | Maps @rs_rdf@ to @http:\/\/id.ninebynine.org\/2003\/Ruleset\/rdf#@.
    scopeRDF :: Namespace
    scopeRDF :: Namespace
    scopeRDF  = Text -> Text -> Namespace
    toNS "rs_rdf"   "http://id.ninebynine.org/2003/Ruleset/rdf#"

    -- | Maps @rs_rdfs@ to @http:\/\/id.ninebynine.org\/2003\/Ruleset\/rdfs#@.
    scopeRDFS :: Namespace
    scopeRDFS :: Namespace
    scopeRDFS = Text -> Text -> Namespace
    toNS "rs_rdfs"  "http://id.ninebynine.org/2003/Ruleset/rdfs#"

    -- | Maps @rs_rdfd@ to @http:\/\/id.ninebynine.org\/2003\/Ruleset\/rdfd#@.
    scopeRDFD :: Namespace
    scopeRDFD :: Namespace
    scopeRDFD = Text -> Text -> Namespace
    toNS "rs_rdfd"  "http://id.ninebynine.org/2003/Ruleset/rdfd#"

    ------------------------------------------------------------
    --  Define some common vocabulary terms
    ------------------------------------------------------------

    toRDFD :: LName -> ScopedName
    toRDFD :: LName -> ScopedName
    toRDFD = Namespace -> LName -> ScopedName
    makeNSScopedName Namespace
    namespaceRDFD

    -- | @rdfd:GeneralRestriction@.
    rdfdGeneralRestriction :: ScopedName
    rdfdGeneralRestriction :: ScopedName
    rdfdGeneralRestriction = LName -> ScopedName
    toRDFD "GeneralRestriction"

    -- | @rdfd:onProperties@.
    rdfdOnProperties :: ScopedName
    rdfdOnProperties :: ScopedName
    rdfdOnProperties = LName -> ScopedName
    toRDFD "onProperties"

    -- | @rdfd:constraint@.
    rdfdConstraint :: ScopedName
    rdfdConstraint :: ScopedName
    rdfdConstraint = LName -> ScopedName
    toRDFD "constraint"

    -- | @rdfd:maxCardinality@.
    rdfdMaxCardinality :: ScopedName
    rdfdMaxCardinality :: ScopedName
    rdfdMaxCardinality = LName -> ScopedName
    toRDFD "maxCardinality"

    -- | @log:implies@.
    logImplies  :: ScopedName
    logImplies :: ScopedName
    logImplies  = Namespace -> LName -> ScopedName
    makeNSScopedName Namespace
    namespaceLOG "implies"

    -- | @default:base@.
    defaultBase :: ScopedName
    defaultBase :: ScopedName
    defaultBase = Namespace -> LName -> ScopedName
    makeNSScopedName Namespace
    namespaceDefault "base"

    --------------------------------------------------------------------------------
    --
    --  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2014, 2021 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
    --
    --------------------------------------------------------------------------------