{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}

module Data.RDF.Types
  ( -- * RDF triples, nodes and literals
    LValue (PlainL, PlainLL, TypedL),
    Node (UNode, BNode, BNodeGen, LNode),
    Subject,
    Predicate,
    Object,
    Triple (Triple),
    Triples,
    View (view),

    -- * Constructor functions
    plainL,
    plainLL,
    typedL,
    unode,
    bnode,
    bnodeUnsafe,
    lnode,
    triple,
    unodeValidate,
    uriValidate,
    uriValidateString,

    -- * Node query function
    isUNode,
    isLNode,
    isBNode,

    -- * Miscellaneous
    resolveQName,
    isAbsoluteUri,
    mkAbsoluteUrl,
    escapeRDFSyntax,
    unescapeUnicode,
    fileSchemeToFilePath,
    filePathToUri,
    iriFragment,
    uchar,

    -- * RDF data family
    RDF,

    -- * Rdf type class
    Rdf (baseUrl, prefixMappings, addPrefixMappings, empty, mkRdf, addTriple, removeTriple, triplesOf, uniqTriplesOf, select, query, showGraph),

    -- * Parsing RDF
    RdfParser (parseString, parseFile, parseURL),

    -- * Serializing RDF
    RdfSerializer (hWriteRdf, writeRdf, hWriteH, writeH, hWriteTs, hWriteT, writeT, writeTs, hWriteN, writeN),

    -- * Namespaces and Prefixes
    Namespace (PrefixedNS, PlainNS),
    PrefixMappings (PrefixMappings),
    PrefixMapping (PrefixMapping),

    -- * Supporting types
    BaseUrl (..),
    NodeSelector,
    ParseFailure (ParseFailure),
  )
where

#if MIN_VERSION_base(4,9,0)
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup
#else
#endif
#else
#endif

import Control.Applicative
import qualified Control.Applicative as A
import Control.DeepSeq (NFData, rnf)
import Control.Monad (guard, (<=<))
import Data.Binary
import Data.Char (chr, ord)
import Data.Either (isRight)
import Data.Hashable (Hashable)
import qualified Data.List as List
import Data.Map (Map)
import qualified Data.Map as Map
import Data.RDF.BlankNode
import Data.RDF.IRI
import Data.String (IsString (..))
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Generics (Generic)
import Network.URI
import qualified Network.URI as Network (parseURI, uriPath)
import qualified System.FilePath as FP
import System.IO
import Text.Parsec (ParseError, parse)
import Text.Parser.Char
import Text.Parser.Combinators
import Text.Printf
import Prelude hiding (pred)

-------------------
-- LValue and constructor functions

-- | The actual value of an RDF literal, represented as the 'LValue'
--  parameter of an 'LNode'.
data LValue
  = -- Constructors are not exported, because we need to have more
    -- control over the format of the literal text that we store.

    -- | A plain (untyped) literal value in an unspecified language.
    PlainL !Text
  | -- | A plain (untyped) literal value with a language specifier.
    PlainLL !Text !Text
  | -- | A typed literal value consisting of the literal value and
    --  the URI of the datatype of the value, respectively.
    TypedL !Text !Text
  deriving ((forall x. LValue -> Rep LValue x)
-> (forall x. Rep LValue x -> LValue) -> Generic LValue
forall x. Rep LValue x -> LValue
forall x. LValue -> Rep LValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LValue x -> LValue
$cfrom :: forall x. LValue -> Rep LValue x
Generic, Int -> LValue -> ShowS
[LValue] -> ShowS
LValue -> String
(Int -> LValue -> ShowS)
-> (LValue -> String) -> ([LValue] -> ShowS) -> Show LValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LValue] -> ShowS
$cshowList :: [LValue] -> ShowS
show :: LValue -> String
$cshow :: LValue -> String
showsPrec :: Int -> LValue -> ShowS
$cshowsPrec :: Int -> LValue -> ShowS
Show)

instance Binary LValue

instance NFData LValue where
  rnf :: LValue -> ()
rnf (PlainL Text
t) = Text -> ()
forall a. NFData a => a -> ()
rnf Text
t
  rnf (PlainLL Text
t1 Text
t2) = Text -> ()
forall a. NFData a => a -> ()
rnf Text
t1 () -> () -> ()
`seq` Text -> ()
forall a. NFData a => a -> ()
rnf Text
t2
  rnf (TypedL Text
t1 Text
t2) = Text -> ()
forall a. NFData a => a -> ()
rnf Text
t1 () -> () -> ()
`seq` Text -> ()
forall a. NFData a => a -> ()
rnf Text
t2

-- | Return a PlainL LValue for the given string value.
{-# INLINE plainL #-}
plainL :: Text -> LValue
plainL :: Text -> LValue
plainL = Text -> LValue
PlainL

-- | Return a PlainLL LValue for the given string value and language,
--  respectively.
{-# INLINE plainLL #-}
plainLL :: Text -> Text -> LValue
plainLL :: Text -> Text -> LValue
plainLL = Text -> Text -> LValue
PlainLL

-- | Return a TypedL LValue for the given string value and datatype URI,
--  respectively.
{-# INLINE typedL #-}
typedL :: Text -> Text -> LValue
typedL :: Text -> Text -> LValue
typedL Text
val Text
dtype = Text -> Text -> LValue
TypedL (Text -> Text -> Text
canonicalize Text
dtype Text
val) Text
dtype

-------------------
-- Node and constructor functions

-- | An RDF node, which may be either a URIRef node ('UNode'), a blank
--  node ('BNode'), or a literal node ('LNode').
data Node
  = -- | An RDF URI reference. URIs conform to the RFC3986 standard. See
    --  <http://www.w3.org/TR/rdf-concepts/#section-Graph-URIref> for more
    --  information.
    UNode !Text
  | -- | An RDF blank node. See
    --  <http://www.w3.org/TR/rdf-concepts/#section-blank-nodes> for more
    --  information.
    BNode !Text
  | -- | An RDF blank node with an auto-generated identifier, as used in
    --  Turtle.
    BNodeGen !Int
  | -- | An RDF literal. See
    --  <http://www.w3.org/TR/rdf-concepts/#section-Graph-Literal> for more
    --  information.
    LNode !LValue
  deriving ((forall x. Node -> Rep Node x)
-> (forall x. Rep Node x -> Node) -> Generic Node
forall x. Rep Node x -> Node
forall x. Node -> Rep Node x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Node x -> Node
$cfrom :: forall x. Node -> Rep Node x
Generic, Int -> Node -> ShowS
[Node] -> ShowS
Node -> String
(Int -> Node -> ShowS)
-> (Node -> String) -> ([Node] -> ShowS) -> Show Node
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Node] -> ShowS
$cshowList :: [Node] -> ShowS
show :: Node -> String
$cshow :: Node -> String
showsPrec :: Int -> Node -> ShowS
$cshowsPrec :: Int -> Node -> ShowS
Show)

instance Binary Node

instance NFData Node where
  rnf :: Node -> ()
rnf (UNode Text
t) = Text -> ()
forall a. NFData a => a -> ()
rnf Text
t
  rnf (BNode Text
b) = Text -> ()
forall a. NFData a => a -> ()
rnf Text
b
  rnf (BNodeGen Int
bgen) = Int -> ()
forall a. NFData a => a -> ()
rnf Int
bgen
  rnf (LNode LValue
lvalue) = LValue -> ()
forall a. NFData a => a -> ()
rnf LValue
lvalue

-- | An alias for 'Node', defined for convenience and readability purposes.
type Subject = Node

-- | An alias for 'Node', defined for convenience and readability purposes.
type Predicate = Node

-- | An alias for 'Node', defined for convenience and readability purposes.
type Object = Node

-- | Return a URIRef node for the given URI.
{-# INLINE unode #-}
unode :: Text -> Node
unode :: Text -> Node
unode = Text -> Node
UNode

-- For background on 'unodeValidate', see:
-- http://stackoverflow.com/questions/33250184/unescaping-unicode-literals-found-in-haskell-strings
--
-- Escaped literals are defined in the Turtle spec, and is
-- inherited by the NTriples and XML specification.
-- http://www.w3.org/TR/turtle/#sec-escapes

-- | Validate a URI and return it in a @Just UNode@ if it is
--   valid, otherwise @Nothing@ is returned. Performs the following:
--
--   1. unescape unicode RDF literals
--   2. checks validity of this unescaped URI using 'isURI' from 'Network.URI'
--   3. if the unescaped URI is valid then 'Node' constructed with 'UNode'
unodeValidate :: Text -> Maybe Node
unodeValidate :: Text -> Maybe Node
unodeValidate Text
t = Text -> Node
UNode (Text -> Node) -> Maybe Text -> Maybe Node
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
uriValidate Text
t

-- | Validate a Text URI and return it in a @Just Text@ if it is
--   valid, otherwise @Nothing@ is returned. See 'unodeValidate'.
uriValidate :: Text -> Maybe Text
uriValidate :: Text -> Maybe Text
uriValidate = (ParseError -> Maybe Text)
-> (Text -> Maybe Text) -> Either ParseError Text -> Maybe Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Text -> ParseError -> Maybe Text
forall a b. a -> b -> a
const Maybe Text
forall a. Maybe a
Nothing) Text -> Maybe Text
forall a. a -> Maybe a
Just (Either ParseError Text -> Maybe Text)
-> (Text -> Either ParseError Text) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ParseError Text
isRdfURI

-- | Same as 'uriValidate', but on 'String' rather than 'Text'
uriValidateString :: String -> Maybe String
uriValidateString :: String -> Maybe String
uriValidateString = (Text -> String) -> Maybe Text -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
T.unpack (Maybe Text -> Maybe String)
-> (String -> Maybe Text) -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
uriValidate (Text -> Maybe Text) -> (String -> Text) -> String -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString

isRdfURI :: Text -> Either ParseError Text
isRdfURI :: Text -> Either ParseError Text
isRdfURI Text
t = Parsec Text () Text -> String -> Text -> Either ParseError Text
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (Parsec Text () Text
forall (m :: * -> *). (CharParsing m, Monad m) => m Text
iriFragment Parsec Text () Text
-> ParsecT Text () Identity () -> Parsec Text () Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text () Identity ()
forall (m :: * -> *). Parsing m => m ()
eof) (String
"Invalid URI: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
t) Text
t

-- IRIREF from NTriples spec (without <> enclosing)
-- [8] IRIREF ::= '<' ([^#x00-#x20<>"{}|^`\] | UCHAR)* '>'
iriFragment :: (CharParsing m, Monad m) => m Text
iriFragment :: m Text
iriFragment = String -> Text
T.pack (String -> Text) -> m String -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Char -> m String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many m Char
validUriChar
  where
    validUriChar :: m Char
validUriChar = m Char -> m Char
forall (m :: * -> *) a. Parsing m => m a -> m a
try ((Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
satisfy Char -> Bool
isValidUriChar) m Char -> m Char -> m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Char
validUnicodeEscaped
    validUnicodeEscaped :: m Char
validUnicodeEscaped = do
      Char
c <- m Char
forall (m :: * -> *). (CharParsing m, Monad m) => m Char
uchar
      Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Char -> Bool
isValidUriChar Char
c)
      Char -> m Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
    isValidUriChar :: Char -> Bool
isValidUriChar Char
c =
      Bool -> Bool
not (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x00' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x20')
        Bool -> Bool -> Bool
&& Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (String
"<>\"{}|^`\\" :: String)

-- UCHAR from NTriples spec
-- [10] UCHAR ::= '\u' HEX HEX HEX HEX | '\U' HEX HEX HEX HEX HEX HEX HEX HEX
uchar :: (CharParsing m, Monad m) => m Char
uchar :: m Char
uchar = m Char -> m Char
forall (m :: * -> *) a. Parsing m => m a -> m a
try m Char
shortUnicode m Char -> m Char -> m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Char -> m Char
forall (m :: * -> *) a. Parsing m => m a -> m a
try m Char
longUnicode
  where
    shortUnicode :: m Char
shortUnicode = String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
string String
"\\u" m String -> m Char -> m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> m Char
forall (m :: * -> *). (CharParsing m, Monad m) => Int -> m Char
unescapeUnicodeParser Int
4
    longUnicode :: m Char
longUnicode = String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
string String
"\\U" m String -> m Char -> m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> m Char
forall (m :: * -> *). (CharParsing m, Monad m) => Int -> m Char
unescapeUnicodeParser Int
8

unescapeUnicodeParser :: (CharParsing m, Monad m) => Int -> m Char
unescapeUnicodeParser :: Int -> m Char
unescapeUnicodeParser Int
n = do
  Int
c <- Int -> Int -> m Int
forall t (f :: * -> *).
(Eq t, Num t, Monad f, CharParsing f) =>
t -> Int -> f Int
go Int
n Int
0
  Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x10FFFF)
  Char -> m Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> m Char) -> Char -> m Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
c
  where
    {-# INLINE go #-}
    go :: t -> Int -> f Int
go t
0 Int
t = Int -> f Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
t
    go t
k Int
t = do
      Int
h <- f Char
forall (m :: * -> *). CharParsing m => m Char
anyChar f Char -> (Char -> f Int) -> f Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> f Int
forall (f :: * -> *). Alternative f => Char -> f Int
getHex
      let t' :: Int
t' = Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
h
      Int -> Int -> Int
seq Int
t' (Int -> Int) -> f Int -> f Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> Int -> f Int
go (t
k t -> t -> t
forall a. Num a => a -> a -> a
- t
1) Int
t'
    {-# INLINE getHex #-}
    getHex :: Char -> f Int
getHex Char
c
      | Char
'0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9' = Int -> f Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0')
      | Char
'A' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'F' = Int -> f Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'A' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10)
      | Char
'a' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'f' = Int -> f Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10)
      | Bool
otherwise = f Int
forall (f :: * -> *) a. Alternative f => f a
A.empty

-- | Unescapes @\Uxxxxxxxx@ and @\uxxxx@ character sequences according
--   to the RDF specification.
unescapeUnicode, escapeRDFSyntax :: Text -> Either ParseError Text
unescapeUnicode :: Text -> Either ParseError Text
unescapeUnicode Text
t = String -> Text
T.pack (String -> Text)
-> Either ParseError String -> Either ParseError Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec Text () String -> String -> Text -> Either ParseError String
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (ParsecT Text () Identity Char -> Parsec Text () String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT Text () Identity Char
unicodeEsc) String
"" Text
t
  where
    unicodeEsc :: ParsecT Text () Identity Char
unicodeEsc = ParsecT Text () Identity Char
forall (m :: * -> *). (CharParsing m, Monad m) => m Char
uchar ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Text () Identity Char
forall (m :: * -> *). CharParsing m => m Char
anyChar
{-# DEPRECATED escapeRDFSyntax "Use unescapeUnicode instead" #-}
escapeRDFSyntax :: Text -> Either ParseError Text
escapeRDFSyntax = Text -> Either ParseError Text
unescapeUnicode

-- | Creates a blank node 'BNode' with a given label. Checks that
-- label is a syntactically valid label for a blank node i.e. a
-- BLANK_NODE_LABEL in
-- https://www.w3.org/TR/n-triples/#n-triples-grammar . Returns
-- 'Nothing' for invalid blank node labels. Blank node labels are
-- written as "_:abc" for a blank node with label "abc" see
-- https://www.w3.org/TR/sparql11-query/#QSynBlankNodes .
--
-- >>> bnode "_:abc"
-- Just (BNode "abc")
--
-- >>> bnode "abc"
-- Nothing
--
-- This does not check that the blank node label is unique for a
-- graph, since the function is not associated with a graph.
{-# INLINE bnode #-}
bnode :: Text -> Maybe Node
bnode :: Text -> Maybe Node
bnode Text
t =
  case Text -> Maybe String
mkBNode Text
t of
    Maybe String
Nothing -> Maybe Node
forall a. Maybe a
Nothing
    Just String
bString -> Node -> Maybe Node
forall a. a -> Maybe a
Just (Text -> Node
BNode (String -> Text
T.pack String
bString))

-- | Return a blank node using the given label. Does not check that
-- label is a syntactically valid label for a blank node i.e. a
-- BLANK_NODE_LABEL in
-- https://www.w3.org/TR/n-triples/#n-triples-grammar .
{-# INLINE bnodeUnsafe #-}
bnodeUnsafe :: Text -> Node
bnodeUnsafe :: Text -> Node
bnodeUnsafe = Text -> Node
BNode

-- | Return a literal node using the given LValue.
{-# INLINE lnode #-}
lnode :: LValue -> Node
lnode :: LValue -> Node
lnode = LValue -> Node
LNode

-------------------
-- Triple and constructor functions

-- | An RDF triple is a statement consisting of a subject, predicate,
--  and object, respectively.
--
--  See <http://www.w3.org/TR/rdf-concepts/#section-triples> for
--  more information.
data Triple = Triple !Node !Node !Node
  deriving ((forall x. Triple -> Rep Triple x)
-> (forall x. Rep Triple x -> Triple) -> Generic Triple
forall x. Rep Triple x -> Triple
forall x. Triple -> Rep Triple x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Triple x -> Triple
$cfrom :: forall x. Triple -> Rep Triple x
Generic, Int -> Triple -> ShowS
[Triple] -> ShowS
Triple -> String
(Int -> Triple -> ShowS)
-> (Triple -> String) -> ([Triple] -> ShowS) -> Show Triple
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Triple] -> ShowS
$cshowList :: [Triple] -> ShowS
show :: Triple -> String
$cshow :: Triple -> String
showsPrec :: Int -> Triple -> ShowS
$cshowsPrec :: Int -> Triple -> ShowS
Show)

instance Binary Triple

instance NFData Triple where
  rnf :: Triple -> ()
rnf (Triple Node
s Node
p Node
o) = Node -> ()
forall a. NFData a => a -> ()
rnf Node
s () -> () -> ()
`seq` Node -> ()
forall a. NFData a => a -> ()
rnf Node
p () -> () -> ()
`seq` Node -> ()
forall a. NFData a => a -> ()
rnf Node
o

-- | A list of triples. This is defined for convenience and readability.
type Triples = [Triple]

-- | A smart constructor function for 'Triple' that verifies the node arguments
--  are of the correct type and creates the new 'Triple' if so or calls 'error'.
--  /subj/ must be a 'UNode' or 'BNode', and /pred/ must be a 'UNode'.
triple :: Subject -> Predicate -> Object -> Triple
triple :: Node -> Node -> Node -> Triple
triple Node
s Node
p Node
o
  | Node -> Bool
isLNode Node
s = String -> Triple
forall a. HasCallStack => String -> a
error (String -> Triple) -> String -> Triple
forall a b. (a -> b) -> a -> b
$ String
"subject must be UNode or BNode: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Node -> String
forall a. Show a => a -> String
show Node
s
  | Node -> Bool
isLNode Node
p = String -> Triple
forall a. HasCallStack => String -> a
error (String -> Triple) -> String -> Triple
forall a b. (a -> b) -> a -> b
$ String
"predicate must be UNode, not LNode: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Node -> String
forall a. Show a => a -> String
show Node
p
  | Node -> Bool
isBNode Node
p = String -> Triple
forall a. HasCallStack => String -> a
error (String -> Triple) -> String -> Triple
forall a b. (a -> b) -> a -> b
$ String
"predicate must be UNode, not BNode: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Node -> String
forall a. Show a => a -> String
show Node
p
  | Bool
otherwise = Node -> Node -> Node -> Triple
Triple Node
s Node
p Node
o

-- | Answer if given node is a URI Ref node.
{-# INLINE isUNode #-}
isUNode :: Node -> Bool
isUNode :: Node -> Bool
isUNode (UNode Text
_) = Bool
True
isUNode Node
_ = Bool
False

-- | Answer if given node is a blank node.
{-# INLINE isBNode #-}
isBNode :: Node -> Bool
isBNode :: Node -> Bool
isBNode (BNode Text
_) = Bool
True
isBNode (BNodeGen Int
_) = Bool
True
isBNode Node
_ = Bool
False

-- | Answer if given node is a literal node.
{-# INLINE isLNode #-}
isLNode :: Node -> Bool
isLNode :: Node -> Bool
isLNode (LNode LValue
_) = Bool
True
isLNode Node
_ = Bool
False

{-# INLINE isAbsoluteUri #-}

-- | returns @True@ if URI is absolute.
isAbsoluteUri :: Text -> Bool
isAbsoluteUri :: Text -> Bool
isAbsoluteUri = Either String IRIRef -> Bool
forall a b. Either a b -> Bool
isRight (Either String IRIRef -> Bool)
-> (Text -> Either String IRIRef) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String IRIRef
parseIRI

-- | A type class for ADTs that expose views to clients.
class View a b where
  view :: a -> b

-- | RDF data family
data family RDF a

-- | An RDF value is a set of (unique) RDF triples, together with the
--  operations defined upon them.
--
--  For information about the efficiency of the functions, see the
--  documentation for the particular RDF instance.
--
--  For more information about the concept of an RDF graph, see
--  the following: <http://www.w3.org/TR/rdf-concepts/#section-rdf-graph>.
class (Generic rdfImpl, NFData rdfImpl) => Rdf rdfImpl where
  -- | Return the base URL of this RDF, if any.
  baseUrl :: RDF rdfImpl -> Maybe BaseUrl

  -- | Return the prefix mappings defined for this RDF, if any.
  prefixMappings :: RDF rdfImpl -> PrefixMappings

  -- | Return an RDF with the specified prefix mappings merged with
  --  the existing mappings. If the Bool arg is True, then a new mapping
  --  for an existing prefix will replace the old mapping; otherwise,
  --  the new mapping is ignored.
  addPrefixMappings :: RDF rdfImpl -> PrefixMappings -> Bool -> RDF rdfImpl

  -- | Return an empty RDF.
  empty :: RDF rdfImpl

  -- | Return a RDF containing all the given triples. Handling of duplicates
  --  in the input depend on the particular RDF implementation.
  mkRdf :: Triples -> Maybe BaseUrl -> PrefixMappings -> RDF rdfImpl

  -- | Adds a triple to an RDF graph.
  addTriple :: RDF rdfImpl -> Triple -> RDF rdfImpl

  -- | Removes all occurrences of a triple in an RDF graph.
  removeTriple :: RDF rdfImpl -> Triple -> RDF rdfImpl

  -- | Return all triples in the RDF, as a list.
  --
  --  Note that this function returns a list of triples in the RDF as they
  --  were added, without removing duplicates and without expanding namespaces.
  triplesOf :: RDF rdfImpl -> Triples

  -- | Return unique triples in the RDF, as a list.
  --
  --  This function performs namespace expansion and removal of duplicates.
  uniqTriplesOf :: RDF rdfImpl -> Triples

  -- | Select the triples in the RDF that match the given selectors.
  --
  --  The three NodeSelector parameters are optional functions that match
  --  the respective subject, predicate, and object of a triple. The triples
  --  returned are those in the given graph for which the first selector
  --  returns true when called on the subject, the second selector returns
  --  true when called on the predicate, and the third selector returns true
  --  when called on the ojbect. A 'Nothing' parameter is equivalent to a
  --  function that always returns true for the appropriate node; but
  --  implementations may be able to much more efficiently answer a select
  --  that involves a 'Nothing' parameter rather than an @(id True)@ parameter.
  --
  --  The following call illustrates the use of select, and would result in
  --  the selection of all and only the triples that have a blank node
  --  as subject and a literal node as object:
  --
  --  > select gr (Just isBNode) Nothing (Just isLNode)
  --
  --  Note: this function may be very slow; see the documentation for the
  --  particular RDF implementation for more information.
  select :: RDF rdfImpl -> NodeSelector -> NodeSelector -> NodeSelector -> Triples

  -- | Return the triples in the RDF that match the given pattern, where
  --  the pattern (3 Maybe Node parameters) is interpreted as a triple pattern.
  --
  --  The @Maybe Node@ params are interpreted as the subject, predicate, and
  --  object of a triple, respectively. @Just n@ is true iff the triple has
  --  a node equal to @n@ in the appropriate location; @Nothing@ is always
  --  true, regardless of the node in the appropriate location.
  --
  --  For example, @ query rdf (Just n1) Nothing (Just n2) @ would return all
  --  and only the triples that have @n1@ as subject and @n2@ as object,
  --  regardless of the predicate of the triple.
  query :: RDF rdfImpl -> Maybe Node -> Maybe Node -> Maybe Node -> Triples

  -- | pretty prints the RDF graph
  showGraph :: RDF rdfImpl -> String

instance (Rdf a) => Show (RDF a) where
  show :: RDF a -> String
show = RDF a -> String
forall a. Rdf a => RDF a -> String
showGraph

-- | An RdfParser is a parser that knows how to parse 1 format of RDF and
--  can parse an RDF document of that type from a string, a file, or a URL.
--  Required configuration options will vary from instance to instance.
class RdfParser p where
  -- | Parse RDF from the given text, yielding a failure with error message or
  --  the resultant RDF.
  parseString :: (Rdf a) => p -> Text -> Either ParseFailure (RDF a)

  -- | Parse RDF from the local file with the given path, yielding a failure with error
  --  message or the resultant RDF in the IO monad.
  parseFile :: (Rdf a) => p -> String -> IO (Either ParseFailure (RDF a))

  -- | Parse RDF from the remote file with the given HTTP URL (https is not supported),
  --  yielding a failure with error message or the resultant graph in the IO monad.
  parseURL :: (Rdf a) => p -> String -> IO (Either ParseFailure (RDF a))

-- | An RdfSerializer is a serializer of RDF to some particular output format, such as
--  NTriples or Turtle.
class RdfSerializer s where
  -- | Write the RDF to a file handle using whatever configuration is specified by
  --  the first argument.
  hWriteRdf :: (Rdf a) => s -> Handle -> RDF a -> IO ()

  -- | Write the RDF to stdout; equivalent to @'hWriteRdf' stdout@.
  writeRdf :: (Rdf a) => s -> RDF a -> IO ()

  -- | Write to the file handle whatever header information is required based on
  --  the output format. For example, if serializing to Turtle, this method would
  --  write the necessary \@prefix declarations and possibly a \@baseUrl declaration,
  --  whereas for NTriples, there is no header section at all, so this would be a no-op.
  hWriteH :: (Rdf a) => s -> Handle -> RDF a -> IO ()

  -- | Write header information to stdout; equivalent to @'hWriteRdf' stdout@.
  writeH :: (Rdf a) => s -> RDF a -> IO ()

  -- | Write some triples to a file handle using whatever configuration is specified
  --  by the first argument.
  --
  --  WARNING: if the serialization format has header-level information
  --  that should be output (e.g., \@prefix declarations for Turtle), then you should
  --  use 'hWriteG' instead of this method unless you're sure this is safe to use, since
  --  otherwise the resultant document will be missing the header information and
  --  will not be valid.
  hWriteTs :: s -> Handle -> Triples -> IO ()

  -- | Write some triples to stdout; equivalent to @'hWriteTs' stdout@.
  writeTs :: s -> Triples -> IO ()

  -- | Write a single triple to the file handle using whatever configuration is
  --  specified by the first argument. The same WARNING applies as to 'hWriteTs'.
  hWriteT :: s -> Handle -> Triple -> IO ()

  -- | Write a single triple to stdout; equivalent to @'hWriteT' stdout@.
  writeT :: s -> Triple -> IO ()

  -- | Write a single node to the file handle using whatever configuration is
  --  specified by the first argument. The same WARNING applies as to 'hWriteTs'.
  hWriteN :: s -> Handle -> Node -> IO ()

  -- | Write a single node to sdout; equivalent to @'hWriteN' stdout@.
  writeN :: s -> Node -> IO ()

-- | The base URL of an RDF.
newtype BaseUrl = BaseUrl {BaseUrl -> Text
unBaseUrl :: Text}
  deriving (BaseUrl -> BaseUrl -> Bool
(BaseUrl -> BaseUrl -> Bool)
-> (BaseUrl -> BaseUrl -> Bool) -> Eq BaseUrl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BaseUrl -> BaseUrl -> Bool
$c/= :: BaseUrl -> BaseUrl -> Bool
== :: BaseUrl -> BaseUrl -> Bool
$c== :: BaseUrl -> BaseUrl -> Bool
Eq, Eq BaseUrl
Eq BaseUrl
-> (BaseUrl -> BaseUrl -> Ordering)
-> (BaseUrl -> BaseUrl -> Bool)
-> (BaseUrl -> BaseUrl -> Bool)
-> (BaseUrl -> BaseUrl -> Bool)
-> (BaseUrl -> BaseUrl -> Bool)
-> (BaseUrl -> BaseUrl -> BaseUrl)
-> (BaseUrl -> BaseUrl -> BaseUrl)
-> Ord BaseUrl
BaseUrl -> BaseUrl -> Bool
BaseUrl -> BaseUrl -> Ordering
BaseUrl -> BaseUrl -> BaseUrl
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BaseUrl -> BaseUrl -> BaseUrl
$cmin :: BaseUrl -> BaseUrl -> BaseUrl
max :: BaseUrl -> BaseUrl -> BaseUrl
$cmax :: BaseUrl -> BaseUrl -> BaseUrl
>= :: BaseUrl -> BaseUrl -> Bool
$c>= :: BaseUrl -> BaseUrl -> Bool
> :: BaseUrl -> BaseUrl -> Bool
$c> :: BaseUrl -> BaseUrl -> Bool
<= :: BaseUrl -> BaseUrl -> Bool
$c<= :: BaseUrl -> BaseUrl -> Bool
< :: BaseUrl -> BaseUrl -> Bool
$c< :: BaseUrl -> BaseUrl -> Bool
compare :: BaseUrl -> BaseUrl -> Ordering
$ccompare :: BaseUrl -> BaseUrl -> Ordering
$cp1Ord :: Eq BaseUrl
Ord, Int -> BaseUrl -> ShowS
[BaseUrl] -> ShowS
BaseUrl -> String
(Int -> BaseUrl -> ShowS)
-> (BaseUrl -> String) -> ([BaseUrl] -> ShowS) -> Show BaseUrl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BaseUrl] -> ShowS
$cshowList :: [BaseUrl] -> ShowS
show :: BaseUrl -> String
$cshow :: BaseUrl -> String
showsPrec :: Int -> BaseUrl -> ShowS
$cshowsPrec :: Int -> BaseUrl -> ShowS
Show, BaseUrl -> ()
(BaseUrl -> ()) -> NFData BaseUrl
forall a. (a -> ()) -> NFData a
rnf :: BaseUrl -> ()
$crnf :: BaseUrl -> ()
NFData, b -> BaseUrl -> BaseUrl
NonEmpty BaseUrl -> BaseUrl
BaseUrl -> BaseUrl -> BaseUrl
(BaseUrl -> BaseUrl -> BaseUrl)
-> (NonEmpty BaseUrl -> BaseUrl)
-> (forall b. Integral b => b -> BaseUrl -> BaseUrl)
-> Semigroup BaseUrl
forall b. Integral b => b -> BaseUrl -> BaseUrl
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> BaseUrl -> BaseUrl
$cstimes :: forall b. Integral b => b -> BaseUrl -> BaseUrl
sconcat :: NonEmpty BaseUrl -> BaseUrl
$csconcat :: NonEmpty BaseUrl -> BaseUrl
<> :: BaseUrl -> BaseUrl -> BaseUrl
$c<> :: BaseUrl -> BaseUrl -> BaseUrl
Semigroup, (forall x. BaseUrl -> Rep BaseUrl x)
-> (forall x. Rep BaseUrl x -> BaseUrl) -> Generic BaseUrl
forall x. Rep BaseUrl x -> BaseUrl
forall x. BaseUrl -> Rep BaseUrl x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BaseUrl x -> BaseUrl
$cfrom :: forall x. BaseUrl -> Rep BaseUrl x
Generic)

instance Binary BaseUrl

instance Monoid BaseUrl where
  mempty :: BaseUrl
mempty = Text -> BaseUrl
BaseUrl Text
T.empty

-- | A 'NodeSelector' is either a function that returns 'True'
--   or 'False' for a node, or Nothing, which indicates that all
--  nodes would return 'True'.
--
--  The selector is said to select, or match, the nodes for
--  which it returns 'True'.
--
--  When used in conjunction with the 'select' method of 'Graph', three
--  node selectors are used to match a triple.
type NodeSelector = Maybe (Node -> Bool)

-- | Represents a failure in parsing an N-Triples document, including
--  an error message with information about the cause for the failure.
newtype ParseFailure = ParseFailure String
  deriving (ParseFailure -> ParseFailure -> Bool
(ParseFailure -> ParseFailure -> Bool)
-> (ParseFailure -> ParseFailure -> Bool) -> Eq ParseFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseFailure -> ParseFailure -> Bool
$c/= :: ParseFailure -> ParseFailure -> Bool
== :: ParseFailure -> ParseFailure -> Bool
$c== :: ParseFailure -> ParseFailure -> Bool
Eq, Int -> ParseFailure -> ShowS
[ParseFailure] -> ShowS
ParseFailure -> String
(Int -> ParseFailure -> ShowS)
-> (ParseFailure -> String)
-> ([ParseFailure] -> ShowS)
-> Show ParseFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseFailure] -> ShowS
$cshowList :: [ParseFailure] -> ShowS
show :: ParseFailure -> String
$cshow :: ParseFailure -> String
showsPrec :: Int -> ParseFailure -> ShowS
$cshowsPrec :: Int -> ParseFailure -> ShowS
Show)

-- | A node is equal to another node if they are both the same type
--  of node and if the field values are equal.
instance Eq Node where
  (UNode Text
bs1) == :: Node -> Node -> Bool
== (UNode Text
bs2) = Text
bs1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
bs2
  (BNode Text
bs1) == (BNode Text
bs2) = Text
bs1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
bs2
  (BNodeGen Int
i1) == (BNodeGen Int
i2) = Int
i1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i2
  (LNode LValue
l1) == (LNode LValue
l2) = LValue
l1 LValue -> LValue -> Bool
forall a. Eq a => a -> a -> Bool
== LValue
l2
  Node
_ == Node
_ = Bool
False

-- | Node ordering is defined first by type, with Unode < BNode < BNodeGen
--  < LNode PlainL < LNode PlainLL < LNode TypedL, and secondly by
--  the natural ordering of the node value.
--
--  E.g., a '(UNode _)' is LT any other type of node, and a
--  '(LNode (TypedL _ _))' is GT any other type of node, and the ordering
--  of '(BNodeGen 44)' and '(BNodeGen 3)' is that of the values, or
--  'compare 44 3', GT.
instance Ord Node where
  compare :: Node -> Node -> Ordering
compare (UNode Text
bs1) (UNode Text
bs2) = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
bs1 Text
bs2
  compare (UNode Text
_) Node
_ = Ordering
LT
  compare Node
_ (UNode Text
_) = Ordering
GT
  compare (BNode Text
bs1) (BNode Text
bs2) = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
bs1 Text
bs2
  compare (BNode Text
_) Node
_ = Ordering
LT
  compare Node
_ (BNode Text
_) = Ordering
GT
  compare (BNodeGen Int
i1) (BNodeGen Int
i2) = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i1 Int
i2
  compare (BNodeGen Int
_) Node
_ = Ordering
LT
  compare Node
_ (BNodeGen Int
_) = Ordering
GT
  compare (LNode LValue
lv1) (LNode LValue
lv2) = LValue -> LValue -> Ordering
forall a. Ord a => a -> a -> Ordering
compare LValue
lv1 LValue
lv2

instance Hashable Node

-- | Two triples are equal iff their respective subjects, predicates, and objects
--  are equal.
instance Eq Triple where
  (Triple Node
s1 Node
p1 Node
o1) == :: Triple -> Triple -> Bool
== (Triple Node
s2 Node
p2 Node
o2) = Node
s1 Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
s2 Bool -> Bool -> Bool
&& Node
p1 Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
p2 Bool -> Bool -> Bool
&& Node
o1 Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
o2

-- | The ordering of triples is based on that of the subject, predicate, and object
--  of the triple, in that order.
instance Ord Triple where
  {-# INLINE compare #-}
  (Triple Node
s1 Node
p1 Node
o1) compare :: Triple -> Triple -> Ordering
`compare` (Triple Node
s2 Node
p2 Node
o2) =
    Node -> Node -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Node
s1 Node
s2 Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` Node -> Node -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Node
p1 Node
p2 Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` Node -> Node -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Node
o1 Node
o2

-- | Two 'LValue' values are equal iff they are of the same type and all fields are equal.
instance Eq LValue where
  (PlainL Text
v1) == :: LValue -> LValue -> Bool
== (PlainL Text
v2) = Text
v1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
v2
  (PlainLL Text
v1 Text
lt1) == (PlainLL Text
v2 Text
lt2) = Text -> Text
T.toLower Text
lt1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Text
T.toLower Text
lt2 Bool -> Bool -> Bool
&& Text
v1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
v2
  (TypedL Text
v1 Text
dt1) == (TypedL Text
v2 Text
dt2) = Text
v1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
v2 Bool -> Bool -> Bool
&& Text
dt1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
dt2
  LValue
_ == LValue
_ = Bool
False

-- | Ordering of 'LValue' values is as follows: (PlainL _) < (PlainLL _ _)
--  < (TypedL _ _), and values of the same type are ordered by field values,
--  with '(PlainLL literalValue language)' being ordered by language first and
--  literal value second, and '(TypedL literalValue datatypeUri)' being ordered
--  by datatype first and literal value second.
instance Ord LValue where
  {-# INLINE compare #-}
  compare :: LValue -> LValue -> Ordering
compare (PlainL Text
v1) (PlainL Text
v2) = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
v1 Text
v2
  compare (PlainL Text
_) LValue
_ = Ordering
LT
  compare LValue
_ (PlainL Text
_) = Ordering
GT
  compare (PlainLL Text
v1 Text
lt1) (PlainLL Text
v2 Text
lt2) = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
lt1 Text
lt2 Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
v1 Text
v2
  compare (PlainLL Text
_ Text
_) LValue
_ = Ordering
LT
  compare LValue
_ (PlainLL Text
_ Text
_) = Ordering
GT
  compare (TypedL Text
v1 Text
dt1) (TypedL Text
v2 Text
dt2) = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
dt1 Text
dt2 Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
v1 Text
v2

instance Hashable LValue

------------------------
-- Prefix mappings

-- | Represents a namespace as either a prefix and uri, respectively,
--   or just a uri.
data Namespace
  = PrefixedNS Text Text -- prefix and ns uri
  | PlainNS Text -- ns uri alone

instance Eq Namespace where
  (PrefixedNS Text
_ Text
u1) == :: Namespace -> Namespace -> Bool
== (PrefixedNS Text
_ Text
u2) = Text
u1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
u2
  (PlainNS Text
u1) == (PlainNS Text
u2) = Text
u1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
u2
  (PrefixedNS Text
_ Text
u1) == (PlainNS Text
u2) = Text
u1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
u2
  (PlainNS Text
u1) == (PrefixedNS Text
_ Text
u2) = Text
u1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
u2

instance Show Namespace where
  show :: Namespace -> String
show (PlainNS Text
uri) = Text -> String
T.unpack Text
uri
  show (PrefixedNS Text
prefix Text
uri) = String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"(PrefixNS %s %s)" (Text -> String
T.unpack Text
prefix) (Text -> String
T.unpack Text
uri)

-- | An alias for a map from prefix to namespace URI.
newtype PrefixMappings = PrefixMappings (Map Text Text)
  deriving (PrefixMappings -> PrefixMappings -> Bool
(PrefixMappings -> PrefixMappings -> Bool)
-> (PrefixMappings -> PrefixMappings -> Bool) -> Eq PrefixMappings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrefixMappings -> PrefixMappings -> Bool
$c/= :: PrefixMappings -> PrefixMappings -> Bool
== :: PrefixMappings -> PrefixMappings -> Bool
$c== :: PrefixMappings -> PrefixMappings -> Bool
Eq, Eq PrefixMappings
Eq PrefixMappings
-> (PrefixMappings -> PrefixMappings -> Ordering)
-> (PrefixMappings -> PrefixMappings -> Bool)
-> (PrefixMappings -> PrefixMappings -> Bool)
-> (PrefixMappings -> PrefixMappings -> Bool)
-> (PrefixMappings -> PrefixMappings -> Bool)
-> (PrefixMappings -> PrefixMappings -> PrefixMappings)
-> (PrefixMappings -> PrefixMappings -> PrefixMappings)
-> Ord PrefixMappings
PrefixMappings -> PrefixMappings -> Bool
PrefixMappings -> PrefixMappings -> Ordering
PrefixMappings -> PrefixMappings -> PrefixMappings
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PrefixMappings -> PrefixMappings -> PrefixMappings
$cmin :: PrefixMappings -> PrefixMappings -> PrefixMappings
max :: PrefixMappings -> PrefixMappings -> PrefixMappings
$cmax :: PrefixMappings -> PrefixMappings -> PrefixMappings
>= :: PrefixMappings -> PrefixMappings -> Bool
$c>= :: PrefixMappings -> PrefixMappings -> Bool
> :: PrefixMappings -> PrefixMappings -> Bool
$c> :: PrefixMappings -> PrefixMappings -> Bool
<= :: PrefixMappings -> PrefixMappings -> Bool
$c<= :: PrefixMappings -> PrefixMappings -> Bool
< :: PrefixMappings -> PrefixMappings -> Bool
$c< :: PrefixMappings -> PrefixMappings -> Bool
compare :: PrefixMappings -> PrefixMappings -> Ordering
$ccompare :: PrefixMappings -> PrefixMappings -> Ordering
$cp1Ord :: Eq PrefixMappings
Ord, PrefixMappings -> ()
(PrefixMappings -> ()) -> NFData PrefixMappings
forall a. (a -> ()) -> NFData a
rnf :: PrefixMappings -> ()
$crnf :: PrefixMappings -> ()
NFData, b -> PrefixMappings -> PrefixMappings
NonEmpty PrefixMappings -> PrefixMappings
PrefixMappings -> PrefixMappings -> PrefixMappings
(PrefixMappings -> PrefixMappings -> PrefixMappings)
-> (NonEmpty PrefixMappings -> PrefixMappings)
-> (forall b. Integral b => b -> PrefixMappings -> PrefixMappings)
-> Semigroup PrefixMappings
forall b. Integral b => b -> PrefixMappings -> PrefixMappings
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> PrefixMappings -> PrefixMappings
$cstimes :: forall b. Integral b => b -> PrefixMappings -> PrefixMappings
sconcat :: NonEmpty PrefixMappings -> PrefixMappings
$csconcat :: NonEmpty PrefixMappings -> PrefixMappings
<> :: PrefixMappings -> PrefixMappings -> PrefixMappings
$c<> :: PrefixMappings -> PrefixMappings -> PrefixMappings
Semigroup, Semigroup PrefixMappings
PrefixMappings
Semigroup PrefixMappings
-> PrefixMappings
-> (PrefixMappings -> PrefixMappings -> PrefixMappings)
-> ([PrefixMappings] -> PrefixMappings)
-> Monoid PrefixMappings
[PrefixMappings] -> PrefixMappings
PrefixMappings -> PrefixMappings -> PrefixMappings
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [PrefixMappings] -> PrefixMappings
$cmconcat :: [PrefixMappings] -> PrefixMappings
mappend :: PrefixMappings -> PrefixMappings -> PrefixMappings
$cmappend :: PrefixMappings -> PrefixMappings -> PrefixMappings
mempty :: PrefixMappings
$cmempty :: PrefixMappings
$cp1Monoid :: Semigroup PrefixMappings
Monoid, (forall x. PrefixMappings -> Rep PrefixMappings x)
-> (forall x. Rep PrefixMappings x -> PrefixMappings)
-> Generic PrefixMappings
forall x. Rep PrefixMappings x -> PrefixMappings
forall x. PrefixMappings -> Rep PrefixMappings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PrefixMappings x -> PrefixMappings
$cfrom :: forall x. PrefixMappings -> Rep PrefixMappings x
Generic)

instance Binary PrefixMappings

instance Show PrefixMappings where
  -- This is really inefficient, but it's not used much so not what
  -- worth optimizing yet.
  show :: PrefixMappings -> String
show (PrefixMappings Map Text Text
pmap) = String -> ShowS
forall r. PrintfType r => String -> r
printf String
"PrefixMappings [%s]" String
mappingsStr
    where
      showPM :: (Text, Text) -> String
showPM = PrefixMapping -> String
forall a. Show a => a -> String
show (PrefixMapping -> String)
-> ((Text, Text) -> PrefixMapping) -> (Text, Text) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> PrefixMapping
PrefixMapping
      mappingsStr :: String
mappingsStr = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
", " (((Text, Text) -> String) -> [(Text, Text)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, Text) -> String
showPM (Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
pmap))

-- | A mapping of a prefix to the URI for that prefix.
newtype PrefixMapping = PrefixMapping (Text, Text)
  deriving (PrefixMapping -> PrefixMapping -> Bool
(PrefixMapping -> PrefixMapping -> Bool)
-> (PrefixMapping -> PrefixMapping -> Bool) -> Eq PrefixMapping
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrefixMapping -> PrefixMapping -> Bool
$c/= :: PrefixMapping -> PrefixMapping -> Bool
== :: PrefixMapping -> PrefixMapping -> Bool
$c== :: PrefixMapping -> PrefixMapping -> Bool
Eq, Eq PrefixMapping
Eq PrefixMapping
-> (PrefixMapping -> PrefixMapping -> Ordering)
-> (PrefixMapping -> PrefixMapping -> Bool)
-> (PrefixMapping -> PrefixMapping -> Bool)
-> (PrefixMapping -> PrefixMapping -> Bool)
-> (PrefixMapping -> PrefixMapping -> Bool)
-> (PrefixMapping -> PrefixMapping -> PrefixMapping)
-> (PrefixMapping -> PrefixMapping -> PrefixMapping)
-> Ord PrefixMapping
PrefixMapping -> PrefixMapping -> Bool
PrefixMapping -> PrefixMapping -> Ordering
PrefixMapping -> PrefixMapping -> PrefixMapping
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PrefixMapping -> PrefixMapping -> PrefixMapping
$cmin :: PrefixMapping -> PrefixMapping -> PrefixMapping
max :: PrefixMapping -> PrefixMapping -> PrefixMapping
$cmax :: PrefixMapping -> PrefixMapping -> PrefixMapping
>= :: PrefixMapping -> PrefixMapping -> Bool
$c>= :: PrefixMapping -> PrefixMapping -> Bool
> :: PrefixMapping -> PrefixMapping -> Bool
$c> :: PrefixMapping -> PrefixMapping -> Bool
<= :: PrefixMapping -> PrefixMapping -> Bool
$c<= :: PrefixMapping -> PrefixMapping -> Bool
< :: PrefixMapping -> PrefixMapping -> Bool
$c< :: PrefixMapping -> PrefixMapping -> Bool
compare :: PrefixMapping -> PrefixMapping -> Ordering
$ccompare :: PrefixMapping -> PrefixMapping -> Ordering
$cp1Ord :: Eq PrefixMapping
Ord)

instance Show PrefixMapping where
  show :: PrefixMapping -> String
show (PrefixMapping (Text
prefix, Text
uri)) = String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"PrefixMapping (%s, %s)" (Text -> String
forall a. Show a => a -> String
show Text
prefix) (Text -> String
forall a. Show a => a -> String
show Text
uri)

-----------------
-- Miscellaneous helper functions used throughout the project

-- | Resolve a prefix using the given prefix mappings.
resolveQName :: Text -> PrefixMappings -> Maybe Text
resolveQName :: Text -> PrefixMappings -> Maybe Text
resolveQName Text
prefix (PrefixMappings Map Text Text
pms) = Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
prefix Map Text Text
pms

{-# INLINE mkAbsoluteUrl #-}
{-# DEPRECATED mkAbsoluteUrl "Use resolveIRI instead, because mkAbsoluteUrl is a partial function" #-}

-- | Make an absolute URL by returning as is if already an absolute URL and otherwise
--   appending the URL to the given base URL.
mkAbsoluteUrl :: Text -> Text -> Text
mkAbsoluteUrl :: Text -> Text -> Text
mkAbsoluteUrl Text
base Text
iri = (String -> Text) -> (Text -> Text) -> Either String Text -> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Text
forall a. HasCallStack => String -> a
error Text -> Text
forall a. a -> a
id (Text -> Text -> Either String Text
resolveIRI Text
base Text
iri)

-----------------
-- Internal canonicalize functions, don't export

-- | Canonicalize the given 'Text' value using the 'Text'
--  as the datatype URI.
{-# NOINLINE canonicalize #-}
canonicalize :: Text -> Text -> Text
canonicalize :: Text -> Text -> Text
canonicalize Text
typeTxt Text
litValue =
  Text -> ((Text -> Text) -> Text) -> Maybe (Text -> Text) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
litValue ((Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
litValue) (Text -> Map Text (Text -> Text) -> Maybe (Text -> Text)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
typeTxt Map Text (Text -> Text)
canonicalizerTable)

-- A table of mappings from a 'Text' URI
-- to a function that canonicalizes a Text
-- assumed to be of that type.
{-# NOINLINE canonicalizerTable #-}
canonicalizerTable :: Map Text (Text -> Text)
canonicalizerTable :: Map Text (Text -> Text)
canonicalizerTable =
  [(Text
integerUri, Text -> Text
_integerStr), (Text
doubleUri, Text -> Text
_doubleStr), (Text
decimalUri, Text -> Text
_decimalStr)]
  where
    integerUri :: Text
integerUri = Text
"http://www.w3.org/2001/XMLSchema#integer"
    decimalUri :: Text
decimalUri = Text
"http://www.w3.org/2001/XMLSchema#decimal"
    doubleUri :: Text
doubleUri = Text
"http://www.w3.org/2001/XMLSchema#double"

_integerStr, _decimalStr, _doubleStr :: Text -> Text
_integerStr :: Text -> Text
_integerStr Text
t
  | Text -> Int
T.length Text
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Text
t
  | Text -> Char
T.head Text
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0' = Text -> Text
_integerStr (Text -> Text
T.tail Text
t)
  | Bool
otherwise = Text
t
-- exponent: [eE] ('-' | '+')? [0-9]+
-- ('-' | '+') ? ( [0-9]+ '.' [0-9]* exponent | '.' ([0-9])+ exponent | ([0-9])+ exponent )
_doubleStr :: Text -> Text
_doubleStr Text
s = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (String -> Double
forall a. Read a => String -> a
read (String -> Double) -> String -> Double
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s :: Double)
-- ('-' | '+')? ( [0-9]+ '.' [0-9]* | '.' ([0-9])+ | ([0-9])+ )
_decimalStr :: Text -> Text
_decimalStr Text
s =
  -- haskell double parser doesn't handle '1.'..,
  case Text -> Char
T.last Text
s of -- so we add a zero if that's the case and then parse
    Char
'.' -> Text -> Text
f (Text
s Text -> Char -> Text
`T.snoc` Char
'0')
    Char
_ -> Text -> Text
f Text
s
  where
    f :: Text -> Text
f Text
s' = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (String -> Double
forall a. Read a => String -> a
read (String -> Double) -> String -> Double
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s' :: Double)

-- | Removes "file://" schema from URIs in 'UNode' nodes
fileSchemeToFilePath :: (IsString s) => Node -> Maybe s
fileSchemeToFilePath :: Node -> Maybe s
fileSchemeToFilePath (UNode Text
fileScheme)
  | Text
"file://" Text -> Text -> Bool
`T.isPrefixOf` Text
fileScheme = Text -> Maybe s
textToFilePath Text
fileScheme
  | Bool
otherwise = Maybe s
forall a. Maybe a
Nothing
  where
    textToFilePath :: Text -> Maybe s
textToFilePath = s -> Maybe s
forall (f :: * -> *) a. Applicative f => a -> f a
pure (s -> Maybe s) -> (String -> s) -> String -> Maybe s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> s
forall a. IsString a => String -> a
fromString (String -> Maybe s) -> (Text -> Maybe String) -> Text -> Maybe s
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< String -> Maybe String
stringToFilePath (String -> Maybe String)
-> (Text -> String) -> Text -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
    stringToFilePath :: String -> Maybe String
stringToFilePath = String -> Maybe String
fixPrefix (String -> Maybe String)
-> (String -> Maybe String) -> String -> Maybe String
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< String -> Maybe String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Maybe String) -> (URI -> String) -> URI -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
unEscapeString ShowS -> (URI -> String) -> URI -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> String
Network.uriPath (URI -> Maybe String)
-> (String -> Maybe URI) -> String -> Maybe String
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< String -> Maybe URI
Network.parseURI
    fixPrefix :: String -> Maybe String
fixPrefix String
"" = Maybe String
forall a. Maybe a
Nothing
    fixPrefix p :: String
p@(Char
p' : String
p'')
      | Char
p' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
FP.pathSeparator = String -> Maybe String
forall a. a -> Maybe a
Just (ShowS
FP.normalise String
p) -- Posix path
      | Char
p' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' = String -> Maybe String
forall a. a -> Maybe a
Just (ShowS
FP.normalise String
p'') -- Windows classic Path
      | Bool
otherwise = String -> Maybe String
forall a. a -> Maybe a
Just (String
"\\\\" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
FP.normalise String
p) -- Windows UNC Path
fileSchemeToFilePath Node
_ = Maybe s
forall a. Maybe a
Nothing

-- | Converts a file path to a URI with "file:" scheme
filePathToUri :: (IsString s) => FilePath -> Maybe s
filePathToUri :: String -> Maybe s
filePathToUri String
p
  | String -> Bool
FP.isRelative String
p = Maybe s
forall a. Maybe a
Nothing
  | Bool
otherwise = s -> Maybe s
forall a. a -> Maybe a
Just (s -> Maybe s) -> (String -> s) -> String -> Maybe s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> s
forall a. IsString a => String -> a
fromString (String -> s) -> ShowS -> String -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
as_uri ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
FP.normalise (String -> Maybe s) -> String -> Maybe s
forall a b. (a -> b) -> a -> b
$ String
p
  where
    as_uri :: ShowS
as_uri = (String
"file://" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
escapeURIString Char -> Bool
isAllowedInURI ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
as_posix ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
fix_prefix
    fix_prefix :: ShowS
fix_prefix String
p' = case (ShowS
FP.takeDrive String
p') of
      String
"/" -> String
p'
      Char
'\\' : Char
'\\' : String
_ -> Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
2 String
p'
      String
_ -> Char
'/' Char -> ShowS
forall a. a -> [a] -> [a]
: String
p'
    as_posix :: ShowS
as_posix = (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
repl
    repl :: Char -> Char
repl Char
'\\' = Char
'/'
    repl Char
c = Char
c