{-# 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, 2022 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 Text
p Text
utxt = 
  let ustr :: String
ustr = Text -> String
T.unpack Text
utxt
      uri :: URI
uri = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error (String
"Unable to convert " forall a. [a] -> [a] -> [a]
++ String
ustr forall a. [a] -> [a] -> [a]
++ String
" to a URI")) forall a b. (a -> b) -> a -> b
$
            String -> Maybe URI
parseURI String
ustr
  in Maybe Text -> URI -> Namespace
makeNamespace (forall a. a -> Maybe a
Just Text
p) URI
uri

toNSU :: T.Text -> URI -> Namespace
toNSU :: Text -> URI -> Namespace
toNSU Text
p = Maybe Text -> URI -> Namespace
makeNamespace (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 LName
lbl = 
    let dtn :: Text
dtn = LName -> Text
getLName LName
lbl
    in Text -> Text -> Namespace
toNS (Text
"xsd_" forall a. Monoid a => a -> a -> a
`mappend` Text
dtn)
           (forall a. Monoid a => [a] -> a
mconcat [Text
"http://id.ninebynine.org/2003/XMLSchema/", Text
dtn, Text
"#"])

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

-- | Maps @math@ to <http://www.w3.org/2000/10/swap/math#>.
namespaceMATH :: Namespace
namespaceMATH :: Namespace
namespaceMATH    = Text -> Text -> Namespace
toNS Text
"math"    Text
"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 Text
"log"    URI
namespaceLOGURI

-- | Maps @daml@ to <http://www.daml.org/2000/10/daml-ont#>.
namespaceDAML :: Namespace
namespaceDAML :: Namespace
namespaceDAML    = Text -> Text -> Namespace
toNS Text
"daml"    Text
"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 Text
"swish"  URI
namespaceSwishURI

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

tU :: String -> URI
tU :: String -> URI
tU = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"Internal error processing namespace 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 String
"http://id.ninebynine.org/2003/rdfext/rdfd#"
namespaceLOGURI :: URI
namespaceLOGURI   = String -> URI
tU String
"http://www.w3.org/2000/10/swap/log#"
namespaceSwishURI :: URI
namespaceSwishURI = String -> URI
tU String
"http://id.ninebynine.org/2003/Swish/"
namespaceDefaultURI :: URI
namespaceDefaultURI = String -> URI
tU String
"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 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 = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe LanguageTag
toLangTag 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 Text
_ NonEmpty Text
t1 == :: LanguageTag -> LanguageTag -> Bool
== LanguageTag Text
_ NonEmpty Text
t2 = NonEmpty Text
t1 forall a. Eq a => a -> a -> Bool
== NonEmpty Text
t2

instance Ord LanguageTag where
    LanguageTag Text
_ NonEmpty Text
t1 compare :: LanguageTag -> LanguageTag -> Ordering
`compare` LanguageTag Text
_ NonEmpty Text
t2 = NonEmpty Text
t1 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 Text
lbl = do
  let tag :: Text
tag = Text -> Text
T.toLower Text
lbl
      toks :: [Text]
toks = (Char -> Bool) -> Text -> [Text]
T.split (forall a. Eq a => a -> a -> Bool
== Char
'-') Text
tag
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Text
s -> let l :: Int
l = Text -> Int
T.length Text
s in Int
l forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
l forall a. Ord a => a -> a -> Bool
< Int
9) [Text]
toks)

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

    [] -> forall a. Maybe a
Nothing

-- | Convert a language tag back into text form.
fromLangTag :: LanguageTag -> T.Text
fromLangTag :: LanguageTag -> Text
fromLangTag (LanguageTag Text
f NonEmpty Text
_) = 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 Text
_ (Text
a :| [Text]
as)) 
               (LanguageTag Text
_ (Text
b :| [Text]
bs))
                   | Text
a forall a. Eq a => a -> a -> Bool
== Text
b    = [Text]
as 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 Text
"rs_rdf"   Text
"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 Text
"rs_rdfs"  Text
"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 Text
"rs_rdfd"  Text
"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 LName
"GeneralRestriction"

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

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

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

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

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

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