{-# LANGUAGE CPP #-}

-- |Defines types and utility functions related to namespaces, and
-- some predefined values for commonly used namespaces, such as
-- rdf, xsd, dublin core, etc.

module Data.RDF.Namespace(
  -- * Namespace types and functions
  Namespace(..), mkPlainNS, mkPrefixedNS, mkPrefixedNS',
  PrefixMapping(PrefixMapping), PrefixMappings(PrefixMappings), toPMList,
  mkUri,
  prefixOf, uriOf,
  -- * Predefined namespace values
  rdf, rdfs, dc, dct, owl, schema, xml, xsd, skos, foaf, ex, ex2,
  standard_ns_mappings, ns_mappings
) where

import Data.Maybe (catMaybes)
import qualified Data.Text as T
import Data.RDF.Types
import qualified Data.Map as Map
#if MIN_VERSION_base(4,9,0)
#if !MIN_VERSION_base(4,11,0)
  -- lts 10 says not needed
-- import Data.Semigroup
#else
#endif
#else
#endif

standard_namespaces :: [Namespace]
standard_namespaces :: [Namespace]
standard_namespaces = [Namespace
rdf, Namespace
rdfs, Namespace
dc, Namespace
dct, Namespace
schema, Namespace
owl, Namespace
xsd, Namespace
skos, Namespace
foaf, Namespace
ex, Namespace
ex2]

-- |The set of common predefined namespaces as a 'PrefixMappings' value.
standard_ns_mappings :: PrefixMappings
standard_ns_mappings :: PrefixMappings
standard_ns_mappings  =  [Namespace] -> PrefixMappings
ns_mappings [Namespace]
standard_namespaces

-- |Takes a list of 'Namespace's and returns 'PrefixMappings'.
ns_mappings :: [Namespace] -> PrefixMappings
ns_mappings :: [Namespace] -> PrefixMappings
ns_mappings [Namespace]
ns =  Map Text Text -> PrefixMappings
PrefixMappings (Map Text Text -> PrefixMappings)
-> Map Text Text -> PrefixMappings
forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, Text)] -> Map Text Text)
-> [(Text, Text)] -> Map Text Text
forall a b. (a -> b) -> a -> b
$ [Maybe (Text, Text)] -> [(Text, Text)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Text, Text)] -> [(Text, Text)])
-> [Maybe (Text, Text)] -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$
                     (Namespace -> Maybe (Text, Text))
-> [Namespace] -> [Maybe (Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Namespace
n -> case Namespace
n of
                              (PrefixedNS Text
pre Text
uri) -> (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
pre, Text
uri)
                              PlainNS Text
_ -> Maybe (Text, Text)
forall a. Maybe a
Nothing
                          ) [Namespace]
ns

-- |The RDF namespace.
rdf :: Namespace
rdf :: Namespace
rdf = String -> String -> Namespace
mkPrefixedNS' String
"rdf" String
"http://www.w3.org/1999/02/22-rdf-syntax-ns#"

-- |The RDF Schema namespace.
rdfs :: Namespace
rdfs :: Namespace
rdfs = String -> String -> Namespace
mkPrefixedNS' String
"rdfs" String
"http://www.w3.org/2000/01/rdf-schema#"

-- |The Dublin Core namespace.
dc :: Namespace
dc :: Namespace
dc = String -> String -> Namespace
mkPrefixedNS' String
"dc" String
"http://purl.org/dc/elements/1.1/"

-- |The Dublin Core terms namespace.
dct :: Namespace
dct :: Namespace
dct = String -> String -> Namespace
mkPrefixedNS' String
"dct" String
"http://purl.org/dc/terms/"

-- |The OWL namespace.
owl :: Namespace
owl :: Namespace
owl = String -> String -> Namespace
mkPrefixedNS' String
"owl" String
"http://www.w3.org/2002/07/owl#"

-- |The Schema.org namespace
schema :: Namespace
schema :: Namespace
schema = String -> String -> Namespace
mkPrefixedNS' String
"schema" String
"http://schema.org/"

-- |The XML Schema namespace.
xml :: Namespace
xml :: Namespace
xml = String -> String -> Namespace
mkPrefixedNS' String
"xml" String
"http://www.w3.org/XML/1998/namespace"

-- |The XML Schema namespace.
xsd :: Namespace
xsd :: Namespace
xsd = String -> String -> Namespace
mkPrefixedNS' String
"xsd" String
"http://www.w3.org/2001/XMLSchema#"

-- |The SKOS namespace.
skos :: Namespace
skos :: Namespace
skos = String -> String -> Namespace
mkPrefixedNS' String
"skos" String
"http://www.w3.org/2004/02/skos/core#"

-- |The friend of a friend namespace.
foaf :: Namespace
foaf :: Namespace
foaf = String -> String -> Namespace
mkPrefixedNS' String
"foaf" String
"http://xmlns.com/foaf/0.1/"

-- |Example namespace #1.
ex :: Namespace
ex :: Namespace
ex = String -> String -> Namespace
mkPrefixedNS' String
"ex" String
"http://www.example.org/"

-- |Example namespace #2.
ex2 :: Namespace
ex2 :: Namespace
ex2 = String -> String -> Namespace
mkPrefixedNS' String
"ex2" String
"http://www2.example.org/"

-- |View the prefix mappings as a list of key-value pairs. The PM in
-- in the name is to reduce name clashes if used without qualifying.
toPMList :: PrefixMappings -> [(T.Text, T.Text)]
toPMList :: PrefixMappings -> [(Text, Text)]
toPMList (PrefixMappings Map Text Text
m) = Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
m

-- |Make a URI consisting of the given namespace and the given localname.
mkUri :: Namespace -> T.Text -> T.Text
mkUri :: Namespace -> Text -> Text
mkUri Namespace
ns Text
local = Namespace -> Text
uriOf Namespace
ns Text -> Text -> Text
`T.append` Text
local


-- |Make a namespace for the given URI reference.
mkPlainNS :: T.Text -> Namespace
mkPlainNS :: Text -> Namespace
mkPlainNS = Text -> Namespace
PlainNS

-- |Make a namespace having the given prefix for the given URI reference,
-- respectively.
mkPrefixedNS :: T.Text -> T.Text -> Namespace
mkPrefixedNS :: Text -> Text -> Namespace
mkPrefixedNS = Text -> Text -> Namespace
PrefixedNS

-- |Make a namespace having the given prefix for the given URI reference,
-- respectively, using strings which will be converted to bytestrings
-- automatically.
mkPrefixedNS' :: String -> String -> Namespace
mkPrefixedNS' :: String -> String -> Namespace
mkPrefixedNS' String
s1 String
s2 = Text -> Text -> Namespace
mkPrefixedNS (String -> Text
T.pack String
s1) (String -> Text
T.pack String
s2)

-- |Determine the URI of the given namespace.
uriOf :: Namespace -> T.Text
uriOf :: Namespace -> Text
uriOf (PlainNS      Text
uri) = Text
uri
uriOf (PrefixedNS Text
_ Text
uri) = Text
uri

-- |Determine the prefix of the given namespace, if it has one.
prefixOf :: Namespace -> Maybe T.Text
prefixOf :: Namespace -> Maybe Text
prefixOf (PlainNS      Text
_) = Maybe Text
forall a. Maybe a
Nothing
prefixOf (PrefixedNS Text
p Text
_) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
p