{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}

--------------------------------------------------------------------------------
--  See end of this file for licence information.
--------------------------------------------------------------------------------
-- |
--  Module      :  Graph
--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin,
--                 2011, 2012, 2013, 2014, 2015, 2016, 2018, 2020. 2022 Douglas Burke
--  License     :  GPL V2
--
--  Maintainer  :  Douglas Burke
--  Stability   :  experimental
--  Portability :  CPP, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings
--
--  This module defines a memory-based RDF graph instance. At present only
--  RDF 1.0 is explicitly supported; I have not gone through the RDF 1.1
--  changes to see how the code needs to be updated. This means that you
--  can have untyped strings in your graph that do not match the same content
--  but with an explicit @xsd:string@ datatype.
--
--  Note that the identifiers for blank nodes may /not/ be propogated when
--  a graph is written out using one of the formatters, such as
--  'Swish.RDF.Formatter.Turtle'. There is limited support for
--  generating new blank nodes from an existing set of triples; e.g.
--  'newNode' and 'newNodes'.
--
--------------------------------------------------------------------------------

------------------------------------------------------------
-- Simple labelled directed graph value
------------------------------------------------------------

module Swish.RDF.Graph
    ( 
      -- * Labels
      RDFLabel(..), ToRDFLabel(..), FromRDFLabel(..)
    , isLiteral, isUntypedLiteral, isTypedLiteral, isXMLLiteral
    , isDatatyped, isMemberProp, isUri, isBlank, isQueryVar
    , getLiteralText, getScopedName, makeBlank
    , quote
    , quoteT
      
      -- * RDF Graphs
    , RDFArcSet
    , RDFTriple
    , toRDFTriple, fromRDFTriple
    , NSGraph(..)
    , RDFGraph
    , toRDFGraph, emptyRDFGraph {-, updateRDFGraph-}
    , NamespaceMap
    , emptyNamespaceMap
    , LookupFormula(..), Formula, FormulaMap, emptyFormulaMap
    , addArc, merge
    , allLabels, allNodes, remapLabels, remapLabelList
    , newNode, newNodes
    , setNamespaces, getNamespaces
    , setFormulae, getFormulae, setFormula, getFormula
    , fmapNSGraph
    , traverseNSGraph
      
    -- * Re-export from GraphClass
    --
    -- | Note that @asubj@, @apred@ and @aobj@ have been
    -- removed in version @0.7.0.0@; use 'arcSubj', 'arcPred'
    -- or 'arcObj' instead.
    --
    , LDGraph(..), Label (..), Arc(..)
    , arc, Selector
      
    -- * Selected RDFLabel values
    --                                
    -- | The 'ToRDFLabel' instance of 'ScopedName' can also be used                                     
    -- to easily construct 'RDFLabel' versions of the terms defined
    -- in "Swish.RDF.Vocabulary".
    
    -- ** RDF terms                                          
    --                                          
    -- | These terms are described in <http://www.w3.org/TR/rdf-syntax-grammar/>;                                          
    -- the version used is \"W3C Recommendation 10 February 2004\", <http://www.w3.org/TR/2004/REC-rdf-syntax-grammar-20040210/>.
    --                                          
    -- Some terms are listed within the RDF Schema terms below since their definition                                            
    -- is given within the RDF Schema document.                                          
    --                                          
    , resRdfRDF                                          
    , resRdfDescription      
    , resRdfID
    , resRdfAbout
    , resRdfParseType
    , resRdfResource
    , resRdfLi
    , resRdfNodeID
    , resRdfDatatype
    , resRdf1, resRdf2, resRdfn
    -- ** RDF Schema terms
    --                                 
    -- | These are defined by <http://www.w3.org/TR/rdf-schema/>; the version
    -- used is \"W3C Recommendation 10 February 2004\", <http://www.w3.org/TR/2004/REC-rdf-schema-20040210/>.
                        
    -- *** Classes
    --                                 
    -- | See the \"Classes\" section at <http://www.w3.org/TR/rdf-schema/#ch_classes> for more information.
    , resRdfsResource
    , resRdfsClass
    , resRdfsLiteral
    , resRdfsDatatype
    , resRdfXMLLiteral
    , resRdfProperty
    -- *** Properties
    --                                 
    -- | See the \"Properties\" section at <http://www.w3.org/TR/rdf-schema/#ch_classes> for more information.
    , resRdfsRange
    , resRdfsDomain
    , resRdfType
    , resRdfsSubClassOf
    , resRdfsSubPropertyOf
    , resRdfsLabel
    , resRdfsComment
    -- *** Containers
    --
    -- | See the \"Container Classes and Properties\" section at <http://www.w3.org/TR/rdf-schema/#ch_containervocab>.
    , resRdfsContainer
    , resRdfBag
    , resRdfSeq                                 
    , resRdfAlt  
    , resRdfsContainerMembershipProperty
    , resRdfsMember
    -- *** Collections
    --
    -- | See the \"Collections\" section at <http://www.w3.org/TR/rdf-schema/#ch_collectionvocab>.
    , resRdfList    
    , resRdfFirst
    , resRdfRest 
    , resRdfNil 
    -- *** Reification Vocabulary 
    --  
    -- | See the \"Reification Vocabulary\" section at <http://www.w3.org/TR/rdf-schema/#ch_reificationvocab>.
    , resRdfStatement  
    , resRdfSubject  
    , resRdfPredicate  
    , resRdfObject  
    -- *** Utility Properties 
    --  
    -- | See the \"Utility Properties\" section at <http://www.w3.org/TR/rdf-schema/#ch_utilvocab>.
    , resRdfsSeeAlso
    , resRdfsIsDefinedBy
    , resRdfValue  
    
    -- ** OWL     
    , resOwlSameAs
                    
    -- ** Miscellaneous     
    , resRdfdGeneralRestriction
    , resRdfdOnProperties, resRdfdConstraint, resRdfdMaxCardinality
    , resLogImplies
      
    -- * Exported for testing
    , grMatchMap, grEq
    , mapnode, maplist
    )
    where

import Swish.Namespace
    ( getNamespaceTuple
    , getScopedNameURI
    , ScopedName
    , getScopeLocal, getScopeNamespace
    , getQName
    , makeQNameScopedName
    , makeURIScopedName
    , nullScopedName
    )

import Swish.RDF.Vocabulary (LanguageTag)
import Swish.RDF.Vocabulary (fromLangTag, xsdBoolean, xsdDate, xsdDateTime, xsdDecimal, xsdDouble, xsdFloat, xsdInteger
                            , rdfType, rdfList, rdfFirst, rdfRest, rdfNil
                            , rdfsMember, rdfdGeneralRestriction, rdfdOnProperties, rdfdConstraint, rdfdMaxCardinality
                            , rdfsSeeAlso, rdfValue, rdfsLabel, rdfsComment, rdfProperty
                            , rdfsSubPropertyOf, rdfsSubClassOf, rdfsClass, rdfsLiteral
                            , rdfsDatatype, rdfXMLLiteral, rdfsRange, rdfsDomain, rdfsContainer
                            , rdfBag, rdfSeq, rdfAlt
                            , rdfsContainerMembershipProperty, rdfsIsDefinedBy
                            , rdfsResource, rdfStatement, rdfSubject, rdfPredicate, rdfObject
                            , rdfRDF, rdfDescription, rdfID, rdfAbout, rdfParseType
                            , rdfResource, rdfLi, rdfNodeID, rdfDatatype, rdfXMLLiteral
                            , rdf1, rdf2, rdfn
                            , owlSameAs, logImplies, namespaceRDF
                            )

import Swish.GraphClass (LDGraph(..), Label (..), Arc(..), ArcSet, Selector)
import Swish.GraphClass (arc, arcLabels, getComponents)
import Swish.GraphMatch (LabelMap, ScopedLabel(..))
import Swish.GraphMatch (graphMatch)
import Swish.QName (QName, getLName)

#if (!defined(__GLASGOW_HASKELL__)) || (__GLASGOW_HASKELL__ < 710)
import Control.Applicative (Applicative(pure), (<$>), (<*>))
import Data.Monoid (Monoid(..))
#endif

import Control.Arrow ((***))

import Network.URI (URI)

import Data.Maybe (mapMaybe)
import Data.Char (ord, isDigit)
import Data.Hashable (hashWithSalt)
import Data.List (intersect, union, foldl')
-- import Data.Ord (comparing)
import Data.Word (Word32)

import Data.String (IsString(..))

#if MIN_VERSION_time(1,5,0)
import Data.Time (UTCTime, Day, ParseTime, parseTimeM, formatTime, defaultTimeLocale)
#else
import Data.Time (UTCTime, Day, ParseTime, parseTime, formatTime)
import System.Locale (defaultTimeLocale)  
#endif

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

import Text.Printf

import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Data.Text.Read as T
import qualified Data.Traversable as Traversable

-- | RDF graph node values
--
--  cf. <http://www.w3.org/TR/rdf-concepts/#section-Graph-syntax> version 1.0
--
--  This is extended from the RDF abstract graph syntax in the
--  following ways:
--
--  (a) a graph can be part of a resource node or blank node
--      (cf. Notation3 formulae)
--
--  (b) a \"variable\" node option is distinguished from a
--      blank node.
--      I have found this useful for encoding and handling
--      queries, even though query variables can be expressed
--      as blank nodes.
--
--  (c) a \"NoNode\" option is defined.
--      This might otherwise be handled by @Maybe (RDFLabel g)@.
--
-- Prior to version @0.7.0.0@, literals were represented by a
-- single constructor, @Lit@, with an optional argument. Language
-- codes for literals was also stored as a 'ScopedName' rather than
-- as a 'LanguageTag'.
--
data RDFLabel =
      Res ScopedName                    -- ^ resource
    | Lit T.Text                        -- ^ plain literal (<http://www.w3.org/TR/rdf-concepts/#dfn-plain-literal>)
    | LangLit T.Text LanguageTag        -- ^ plain literal
    | TypedLit T.Text ScopedName        -- ^ typed literal (<http://www.w3.org/TR/rdf-concepts/#dfn-typed-literal>)
    | Blank String                      -- ^ blank node
    | Var String                        -- ^ variable (not used in ordinary graphs)
    | NoNode                            -- ^ no node  (not used in ordinary graphs)

-- | Define equality of nodes possibly based on different graph types.
--
-- The equality of literals is taken from section 6.5.1 ("Literal
-- Equality") of the RDF Concepts and Abstract Document,
-- <http://www.w3.org/TR/2004/REC-rdf-concepts-20040210/#section-Literal-Equality>.
--
instance Eq RDFLabel where
    Res ScopedName
q1   == :: RDFLabel -> RDFLabel -> Bool
== Res ScopedName
q2   = ScopedName
q1 forall a. Eq a => a -> a -> Bool
== ScopedName
q2
    Blank [Char]
b1 == Blank [Char]
b2 = [Char]
b1 forall a. Eq a => a -> a -> Bool
== [Char]
b2
    Var [Char]
v1   == Var [Char]
v2   = [Char]
v1 forall a. Eq a => a -> a -> Bool
== [Char]
v2

    Lit Text
s1         == Lit Text
s2         = Text
s1 forall a. Eq a => a -> a -> Bool
== Text
s2
    LangLit Text
s1 LanguageTag
l1  == LangLit Text
s2 LanguageTag
l2  = Text
s1 forall a. Eq a => a -> a -> Bool
== Text
s2 Bool -> Bool -> Bool
&& LanguageTag
l1 forall a. Eq a => a -> a -> Bool
== LanguageTag
l2
    TypedLit Text
s1 ScopedName
t1 == TypedLit Text
s2 ScopedName
t2 = Text
s1 forall a. Eq a => a -> a -> Bool
== Text
s2 Bool -> Bool -> Bool
&& ScopedName
t1 forall a. Eq a => a -> a -> Bool
== ScopedName
t2

    RDFLabel
_  == RDFLabel
_ = Bool
False

instance Show RDFLabel where
    show :: RDFLabel -> [Char]
show (Res ScopedName
sn)           = forall a. Show a => a -> [Char]
show ScopedName
sn
    show (Lit Text
st)           = Text -> [Char]
quote1Str Text
st
    show (LangLit Text
st LanguageTag
lang)  = Text -> [Char]
quote1Str Text
st forall a. [a] -> [a] -> [a]
++ [Char]
"@"  forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack (LanguageTag -> Text
fromLangTag LanguageTag
lang)
    show (TypedLit Text
st ScopedName
dtype) 
        | ScopedName
dtype forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ScopedName
xsdBoolean, ScopedName
xsdDouble, ScopedName
xsdDecimal, ScopedName
xsdInteger] = Text -> [Char]
T.unpack Text
st
        | Bool
otherwise  = Text -> [Char]
quote1Str Text
st forall a. [a] -> [a] -> [a]
++ [Char]
"^^" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ScopedName
dtype

    {-
    show (Lit st (Just nam))
        | isLang nam = quote1Str st ++ "@"  ++ T.unpack (langTag nam)
        | nam `elem` [xsdBoolean, xsdDouble, xsdDecimal, xsdInteger] = T.unpack st
        | otherwise  = quote1Str st ++ "^^" ++ show nam
    -}

    show (Blank [Char]
ln)         = [Char]
"_:" forall a. [a] -> [a] -> [a]
++ [Char]
ln
    show (Var [Char]
ln)           = Char
'?' forall a. a -> [a] -> [a]
: [Char]
ln
    show RDFLabel
NoNode             = [Char]
"<NoNode>"

instance Ord RDFLabel where
    -- Order, from lowest to highest is
    --    Res, Lit, LangLit, TypedLit, Blank, Var, NoNode
    --
    compare :: RDFLabel -> RDFLabel -> Ordering
compare (Res ScopedName
sn1)        (Res ScopedName
sn2)        = forall a. Ord a => a -> a -> Ordering
compare ScopedName
sn1 ScopedName
sn2
    compare (Res ScopedName
_)          RDFLabel
_                = Ordering
LT
    compare RDFLabel
_                (Res ScopedName
_)          = Ordering
GT

    compare (Lit Text
s1)         (Lit Text
s2)         = forall a. Ord a => a -> a -> Ordering
compare Text
s1 Text
s2
    compare (Lit Text
_)          RDFLabel
_                = Ordering
LT
    compare RDFLabel
_                (Lit Text
_)          = Ordering
GT

    compare (LangLit Text
s1 LanguageTag
l1)  (LangLit Text
s2 LanguageTag
l2)  = forall a. Ord a => a -> a -> Ordering
compare (Text
s1,LanguageTag
l1) (Text
s2,LanguageTag
l2)
    compare (LangLit Text
_ LanguageTag
_)    RDFLabel
_                = Ordering
LT
    compare RDFLabel
_                (LangLit Text
_ LanguageTag
_)    = Ordering
GT

    compare (TypedLit Text
s1 ScopedName
t1) (TypedLit Text
s2 ScopedName
t2) = forall a. Ord a => a -> a -> Ordering
compare (Text
s1,ScopedName
t1) (Text
s2,ScopedName
t2)
    compare (TypedLit Text
_ ScopedName
_)   RDFLabel
_                = Ordering
LT
    compare RDFLabel
_                (TypedLit Text
_ ScopedName
_)   = Ordering
GT

    compare (Blank [Char]
ln1)      (Blank [Char]
ln2)      = forall a. Ord a => a -> a -> Ordering
compare [Char]
ln1 [Char]
ln2
    compare (Blank [Char]
_)        RDFLabel
_                = Ordering
LT
    compare RDFLabel
_                (Blank [Char]
_)        = Ordering
GT

    compare (Var [Char]
ln1)        (Var [Char]
ln2)        = forall a. Ord a => a -> a -> Ordering
compare [Char]
ln1 [Char]
ln2
    compare (Var [Char]
_)          RDFLabel
NoNode           = Ordering
LT
    compare RDFLabel
_                (Var [Char]
_)          = Ordering
GT

    compare RDFLabel
NoNode           RDFLabel
NoNode           = Ordering
EQ

instance Label RDFLabel where
    labelIsVar :: RDFLabel -> Bool
labelIsVar (Blank [Char]
_)    = Bool
True
    labelIsVar (Var [Char]
_)      = Bool
True
    labelIsVar RDFLabel
_            = Bool
False

    getLocal :: RDFLabel -> [Char]
getLocal   (Blank [Char]
loc)  = [Char]
loc
    getLocal   (Var   [Char]
loc)  = Char
'?'forall a. a -> [a] -> [a]
:[Char]
loc
    getLocal   (Res   ScopedName
sn)   = [Char]
"Res_" forall a. [a] -> [a] -> [a]
++ (Text -> [Char]
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. LName -> Text
getLName forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScopedName -> LName
getScopeLocal) ScopedName
sn
    getLocal   RDFLabel
NoNode       = [Char]
"None"
    getLocal   RDFLabel
_            = [Char]
"Lit_"

    makeLabel :: [Char] -> RDFLabel
makeLabel  (Char
'?':[Char]
loc)    = [Char] -> RDFLabel
Var [Char]
loc
    makeLabel  [Char]
loc          = [Char] -> RDFLabel
Blank [Char]
loc

    labelHash :: Int -> RDFLabel -> Int
labelHash Int
seed RDFLabel
lb       = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
seed (RDFLabel -> [Char]
showCanon RDFLabel
lb)

instance IsString RDFLabel where
  fromString :: [Char] -> RDFLabel
fromString = Text -> RDFLabel
Lit forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack

{-|
A type that can be converted to a RDF Label.

The String instance converts to an untyped literal
(so no language tag is assumed).

The `UTCTime` and `Day` instances assume values are in UTC.
 
The conversion for XSD types attempts to use the
canonical form described in section 2.3.1 of
<http://www.w3.org/TR/2004/REC-xmlschema-2-20041028/#lexical-space>.
  
Note that this is similar to
'Swish.RDF.Datatype.toRDFLabel';
the code should probably be combined at some point.
-}

class ToRDFLabel a where
  toRDFLabel :: a -> RDFLabel
  
{-|
A type that can be converted from a RDF Label,
with the possibility of failure.
 
The String instance converts from an untyped literal
(so it can not be used with a string with a language tag).

The following conversions are supported for common XSD
types (out-of-band values result in @Nothing@):

 - @xsd:boolean@ to @Bool@

 - @xsd:integer@ to @Int@ and @Integer@

 - @xsd:float@ to @Float@

 - @xsd:double@ to @Double@

 - @xsd:dateTime@ to @UTCTime@

 - @xsd:date@ to @Day@

Note that this is similar to
'Swish.RDF.Datatype.fromRDFLabel'; 
the code should probably be combined at some point.
-}

class FromRDFLabel a where
  fromRDFLabel :: RDFLabel -> Maybe a

-- instances for type conversion to/from RDFLabel
  
-- | This is just @id@.
instance ToRDFLabel RDFLabel where
  toRDFLabel :: RDFLabel -> RDFLabel
toRDFLabel = forall a. a -> a
id
  
-- | This is just @Just@.
instance FromRDFLabel RDFLabel where
  fromRDFLabel :: RDFLabel -> Maybe RDFLabel
fromRDFLabel = forall a. a -> Maybe a
Just
  
-- TODO: remove this hack when finished conversion to Text
maybeReadStr :: (Read a) => T.Text -> Maybe a  
maybeReadStr :: forall a. Read a => Text -> Maybe a
maybeReadStr Text
txt = case forall a. Read a => ReadS a
reads (Text -> [Char]
T.unpack Text
txt) of
  [(a
val, [Char]
"")] -> forall a. a -> Maybe a
Just a
val
  [(a, [Char])]
_ -> forall a. Maybe a
Nothing
  
maybeRead :: T.Reader a -> T.Text -> Maybe a
maybeRead :: forall a. Reader a -> Text -> Maybe a
maybeRead Reader a
rdr Text
inTxt = 
  case Reader a
rdr Text
inTxt of
    Right (a
val, Text
"") -> forall a. a -> Maybe a
Just a
val
    Either [Char] (a, Text)
_ -> forall a. Maybe a
Nothing
    
fLabel :: (T.Text -> Maybe a) -> ScopedName -> RDFLabel -> Maybe a
fLabel :: forall a. (Text -> Maybe a) -> ScopedName -> RDFLabel -> Maybe a
fLabel Text -> Maybe a
conv ScopedName
dtype (TypedLit Text
xs ScopedName
dt) | ScopedName
dt forall a. Eq a => a -> a -> Bool
== ScopedName
dtype = Text -> Maybe a
conv Text
xs
                                   | Bool
otherwise   = forall a. Maybe a
Nothing
fLabel Text -> Maybe a
_    ScopedName
_     RDFLabel
_ = forall a. Maybe a
Nothing
  
tLabel :: (Show a) => ScopedName -> (String -> T.Text) -> a -> RDFLabel                      
tLabel :: forall a. Show a => ScopedName -> ([Char] -> Text) -> a -> RDFLabel
tLabel ScopedName
dtype [Char] -> Text
conv = forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> ScopedName -> RDFLabel
TypedLit ScopedName
dtype forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
conv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show                      

-- | The character is converted to an untyped literal of length one.
instance ToRDFLabel Char where
  toRDFLabel :: Char -> RDFLabel
toRDFLabel = Text -> RDFLabel
Lit forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton

-- | The label must be an untyped literal containing a single character.
instance FromRDFLabel Char where
  fromRDFLabel :: RDFLabel -> Maybe Char
fromRDFLabel (Lit Text
cs) | Text -> Int -> Ordering
T.compareLength Text
cs Int
1 forall a. Eq a => a -> a -> Bool
== Ordering
EQ = forall a. a -> Maybe a
Just (Text -> Char
T.head Text
cs)
                        | Bool
otherwise = forall a. Maybe a
Nothing
  fromRDFLabel RDFLabel
_ = forall a. Maybe a
Nothing

-- | Strings are converted to untyped literals.
instance ToRDFLabel String where
  toRDFLabel :: [Char] -> RDFLabel
toRDFLabel = Text -> RDFLabel
Lit forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack

-- | Only untyped literals are converted to strings.
instance FromRDFLabel String where
  fromRDFLabel :: RDFLabel -> Maybe [Char]
fromRDFLabel (Lit Text
xs) = forall a. a -> Maybe a
Just (Text -> [Char]
T.unpack Text
xs)
  fromRDFLabel RDFLabel
_        = forall a. Maybe a
Nothing

textToBool :: T.Text -> Maybe Bool
textToBool :: Text -> Maybe Bool
textToBool Text
s | Text
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"1", Text
"true"]  = forall a. a -> Maybe a
Just Bool
True
             | Text
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"0", Text
"false"] = forall a. a -> Maybe a
Just Bool
False
             | Bool
otherwise               = forall a. Maybe a
Nothing

-- | Converts to a literal with a @xsd:boolean@ datatype.
instance ToRDFLabel Bool where
  toRDFLabel :: Bool -> RDFLabel
toRDFLabel Bool
b = Text -> ScopedName -> RDFLabel
TypedLit (if Bool
b then Text
"true" else Text
"false") ScopedName
xsdBoolean
                                                 
-- | Converts from a literal with a @xsd:boolean@ datatype. The
-- literal can be any of the supported XSD forms - e.g. \"0\" or
-- \"true\".
instance FromRDFLabel Bool where
  fromRDFLabel :: RDFLabel -> Maybe Bool
fromRDFLabel = forall a. (Text -> Maybe a) -> ScopedName -> RDFLabel -> Maybe a
fLabel Text -> Maybe Bool
textToBool ScopedName
xsdBoolean

-- fromRealFloat :: (RealFloat a, Buildable a) => ScopedName -> a -> RDFLabel
fromRealFloat :: (RealFloat a, PrintfArg a) => ScopedName -> a -> RDFLabel
fromRealFloat :: forall a. (RealFloat a, PrintfArg a) => ScopedName -> a -> RDFLabel
fromRealFloat ScopedName
dtype a
f | forall a. RealFloat a => a -> Bool
isNaN a
f      = Text -> RDFLabel
toL Text
"NaN"
                      | forall a. RealFloat a => a -> Bool
isInfinite a
f = Text -> RDFLabel
toL forall a b. (a -> b) -> a -> b
$ if a
f forall a. Ord a => a -> a -> Bool
> a
0.0 then Text
"INF" else Text
"-INF"
                      -- 
                      -- Would like to use Data.Text.Format.format but there are                                                                        
                      -- issues with this module; 0.3.0.2 doesn't build under
                      -- 6.12.3 due to a missing RelaxedPolyRec language extension
                      -- and it relies on double-conversion which has issues
                      -- when used in ghci due to a dlopen issue with libstdc++.
                      -- 
                      -- -- | otherwise    = toL $ L.toStrict $ format "{}" (Only f)  
                      -- 
                      | Bool
otherwise    = Text -> RDFLabel
toL forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => [Char] -> r
printf [Char]
"%E" a
f
                        
                        where
                          toL :: Text -> RDFLabel
toL = forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> ScopedName -> RDFLabel
TypedLit ScopedName
dtype

-- textToRealFloat :: (RealFloat a) => (a -> Maybe a) -> T.Text -> Maybe a
textToRealFloat :: (RealFloat a, Read a) => (a -> Maybe a) -> T.Text -> Maybe a
textToRealFloat :: forall a.
(RealFloat a, Read a) =>
(a -> Maybe a) -> Text -> Maybe a
textToRealFloat a -> Maybe a
conv = Text -> Maybe a
rconv
    where
      rconv :: Text -> Maybe a
rconv Text
"NaN"  = forall a. a -> Maybe a
Just (a
0.0 forall a. Fractional a => a -> a -> a
/ a
0.0) -- how best to create a NaN?
      rconv Text
"INF"  = forall a. a -> Maybe a
Just (a
1.0 forall a. Fractional a => a -> a -> a
/ a
0.0) -- ditto for Infinity
      rconv Text
"-INF" = forall a. a -> Maybe a
Just ((-a
1.0) forall a. Fractional a => a -> a -> a
/ a
0.0)
      rconv Text
ival 
        -- xsd semantics allows "2." but Haskell syntax does not.
        | Text -> Bool
T.null Text
ival = forall a. Maybe a
Nothing
          
        | Bool
otherwise = case forall a. Read a => Text -> Maybe a
maybeReadStr Text
ival of
          Just a
val -> a -> Maybe a
conv a
val
          Maybe a
_        -> if Text -> Char
T.last Text
ival forall a. Eq a => a -> a -> Bool
== Char
'.' -- could drop the check
                      then forall a. Read a => Text -> Maybe a
maybeReadStr (Text -> Char -> Text
T.snoc Text
ival Char
'0') forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Maybe a
conv
                      else forall a. Maybe a
Nothing
                               
        {-

        Unfortunately T.rational does not handle "3.01e4" the same
        as read; see https://bitbucket.org/bos/text/issue/7/

        | otherwise = case maybeRead T.rational ival of
          Just val -> conv val
          _        -> if T.last ival == '.' -- could drop the check
                      then maybeRead T.rational (T.snoc ival '0') >>= conv
                      else Nothing
        -}
                        
        -- not sure the above is any improvement on the following
        -- -- | T.last ival == '.' = maybeRead T.rational (T.snoc ival '0') >>= conv
        -- -- | otherwise          = maybeRead T.rational ival >>= conv
      
textToFloat :: T.Text -> Maybe Float
textToFloat :: Text -> Maybe Float
textToFloat = 
  let -- assume that an invalid value (NaN/Inf) from maybeRead means
      -- that the value is out of bounds for Float so we do not
      -- convert
      conv :: a -> Maybe a
conv a
f | forall a. RealFloat a => a -> Bool
isNaN a
f Bool -> Bool -> Bool
|| forall a. RealFloat a => a -> Bool
isInfinite a
f = forall a. Maybe a
Nothing
             | Bool
otherwise               = forall a. a -> Maybe a
Just a
f
  in forall a.
(RealFloat a, Read a) =>
(a -> Maybe a) -> Text -> Maybe a
textToRealFloat forall {a}. RealFloat a => a -> Maybe a
conv

textToDouble :: T.Text -> Maybe Double      
textToDouble :: Text -> Maybe Double
textToDouble = forall a.
(RealFloat a, Read a) =>
(a -> Maybe a) -> Text -> Maybe a
textToRealFloat forall a. a -> Maybe a
Just

-- | Converts to a literal with a @xsd:float@ datatype.
instance ToRDFLabel Float where
  toRDFLabel :: Float -> RDFLabel
toRDFLabel = forall a. (RealFloat a, PrintfArg a) => ScopedName -> a -> RDFLabel
fromRealFloat ScopedName
xsdFloat
  
-- | Converts from a literal with a @xsd:float@ datatype.
-- The conversion will fail if the value is outside the valid range of
-- a Haskell `Float`.
instance FromRDFLabel Float where
  fromRDFLabel :: RDFLabel -> Maybe Float
fromRDFLabel = forall a. (Text -> Maybe a) -> ScopedName -> RDFLabel -> Maybe a
fLabel Text -> Maybe Float
textToFloat ScopedName
xsdFloat
                 
-- | Converts to a literal with a @xsd:double@ datatype.
instance ToRDFLabel Double where
  toRDFLabel :: Double -> RDFLabel
toRDFLabel = forall a. (RealFloat a, PrintfArg a) => ScopedName -> a -> RDFLabel
fromRealFloat ScopedName
xsdDouble
  
-- | Converts from a literal with a @xsd:double@ datatype.
instance FromRDFLabel Double where
  fromRDFLabel :: RDFLabel -> Maybe Double
fromRDFLabel = forall a. (Text -> Maybe a) -> ScopedName -> RDFLabel -> Maybe a
fLabel Text -> Maybe Double
textToDouble ScopedName
xsdDouble
  
-- TODO: are there subtypes of xsd::integer that are  
--       useful here?  
--         
-- TODO: add in support for Int8/..., Word8/...  
--  

-- | Converts to a literal with a @xsd:integer@ datatype.
instance ToRDFLabel Int where
  toRDFLabel :: Int -> RDFLabel
toRDFLabel = forall a. Show a => ScopedName -> ([Char] -> Text) -> a -> RDFLabel
tLabel ScopedName
xsdInteger [Char] -> Text
T.pack

{-
Since decimal will just over/under-flow when converting to Int
we go via Integer and explicitly check for overflow.
-}

textToInt :: T.Text -> Maybe Int
textToInt :: Text -> Maybe Int
textToInt Text
s = 
  let conv :: Integer -> Maybe Int
      conv :: Integer -> Maybe Int
conv Integer
i = 
        let lb :: Integer
lb = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound :: Int)
            ub :: Integer
ub = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Int)
        in if (Integer
i forall a. Ord a => a -> a -> Bool
>= Integer
lb) Bool -> Bool -> Bool
&& (Integer
i forall a. Ord a => a -> a -> Bool
<= Integer
ub) then forall a. a -> Maybe a
Just (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) else forall a. Maybe a
Nothing
  
  in forall a. Reader a -> Text -> Maybe a
maybeRead (forall a. Num a => Reader a -> Reader a
T.signed forall a. Integral a => Reader a
T.decimal) Text
s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Integer -> Maybe Int
conv

-- | Converts from a literal with a @xsd:integer@ datatype.
-- The conversion will fail if the value is outside the valid range of
-- a Haskell `Int`.
instance FromRDFLabel Int where
  fromRDFLabel :: RDFLabel -> Maybe Int
fromRDFLabel = forall a. (Text -> Maybe a) -> ScopedName -> RDFLabel -> Maybe a
fLabel Text -> Maybe Int
textToInt ScopedName
xsdInteger

-- | Converts to a literal with a @xsd:integer@ datatype.
instance ToRDFLabel Integer where
  toRDFLabel :: Integer -> RDFLabel
toRDFLabel = forall a. Show a => ScopedName -> ([Char] -> Text) -> a -> RDFLabel
tLabel ScopedName
xsdInteger [Char] -> Text
T.pack

-- | Converts from a literal with a @xsd:integer@ datatype.
instance FromRDFLabel Integer where
  fromRDFLabel :: RDFLabel -> Maybe Integer
fromRDFLabel = forall a. (Text -> Maybe a) -> ScopedName -> RDFLabel -> Maybe a
fLabel (forall a. Reader a -> Text -> Maybe a
maybeRead (forall a. Num a => Reader a -> Reader a
T.signed forall a. Integral a => Reader a
T.decimal)) ScopedName
xsdInteger

{-
Support an ISO-8601 style format supporting

  2005-02-28T00:00:00Z
  2004-12-31T19:01:00-05:00
  2005-07-14T03:18:56.234+01:00

fromUTCFormat is used to convert UTCTime to a string
for storage within a Lit.

toUTCFormat is used to convert a string into UTCTime;
we have to support 
   no time zone
   Z
   +/-HH:MM

which means a somewhat messy convertor, which is written
for clarity rather than speed.
-}

fromUTCFormat :: UTCTime -> String
fromUTCFormat :: UTCTime -> [Char]
fromUTCFormat = forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
"%FT%T%QZ"
  
fromDayFormat :: Day -> String
fromDayFormat :: Day -> [Char]
fromDayFormat = forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
"%FZ"
  
toTimeFormat :: (ParseTime a) => String -> String -> Maybe a
toTimeFormat :: forall a. ParseTime a => [Char] -> [Char] -> Maybe a
toTimeFormat [Char]
fmt [Char]
inVal =
  let fmtHHMM :: [Char]
fmtHHMM = [Char]
fmt forall a. [a] -> [a] -> [a]
++ [Char]
"%z"
      fmtZ :: [Char]
fmtZ = [Char]
fmt forall a. [a] -> [a] -> [a]
++ [Char]
"Z"
#if MIN_VERSION_time(1,5,0)
      pt :: [Char] -> m t
pt [Char]
f = forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> [Char] -> [Char] -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale [Char]
f [Char]
inVal
#else
      pt f = parseTime defaultTimeLocale f inVal
#endif
  in case forall {m :: * -> *} {t}.
(MonadFail m, ParseTime t) =>
[Char] -> m t
pt [Char]
fmtHHMM of
    o :: Maybe a
o@(Just a
_) -> Maybe a
o
    Maybe a
_ -> case forall {m :: * -> *} {t}.
(MonadFail m, ParseTime t) =>
[Char] -> m t
pt [Char]
fmtZ of
      o :: Maybe a
o@(Just a
_) -> Maybe a
o
      Maybe a
_ -> forall {m :: * -> *} {t}.
(MonadFail m, ParseTime t) =>
[Char] -> m t
pt [Char]
fmt 
  
toUTCFormat :: T.Text -> Maybe UTCTime
toUTCFormat :: Text -> Maybe UTCTime
toUTCFormat = forall a. ParseTime a => [Char] -> [Char] -> Maybe a
toTimeFormat [Char]
"%FT%T%Q" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack
    
toDayFormat :: T.Text -> Maybe Day
toDayFormat :: Text -> Maybe Day
toDayFormat = forall a. ParseTime a => [Char] -> [Char] -> Maybe a
toTimeFormat [Char]
"%F" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack
    
-- | Converts to a literal with a @xsd:datetime@ datatype.
instance ToRDFLabel UTCTime where
  toRDFLabel :: UTCTime -> RDFLabel
toRDFLabel = forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> ScopedName -> RDFLabel
TypedLit ScopedName
xsdDateTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> [Char]
fromUTCFormat
  
-- | Converts from a literal with a @xsd:datetime@ datatype.
instance FromRDFLabel UTCTime where
  fromRDFLabel :: RDFLabel -> Maybe UTCTime
fromRDFLabel = forall a. (Text -> Maybe a) -> ScopedName -> RDFLabel -> Maybe a
fLabel Text -> Maybe UTCTime
toUTCFormat ScopedName
xsdDateTime
  
-- | Converts to a literal with a @xsd:date@ datatype.
instance ToRDFLabel Day where
  toRDFLabel :: Day -> RDFLabel
toRDFLabel = forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> ScopedName -> RDFLabel
TypedLit ScopedName
xsdDate forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> [Char]
fromDayFormat

-- | Converts from a literal with a @xsd:date@ datatype.
instance FromRDFLabel Day where
  fromRDFLabel :: RDFLabel -> Maybe Day
fromRDFLabel = forall a. (Text -> Maybe a) -> ScopedName -> RDFLabel -> Maybe a
fLabel Text -> Maybe Day
toDayFormat ScopedName
xsdDate
  
-- | Converts to a Resource.
instance ToRDFLabel ScopedName where  
  toRDFLabel :: ScopedName -> RDFLabel
toRDFLabel = ScopedName -> RDFLabel
Res

-- | Converts from a Resource.
instance FromRDFLabel ScopedName where
  fromRDFLabel :: RDFLabel -> Maybe ScopedName
fromRDFLabel (Res ScopedName
sn) = forall a. a -> Maybe a
Just ScopedName
sn
  fromRDFLabel RDFLabel
_        = forall a. Maybe a
Nothing
  
-- | Converts to a Resource.
instance ToRDFLabel QName where  
  toRDFLabel :: QName -> RDFLabel
toRDFLabel = ScopedName -> RDFLabel
Res forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text -> QName -> ScopedName
makeQNameScopedName forall a. Maybe a
Nothing
  
-- | Converts from a Resource.
instance FromRDFLabel QName where
  fromRDFLabel :: RDFLabel -> Maybe QName
fromRDFLabel (Res ScopedName
sn) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ScopedName -> QName
getQName ScopedName
sn
  fromRDFLabel RDFLabel
_        = forall a. Maybe a
Nothing
  
-- | Converts to a Resource.
instance ToRDFLabel URI where  
  toRDFLabel :: URI -> RDFLabel
toRDFLabel = ScopedName -> RDFLabel
Res forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> ScopedName
makeURIScopedName
  
-- | Converts from a Resource.
instance FromRDFLabel URI where
  fromRDFLabel :: RDFLabel -> Maybe URI
fromRDFLabel (Res ScopedName
sn) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ScopedName -> URI
getScopedNameURI ScopedName
sn
  fromRDFLabel RDFLabel
_        = forall a. Maybe a
Nothing

-- | Get the canonical string for RDF label.
--
--  This is used for hashing, so that equivalent labels always return
--  the same hash value.
--
--  TODO: can remove the use of quote1Str as all we care about is
--  a unique output, not that it is valid in any RDF format. Also
--  rename to showForHash or something like that, since it is only used
--  for this purpose.
--
showCanon :: RDFLabel -> String
showCanon :: RDFLabel -> [Char]
showCanon (Res ScopedName
sn)           = [Char]
"<" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (ScopedName -> URI
getScopedNameURI ScopedName
sn) forall a. [a] -> [a] -> [a]
++ [Char]
">"
showCanon (Lit Text
st)           = forall a. Show a => a -> [Char]
show Text
st
showCanon (LangLit Text
st LanguageTag
lang)  = Text -> [Char]
quote1Str Text
st forall a. [a] -> [a] -> [a]
++ [Char]
"@"  forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack (LanguageTag -> Text
fromLangTag LanguageTag
lang)
showCanon (TypedLit Text
st ScopedName
dt)   = Text -> [Char]
quote1Str Text
st forall a. [a] -> [a] -> [a]
++ [Char]
"^^" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (ScopedName -> URI
getScopedNameURI ScopedName
dt)
showCanon RDFLabel
s                  = forall a. Show a => a -> [Char]
show RDFLabel
s

-- The Data.Text API points out issues with processing a text
-- character-by-character, but it's not clear to me how to avoid
-- that here.
--
-- One assumption would be that the strings aren't likely to be large,
-- so that several calls to T.find or similar could be made to
-- simplify certain cases.
--
-- Is it worth scanning through the text to look for characters like \n
-- or #, or to look for sequences like '##'?

-- Is it worth sending in a flag to indicate the different modes for
-- handling \n characters, or just leave this complexity in 'quoteT False'?
--
processChar ::
  Char
  -> (T.Text, Bool) -- ^ the boolean is @True@ if the returned text has been
  -- expanded so that it begins with @\\@
processChar :: Char -> (Text, Bool)
processChar Char
'"'  = (Text
"\\\"", Bool
True)
processChar Char
'\\' = (Text
"\\\\", Bool
True)
processChar Char
'\n' = (Text
"\\n", Bool
True)
processChar Char
'\r' = (Text
"\\r", Bool
True)
processChar Char
'\t' = (Text
"\\t", Bool
True)
processChar Char
'\b' = (Text
"\\b", Bool
True)
-- processChar '\f' = ("\\f", True)
-- Using the above I get invalid output according to
-- rapper version 2.0.9, so use the following for now
-- (changed at version 0.9.0.6)
processChar Char
'\f' = (Text
"\\u000C", Bool
True) -- 
processChar Char
c =
  let nc :: Int
nc = Char -> Int
ord Char
c
      -- lazy ways to convert to hex-encoded strings
      four :: Text
four = Text -> Text -> Text
T.append Text
"\\u" forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => [Char] -> r
printf [Char]
"%04X" Int
nc
      eight :: Text
eight = Text -> Text -> Text
T.append Text
"\\U" forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => [Char] -> r
printf [Char]
"%08X" Int
nc
  in if Int
nc forall a. Ord a => a -> a -> Bool
< Int
0x20
     then (Text
four, Bool
True)
     else if Int
nc forall a. Ord a => a -> a -> Bool
< Int
0x7f
          then (Char -> Text
T.singleton Char
c, Bool
False)
          else if Int
nc forall a. Ord a => a -> a -> Bool
< Int
0x10000
               then (Text
four, Bool
True)
               else (Text
eight, Bool
True)

convertChar :: Char -> T.Text
convertChar :: Char -> Text
convertChar = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> (Text, Bool)
processChar

-- | See `quote`.
quoteT :: Bool -> T.Text -> T.Text
quoteT :: Bool -> Text -> Text
quoteT Bool
True Text
txt =
  -- Output is to be used as "..."
  let go :: (Text -> t) -> Text -> t
go Text -> t
dl Text
x =
        case Text -> Maybe (Char, Text)
T.uncons Text
x of
          Just (Char
c, Text
xs) -> (Text -> t) -> Text -> t
go (Text -> t
dl forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
T.append (Char -> Text
convertChar Char
c)) Text
xs
          Maybe (Char, Text)
_ -> Text -> t
dl Text
T.empty
                          
  in forall {t}. (Text -> t) -> Text -> t
go (Text -> Text -> Text
T.append Text
T.empty) Text
txt

-- One complexity here is my reading of the Turtle grammar
--    STRING_LITERAL_LONG_QUOTE ::=	'"""' (('"' | '""')? [^"\] | ECHAR | UCHAR)* '"""'
-- which says that any un-protected double-quote characters can not
-- be followed by a \ character. One option would be to always use the
-- 'quoteT True' behavior.
--
quoteT Bool
_ Text
txt =
  -- Output is to be used as """...""""
  let go :: (Text -> t) -> Text -> t
go Text -> t
dl Text
x =
        case Text -> Maybe (Char, Text)
T.uncons Text
x of
          Just (Char
'"', Text
xs) -> (Text -> t) -> Text -> t
go1 Text -> t
dl Text
xs
          Just (Char
'\n', Text
xs) -> (Text -> t) -> Text -> t
go (Text -> t
dl forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text -> Text
T.cons Char
'\n') Text
xs
          Just (Char
c, Text
xs) -> (Text -> t) -> Text -> t
go (Text -> t
dl forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
T.append (Char -> Text
convertChar Char
c)) Text
xs
          Maybe (Char, Text)
_ -> Text -> t
dl Text
T.empty

      -- Seen one double quote
      go1 :: (Text -> t) -> Text -> t
go1 Text -> t
dl Text
x =
        case Text -> Maybe (Char, Text)
T.uncons Text
x of
          Just (Char
'"', Text
xs) -> (Text -> t) -> Text -> t
go2 Text -> t
dl Text
xs
          Just (Char
'\n', Text
xs) -> (Text -> t) -> Text -> t
go (Text -> t
dl forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
T.append Text
"\"\n") Text
xs
          Just (Char
'\\', Text
xs) -> (Text -> t) -> Text -> t
go (Text -> t
dl forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
T.append Text
"\\\"\\\\") Text
xs
          Just (Char
c, Text
xs) ->
            let (Text
t, Bool
f) = Char -> (Text, Bool)
processChar Char
c
                dl' :: Text -> Text
dl' = if Bool
f then Text -> Text -> Text
T.append Text
"\\\"" else Char -> Text -> Text
T.cons Char
'"'
            in (Text -> t) -> Text -> t
go (Text -> t
dl forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
dl' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
T.append Text
t) Text
xs
          Maybe (Char, Text)
_ -> Text -> t
dl Text
"\\\""
          
      -- Seen two double quotes
      go2 :: (Text -> t) -> Text -> t
go2 Text -> t
dl Text
x =
        case Text -> Maybe (Char, Text)
T.uncons Text
x of
          Just (Char
'"', Text
xs) -> (Text -> t) -> Text -> t
go (Text -> t
dl forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
T.append Text
"\\\"\\\"\\\"") Text
xs
          Just (Char
'\n', Text
xs) -> (Text -> t) -> Text -> t
go (Text -> t
dl forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
T.append Text
"\"\"\n") Text
xs
          Just (Char
'\\', Text
xs) -> (Text -> t) -> Text -> t
go (Text -> t
dl forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
T.append Text
"\\\"\\\"\\\\") Text
xs
          Just (Char
c, Text
xs) ->
            let (Text
t, Bool
f) = Char -> (Text, Bool)
processChar Char
c
                dl' :: Text -> Text
dl' = Text -> Text -> Text
T.append (if Bool
f then Text
"\\\"\\\"" else Text
"\"\"")
            in (Text -> t) -> Text -> t
go (Text -> t
dl forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
dl' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
T.append Text
t) Text
xs
          Maybe (Char, Text)
_ -> Text -> t
dl Text
"\\\"\\\""

      -- at the start of the string we have 3 quotes, so any
      -- starting quote characters must be quoted.
      go0 :: (Text -> t) -> Text -> t
go0 Text -> t
dl Text
x =
        case Text -> Maybe (Char, Text)
T.uncons Text
x of
          Just (Char
'"', Text
xs) -> (Text -> t) -> Text -> t
go0 (Text -> t
dl forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
T.append Text
"\\\"") Text
xs
          Just (Char
'\n', Text
xs) -> forall {t}. (Text -> t) -> Text -> t
go (Text -> t
dl forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text -> Text
T.cons Char
'\n') Text
xs
          Just (Char
c, Text
xs) -> forall {t}. (Text -> t) -> Text -> t
go (Text -> t
dl forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
T.append (Char -> Text
convertChar Char
c)) Text
xs
          Maybe (Char, Text)
_ -> Text -> t
dl Text
T.empty
      
  in forall {t}. (Text -> t) -> Text -> t
go0 (Text -> Text -> Text
T.append Text
T.empty) Text
txt
        
-- | Turtle-style quoting rules for a string.
--
--   At present the choice is between using one or three
--   double quote (@\"@) characters to surround the string; i.e. using
--   single quote (@'@)  characters is not supported.
-- 
--   As of Swish 0.9.0.6, the @\\f@ character is converted to
--   @\\u000C@ rather than left as is to aid interoperability
--   with some other tools.
--   
quote :: 
  Bool  -- ^ @True@ if the string is to be displayed using one rather than three quotes.
  -> String -- ^ String to quote.
  -> String -- ^ The string does /not/ contain the surrounding quote marks.
quote :: Bool -> ShowS
quote Bool
f = Text -> [Char]
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Text -> Text
quoteT Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack

{-
quote _     []           = ""
quote False s@(c:'"':[]) | c == '\\'  = s -- handle triple-quoted strings ending in "
                         | otherwise  = [c, '\\', '"']

quote True  ('"': st)    = '\\':'"': quote True  st
quote True  ('\n':st)    = '\\':'n': quote True  st
quote True  ('\t':st)    = '\\':'t': quote True  st

quote False ('"': st)    =      '"': quote False st
quote False ('\n':st)    =     '\n': quote False st
quote False ('\t':st)    =     '\t': quote False st
quote f ('\r':st)    = '\\':'r': quote f st
quote f ('\\':st)    = '\\':'\\': quote f st -- not sure about this
quote f (c:st) = 
  let nc = ord c
      rst = quote f st
      
      -- lazy way to convert to a string
      hstr = printf "%08X" nc
      ustr = hstr ++ rst

  in if nc > 0xffff 
     then '\\':'U': ustr
     else if nc > 0x7e || nc < 0x20
          then '\\':'u': drop 4 ustr
          else c : rst

-}

-- surround a string with a single double-quote mark at each end,
-- e.g. "...".
quote1Str :: T.Text -> String
quote1Str :: Text -> [Char]
quote1Str Text
t = Char
'"' forall a. a -> [a] -> [a]
: Text -> [Char]
T.unpack (Bool -> Text -> Text
quoteT Bool
True Text
t) forall a. [a] -> [a] -> [a]
++ [Char]
"\""

---------------------------------------------------------
--  Selected RDFLabel values
---------------------------------------------------------

-- | @rdf:type@ from <http://www.w3.org/TR/rdf-schema/#ch_type>.
resRdfType :: RDFLabel
resRdfType :: RDFLabel
resRdfType = ScopedName -> RDFLabel
Res ScopedName
rdfType 

-- | @rdf:List@ from <http://www.w3.org/TR/rdf-schema/#ch_list>.
resRdfList :: RDFLabel
resRdfList :: RDFLabel
resRdfList = ScopedName -> RDFLabel
Res ScopedName
rdfList

-- | @rdf:first@ from <http://www.w3.org/TR/rdf-schema/#ch_first>.
resRdfFirst :: RDFLabel
resRdfFirst :: RDFLabel
resRdfFirst = ScopedName -> RDFLabel
Res ScopedName
rdfFirst 

-- | @rdf:rest@ from <http://www.w3.org/TR/rdf-schema/#ch_rest>.
resRdfRest :: RDFLabel
resRdfRest :: RDFLabel
resRdfRest = ScopedName -> RDFLabel
Res ScopedName
rdfRest

-- | @rdf:nil@ from <http://www.w3.org/TR/rdf-schema/#ch_nil>.
resRdfNil :: RDFLabel
resRdfNil :: RDFLabel
resRdfNil = ScopedName -> RDFLabel
Res ScopedName
rdfNil

-- | @rdfs:member@ from <http://www.w3.org/TR/rdf-schema/#ch_member>.
resRdfsMember :: RDFLabel
resRdfsMember :: RDFLabel
resRdfsMember = ScopedName -> RDFLabel
Res ScopedName
rdfsMember

-- | @rdfd:GeneralRestriction@.
resRdfdGeneralRestriction :: RDFLabel
resRdfdGeneralRestriction :: RDFLabel
resRdfdGeneralRestriction = ScopedName -> RDFLabel
Res ScopedName
rdfdGeneralRestriction

-- | @rdfd:onProperties@.
resRdfdOnProperties :: RDFLabel
resRdfdOnProperties :: RDFLabel
resRdfdOnProperties       = ScopedName -> RDFLabel
Res ScopedName
rdfdOnProperties

-- | @rdfd:constraint@.
resRdfdConstraint :: RDFLabel
resRdfdConstraint :: RDFLabel
resRdfdConstraint         = ScopedName -> RDFLabel
Res ScopedName
rdfdConstraint

-- | @rdfd:maxCardinality@.
resRdfdMaxCardinality :: RDFLabel
resRdfdMaxCardinality :: RDFLabel
resRdfdMaxCardinality     = ScopedName -> RDFLabel
Res ScopedName
rdfdMaxCardinality

-- | @rdfs:seeAlso@ from <http://www.w3.org/TR/rdf-schema/#ch_seealso>.
resRdfsSeeAlso :: RDFLabel
resRdfsSeeAlso :: RDFLabel
resRdfsSeeAlso = ScopedName -> RDFLabel
Res ScopedName
rdfsSeeAlso

-- | @rdf:value@ from <http://www.w3.org/TR/rdf-schema/#ch_value>.
resRdfValue :: RDFLabel
resRdfValue :: RDFLabel
resRdfValue = ScopedName -> RDFLabel
Res ScopedName
rdfValue

-- | @owl:sameAs@.
resOwlSameAs :: RDFLabel
resOwlSameAs :: RDFLabel
resOwlSameAs = ScopedName -> RDFLabel
Res ScopedName
owlSameAs

-- | @log:implies@.
resLogImplies :: RDFLabel
resLogImplies :: RDFLabel
resLogImplies = ScopedName -> RDFLabel
Res ScopedName
logImplies

-- | @rdfs:label@ from <http://www.w3.org/TR/rdf-schema/#ch_label>.
resRdfsLabel :: RDFLabel
resRdfsLabel :: RDFLabel
resRdfsLabel = ScopedName -> RDFLabel
Res ScopedName
rdfsLabel

-- | @rdfs:comment@ from <http://www.w3.org/TR/rdf-schema/#ch_comment>.
resRdfsComment :: RDFLabel
resRdfsComment :: RDFLabel
resRdfsComment = ScopedName -> RDFLabel
Res ScopedName
rdfsComment

-- | @rdf:Property@ from <http://www.w3.org/TR/rdf-schema/#ch_property>.
resRdfProperty :: RDFLabel
resRdfProperty :: RDFLabel
resRdfProperty = ScopedName -> RDFLabel
Res ScopedName
rdfProperty

-- | @rdfs:subPropertyOf@ from <http://www.w3.org/TR/rdf-schema/#ch_subpropertyof>.
resRdfsSubPropertyOf :: RDFLabel
resRdfsSubPropertyOf :: RDFLabel
resRdfsSubPropertyOf = ScopedName -> RDFLabel
Res ScopedName
rdfsSubPropertyOf

-- | @rdfs:subClassOf@ from <http://www.w3.org/TR/rdf-schema/#ch_subclassof>.
resRdfsSubClassOf :: RDFLabel
resRdfsSubClassOf :: RDFLabel
resRdfsSubClassOf = ScopedName -> RDFLabel
Res ScopedName
rdfsSubClassOf

-- | @rdfs:Class@ from <http://www.w3.org/TR/rdf-schema/#ch_class>.
resRdfsClass :: RDFLabel
resRdfsClass :: RDFLabel
resRdfsClass = ScopedName -> RDFLabel
Res ScopedName
rdfsClass

-- | @rdfs:Literal@ from <http://www.w3.org/TR/rdf-schema/#ch_literal>.
resRdfsLiteral :: RDFLabel
resRdfsLiteral :: RDFLabel
resRdfsLiteral = ScopedName -> RDFLabel
Res ScopedName
rdfsLiteral

-- | @rdfs:Datatype@ from <http://www.w3.org/TR/rdf-schema/#ch_datatype>.
resRdfsDatatype :: RDFLabel
resRdfsDatatype :: RDFLabel
resRdfsDatatype = ScopedName -> RDFLabel
Res ScopedName
rdfsDatatype

-- | @rdf:XMLLiteral@ from <http://www.w3.org/TR/rdf-schema/#ch_xmlliteral>.
resRdfXMLLiteral :: RDFLabel
resRdfXMLLiteral :: RDFLabel
resRdfXMLLiteral = ScopedName -> RDFLabel
Res ScopedName
rdfXMLLiteral

-- | @rdfs:range@ from <http://www.w3.org/TR/rdf-schema/#ch_range>.
resRdfsRange :: RDFLabel
resRdfsRange :: RDFLabel
resRdfsRange = ScopedName -> RDFLabel
Res ScopedName
rdfsRange

-- | @rdfs:domain@ from <http://www.w3.org/TR/rdf-schema/#ch_domain>.
resRdfsDomain :: RDFLabel
resRdfsDomain :: RDFLabel
resRdfsDomain = ScopedName -> RDFLabel
Res ScopedName
rdfsDomain

-- | @rdfs:Container@ from <http://www.w3.org/TR/rdf-schema/#ch_container>.
resRdfsContainer :: RDFLabel
resRdfsContainer :: RDFLabel
resRdfsContainer = ScopedName -> RDFLabel
Res ScopedName
rdfsContainer

-- | @rdf:Bag@ from <http://www.w3.org/TR/rdf-schema/#ch_bag>.
resRdfBag :: RDFLabel
resRdfBag :: RDFLabel
resRdfBag = ScopedName -> RDFLabel
Res ScopedName
rdfBag

-- | @rdf:Seq@ from <http://www.w3.org/TR/rdf-schema/#ch_seq>.
resRdfSeq :: RDFLabel
resRdfSeq :: RDFLabel
resRdfSeq = ScopedName -> RDFLabel
Res ScopedName
rdfSeq

-- | @rdf:Alt@ from <http://www.w3.org/TR/rdf-schema/#ch_alt>.
resRdfAlt :: RDFLabel
resRdfAlt :: RDFLabel
resRdfAlt = ScopedName -> RDFLabel
Res ScopedName
rdfAlt

-- | @rdfs:ContainerMembershipProperty@ from <http://www.w3.org/TR/rdf-schema/#ch_containermembershipproperty>.
resRdfsContainerMembershipProperty :: RDFLabel
resRdfsContainerMembershipProperty :: RDFLabel
resRdfsContainerMembershipProperty = ScopedName -> RDFLabel
Res ScopedName
rdfsContainerMembershipProperty

-- | @rdfs:isDefinedBy@ from <http://www.w3.org/TR/rdf-schema/#ch_isdefinedby>.
resRdfsIsDefinedBy :: RDFLabel
resRdfsIsDefinedBy :: RDFLabel
resRdfsIsDefinedBy = ScopedName -> RDFLabel
Res ScopedName
rdfsIsDefinedBy

-- | @rdfs:Resource@ from <http://www.w3.org/TR/rdf-schema/#ch_resource>.
resRdfsResource :: RDFLabel
resRdfsResource :: RDFLabel
resRdfsResource = ScopedName -> RDFLabel
Res ScopedName
rdfsResource

-- | @rdf:Statement@ from <http://www.w3.org/TR/rdf-schema/#ch_statement>.
resRdfStatement :: RDFLabel
resRdfStatement :: RDFLabel
resRdfStatement = ScopedName -> RDFLabel
Res ScopedName
rdfStatement

-- | @rdf:subject@ from <http://www.w3.org/TR/rdf-schema/#ch_subject>.
resRdfSubject :: RDFLabel
resRdfSubject :: RDFLabel
resRdfSubject = ScopedName -> RDFLabel
Res ScopedName
rdfSubject

-- | @rdf:predicate@ from <http://www.w3.org/TR/rdf-schema/#ch_predicate>.
resRdfPredicate :: RDFLabel
resRdfPredicate :: RDFLabel
resRdfPredicate = ScopedName -> RDFLabel
Res ScopedName
rdfPredicate

-- | @rdf:object@ from <http://www.w3.org/TR/rdf-schema/#ch_object>.
resRdfObject :: RDFLabel
resRdfObject :: RDFLabel
resRdfObject = ScopedName -> RDFLabel
Res ScopedName
rdfObject

-- | @rdf:RDF@.
resRdfRDF :: RDFLabel
resRdfRDF :: RDFLabel
resRdfRDF = ScopedName -> RDFLabel
Res ScopedName
rdfRDF

-- | @rdf:Description@.
resRdfDescription :: RDFLabel
resRdfDescription :: RDFLabel
resRdfDescription = ScopedName -> RDFLabel
Res ScopedName
rdfDescription

-- | @rdf:ID@.
resRdfID :: RDFLabel
resRdfID :: RDFLabel
resRdfID = ScopedName -> RDFLabel
Res ScopedName
rdfID

-- | @rdf:about@.
resRdfAbout :: RDFLabel
resRdfAbout :: RDFLabel
resRdfAbout = ScopedName -> RDFLabel
Res ScopedName
rdfAbout

-- | @rdf:parseType@.
resRdfParseType :: RDFLabel
resRdfParseType :: RDFLabel
resRdfParseType = ScopedName -> RDFLabel
Res ScopedName
rdfParseType

-- | @rdf:resource@.
resRdfResource :: RDFLabel
resRdfResource :: RDFLabel
resRdfResource = ScopedName -> RDFLabel
Res ScopedName
rdfResource

-- | @rdf:li@.
resRdfLi :: RDFLabel
resRdfLi :: RDFLabel
resRdfLi = ScopedName -> RDFLabel
Res ScopedName
rdfLi

-- | @rdf:nodeID@.
resRdfNodeID :: RDFLabel
resRdfNodeID :: RDFLabel
resRdfNodeID = ScopedName -> RDFLabel
Res ScopedName
rdfNodeID

-- | @rdf:datatype@.
resRdfDatatype :: RDFLabel
resRdfDatatype :: RDFLabel
resRdfDatatype = ScopedName -> RDFLabel
Res ScopedName
rdfDatatype

-- | @rdf:_1@.
resRdf1 :: RDFLabel
resRdf1 :: RDFLabel
resRdf1 = ScopedName -> RDFLabel
Res ScopedName
rdf1

-- | @rdf:_2@.
resRdf2 :: RDFLabel
resRdf2 :: RDFLabel
resRdf2 = ScopedName -> RDFLabel
Res ScopedName
rdf2

-- | Create a @rdf:_n@ entity.
--
-- There is no check that the argument is not @0@.
resRdfn :: Word32 -> RDFLabel
resRdfn :: Word32 -> RDFLabel
resRdfn = ScopedName -> RDFLabel
Res forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> ScopedName
rdfn

---------------------------------------------------------
--  Additional functions on RDFLabel values
---------------------------------------------------------

-- |Test if supplied labal is a URI resource node
isUri :: RDFLabel -> Bool
isUri :: RDFLabel -> Bool
isUri (Res ScopedName
_) = Bool
True
isUri  RDFLabel
_      = Bool
False

-- |Test if supplied labal is a literal node
-- ('Lit', 'LangLit', or 'TypedLit').
isLiteral :: RDFLabel -> Bool
isLiteral :: RDFLabel -> Bool
isLiteral (Lit Text
_)        = Bool
True
isLiteral (LangLit Text
_ LanguageTag
_)  = Bool
True
isLiteral (TypedLit Text
_ ScopedName
_) = Bool
True
isLiteral  RDFLabel
_             = Bool
False

-- |Test if supplied labal is an untyped literal node (either
-- 'Lit' or 'LangLit').
isUntypedLiteral :: RDFLabel -> Bool
isUntypedLiteral :: RDFLabel -> Bool
isUntypedLiteral (Lit Text
_)       = Bool
True
isUntypedLiteral (LangLit Text
_ LanguageTag
_) = Bool
True
isUntypedLiteral  RDFLabel
_            = Bool
False

-- |Test if supplied labal is a typed literal node ('TypedLit').
isTypedLiteral :: RDFLabel -> Bool
isTypedLiteral :: RDFLabel -> Bool
isTypedLiteral (TypedLit Text
_ ScopedName
_) = Bool
True
isTypedLiteral  RDFLabel
_             = Bool
False

-- |Test if supplied labal is a XML literal node
isXMLLiteral :: RDFLabel -> Bool
isXMLLiteral :: RDFLabel -> Bool
isXMLLiteral = ScopedName -> RDFLabel -> Bool
isDatatyped ScopedName
rdfXMLLiteral

-- |Test if supplied label is a typed literal node of a given datatype
isDatatyped :: ScopedName -> RDFLabel -> Bool
isDatatyped :: ScopedName -> RDFLabel -> Bool
isDatatyped ScopedName
d  (TypedLit Text
_ ScopedName
dt) = ScopedName
d forall a. Eq a => a -> a -> Bool
== ScopedName
dt
isDatatyped ScopedName
_  RDFLabel
_               = Bool
False

-- |Test if supplied label is a container membership property
--
--  Check for namespace is RDF namespace and
--  first character of local name is '_' and
--  remaining characters of local name are all digits
isMemberProp :: RDFLabel -> Bool
isMemberProp :: RDFLabel -> Bool
isMemberProp (Res ScopedName
sn) =
  ScopedName -> Namespace
getScopeNamespace ScopedName
sn forall a. Eq a => a -> a -> Bool
== Namespace
namespaceRDF Bool -> Bool -> Bool
&&
  case Text -> Maybe (Char, Text)
T.uncons (LName -> Text
getLName (ScopedName -> LName
getScopeLocal ScopedName
sn)) of
    Just (Char
'_', Text
t) -> (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
t
    Maybe (Char, Text)
_ -> Bool
False
isMemberProp RDFLabel
_        = Bool
False

-- |Test if supplied labal is a blank node
isBlank :: RDFLabel -> Bool
isBlank :: RDFLabel -> Bool
isBlank (Blank [Char]
_) = Bool
True
isBlank  RDFLabel
_        = Bool
False

-- |Test if supplied labal is a query variable
isQueryVar :: RDFLabel -> Bool
isQueryVar :: RDFLabel -> Bool
isQueryVar (Var [Char]
_) = Bool
True
isQueryVar  RDFLabel
_      = Bool
False

-- |Extract text value from a literal node (including the
-- Language and Typed variants). The empty string is returned
-- for other nodes.
getLiteralText :: RDFLabel -> T.Text
getLiteralText :: RDFLabel -> Text
getLiteralText (Lit Text
s)        = Text
s
getLiteralText (LangLit Text
s LanguageTag
_)  = Text
s
getLiteralText (TypedLit Text
s ScopedName
_) = Text
s
getLiteralText  RDFLabel
_             = Text
""

-- |Extract the ScopedName value from a resource node ('nullScopedName'
-- is returned for non-resource nodes).
getScopedName :: RDFLabel -> ScopedName
getScopedName :: RDFLabel -> ScopedName
getScopedName (Res ScopedName
sn) = ScopedName
sn
getScopedName  RDFLabel
_       = ScopedName
nullScopedName

-- |Make a blank node from a supplied query variable,
--  or return the supplied label unchanged.
--  (Use this in when substituting an existential for an
--  unsubstituted query variable.)
makeBlank :: RDFLabel -> RDFLabel
makeBlank :: RDFLabel -> RDFLabel
makeBlank  (Var [Char]
loc)    = [Char] -> RDFLabel
Blank [Char]
loc
makeBlank  RDFLabel
lb           = RDFLabel
lb

-- | RDF Triple (statement)
-- 
--   At present there is no check or type-level
--   constraint that stops the subject or
--   predicate of the triple from being a literal.
--
type RDFTriple = Arc RDFLabel

-- | A set of RDF triples.
type RDFArcSet = ArcSet RDFLabel

-- | Convert 3 RDF labels to a RDF triple.
--
--   See also @Swish.RDF.GraphClass.arcFromTriple@.
toRDFTriple :: 
  (ToRDFLabel s, ToRDFLabel p, ToRDFLabel o) 
  => s -- ^ Subject 
  -> p -- ^ Predicate
  -> o -- ^ Object
  -> RDFTriple
toRDFTriple :: forall s p o.
(ToRDFLabel s, ToRDFLabel p, ToRDFLabel o) =>
s -> p -> o -> RDFTriple
toRDFTriple s
s p
p o
o = 
  forall lb. lb -> lb -> lb -> Arc lb
Arc (forall a. ToRDFLabel a => a -> RDFLabel
toRDFLabel s
s) (forall a. ToRDFLabel a => a -> RDFLabel
toRDFLabel p
p) (forall a. ToRDFLabel a => a -> RDFLabel
toRDFLabel o
o)

-- | Extract the contents of a RDF triple.
--
--   See also @Swish.RDF.GraphClass.arcToTriple@.
fromRDFTriple :: 
  (FromRDFLabel s, FromRDFLabel p, FromRDFLabel o) 
  => RDFTriple 
  -> Maybe (s, p, o) -- ^ The conversion only succeeds if all three
                     --   components can be converted to the correct
                     --   Haskell types.
fromRDFTriple :: forall s p o.
(FromRDFLabel s, FromRDFLabel p, FromRDFLabel o) =>
RDFTriple -> Maybe (s, p, o)
fromRDFTriple (Arc RDFLabel
s RDFLabel
p RDFLabel
o) = 
  (,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromRDFLabel a => RDFLabel -> Maybe a
fromRDFLabel RDFLabel
s forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromRDFLabel a => RDFLabel -> Maybe a
fromRDFLabel RDFLabel
p forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromRDFLabel a => RDFLabel -> Maybe a
fromRDFLabel RDFLabel
o
  
-- | Namespace prefix list entry

-- | A map for name spaces (key is the prefix).
type NamespaceMap = M.Map (Maybe T.Text) URI -- TODO: should val be URI or namespace?

-- | Create an empty namespace map.
emptyNamespaceMap :: NamespaceMap
emptyNamespaceMap :: NamespaceMap
emptyNamespaceMap = forall k a. Map k a
M.empty

-- | Graph formula entry

data LookupFormula lb gr = Formula
    { forall lb gr. LookupFormula lb gr -> lb
formLabel :: lb -- ^ The label for the formula
    , forall lb gr. LookupFormula lb gr -> gr
formGraph :: gr -- ^ The contents of the formula
    }

instance (Eq lb, Eq gr) => Eq (LookupFormula lb gr) where
    LookupFormula lb gr
f1 == :: LookupFormula lb gr -> LookupFormula lb gr -> Bool
== LookupFormula lb gr
f2 = forall lb gr. LookupFormula lb gr -> lb
formLabel LookupFormula lb gr
f1 forall a. Eq a => a -> a -> Bool
== forall lb gr. LookupFormula lb gr -> lb
formLabel LookupFormula lb gr
f2 Bool -> Bool -> Bool
&&
               forall lb gr. LookupFormula lb gr -> gr
formGraph LookupFormula lb gr
f1 forall a. Eq a => a -> a -> Bool
== forall lb gr. LookupFormula lb gr -> gr
formGraph LookupFormula lb gr
f2

instance (Ord lb, Ord gr) => Ord (LookupFormula lb gr) where
    (Formula lb
a1 gr
b1) compare :: LookupFormula lb gr -> LookupFormula lb gr -> Ordering
`compare` (Formula lb
a2 gr
b2) =
        (lb
a1,gr
b1) forall a. Ord a => a -> a -> Ordering
`compare` (lb
a2,gr
b2)

-- | A named formula.
type Formula lb = LookupFormula lb (NSGraph lb)

instance (Label lb) => Show (Formula lb)
    where
        show :: Formula lb -> [Char]
show (Formula lb
l NSGraph lb
g) = forall a. Show a => a -> [Char]
show lb
l forall a. [a] -> [a] -> [a]
++ [Char]
" :- { " forall a. [a] -> [a] -> [a]
++ forall lb. Label lb => [Char] -> NSGraph lb -> [Char]
showArcs [Char]
"    " NSGraph lb
g forall a. [a] -> [a] -> [a]
++ [Char]
" }"

-- | A map for named formulae.
type FormulaMap lb = M.Map lb (NSGraph lb)

-- | Create an empty formula map.
emptyFormulaMap :: FormulaMap RDFLabel
emptyFormulaMap :: FormulaMap RDFLabel
emptyFormulaMap = forall k a. Map k a
M.empty

-- fmapFormulaMap :: (Ord a, Ord b) => (a -> b) -> FormulaMap a -> FormulaMap b
fmapFormulaMap :: (Ord a) => (a -> a) -> FormulaMap a -> FormulaMap a
fmapFormulaMap :: forall a. Ord a => (a -> a) -> FormulaMap a -> FormulaMap a
fmapFormulaMap a -> a
f FormulaMap a
m = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (a -> a
f forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall lb. Ord lb => (lb -> lb) -> NSGraph lb -> NSGraph lb
fmapNSGraph a -> a
f) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.assocs FormulaMap a
m

-- TODO: how to traverse formulamaps now?

{-
traverseFormulaMap :: 
    (Applicative f, Ord a, Ord b) 
    => (a -> f b) -> FormulaMap a -> f (FormulaMap b)
-}
traverseFormulaMap :: 
    (Applicative f, Ord a) 
    => (a -> f a) -> FormulaMap a -> f (FormulaMap a)
traverseFormulaMap :: forall (f :: * -> *) a.
(Applicative f, Ord a) =>
(a -> f a) -> FormulaMap a -> f (FormulaMap a)
traverseFormulaMap a -> f a
f = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Traversable.traverse (forall (f :: * -> *) a.
(Applicative f, Ord a) =>
(a -> f a) -> NSGraph a -> f (NSGraph a)
traverseFormula a -> f a
f)

{-
traverseFormula :: 
    (Applicative f, Ord a, Ord b)
    => (a -> f b) -> Formula a -> f (Formula b)
-}
{-
traverseFormula :: 
    (Applicative f, Ord a)
    => (a -> f a) -> Formula a -> f (Formula a)
traverseFormula f (Formula k gr) = Formula <$> f k <*> traverseNSGraph f gr
-}

traverseFormula ::
    (Applicative f, Ord a)
    => (a -> f a) -> NSGraph a -> f (NSGraph a)

{-
traverseFormula ::
    (Applicative f, Ord a, Ord b)
    => (a -> f b) -> NSGraph a -> f (NSGraph b)
-}

traverseFormula :: forall (f :: * -> *) a.
(Applicative f, Ord a) =>
(a -> f a) -> NSGraph a -> f (NSGraph a)
traverseFormula = forall (f :: * -> *) a.
(Applicative f, Ord a) =>
(a -> f a) -> NSGraph a -> f (NSGraph a)
traverseNSGraph

{-
formulaeMapM ::
    (Monad m) => (lb -> m l2) -> FormulaMap lb -> m (FormulaMap l2)
formulaeMapM f = T.mapM (formulaEntryMapM f)

formulaEntryMapM ::
    (Monad m)
    => (lb -> m l2)
    -> Formula lb
    -> m (Formula l2)
formulaEntryMapM f (Formula k gr) =
  Formula `liftM` f k `ap` T.mapM f gr
    
-}

{-|

Memory-based graph with namespaces and subgraphs.

The primary means for adding arcs to an existing graph
are: 

 - `setArcs` from the `LDGraph` instance, which replaces the 
    existing set of arcs and does not change the namespace 
    map.

 - `addArc` which checks that the arc is unknown before
    adding it but does not change the namespace map or
    re-label any blank nodes in the arc.

-}
data NSGraph lb = NSGraph
    { forall lb. NSGraph lb -> NamespaceMap
namespaces :: NamespaceMap      -- ^ the namespaces to use
    , forall lb. NSGraph lb -> FormulaMap lb
formulae   :: FormulaMap lb     -- ^ any associated formulae 
                                      --   (a.k.a. sub- or named- graps)
    , forall lb. NSGraph lb -> ArcSet lb
statements :: ArcSet lb         -- ^ the statements in the graph
    }

instance LDGraph NSGraph lb where
    emptyGraph :: NSGraph lb
emptyGraph   = forall lb. NamespaceMap -> FormulaMap lb -> ArcSet lb -> NSGraph lb
NSGraph NamespaceMap
emptyNamespaceMap forall k a. Map k a
M.empty forall a. Set a
S.empty
    getArcs :: NSGraph lb -> ArcSet lb
getArcs      = forall lb. NSGraph lb -> ArcSet lb
statements 
    setArcs :: NSGraph lb -> ArcSet lb -> NSGraph lb
setArcs NSGraph lb
g ArcSet lb
as = NSGraph lb
g { statements :: ArcSet lb
statements=ArcSet lb
as }

-- | The '<>' operation uses 'merge' rather than 'addGraphs'.
instance (Label lb) => Semigroup (NSGraph lb) where
    <> :: NSGraph lb -> NSGraph lb -> NSGraph lb
(<>) = forall lb. Label lb => NSGraph lb -> NSGraph lb -> NSGraph lb
merge

-- | The 'mappend' operation uses the Semigroup instance
--   (so 'merge' rather than 'addGraphs').
instance (Label lb) => Monoid (NSGraph lb) where
    mempty :: NSGraph lb
mempty  = forall (lg :: * -> *) lb. LDGraph lg lb => lg lb
emptyGraph
#if !(MIN_VERSION_base(4, 11, 0))
    mappend = (<>)
#endif

-- fmapNSGraph :: (Ord lb1, Ord lb2) => (lb1 -> lb2) -> NSGraph lb1 -> NSGraph lb2
  
-- | 'fmap' for 'NSGraph' instances.
fmapNSGraph :: (Ord lb) => (lb -> lb) -> NSGraph lb -> NSGraph lb
fmapNSGraph :: forall lb. Ord lb => (lb -> lb) -> NSGraph lb -> NSGraph lb
fmapNSGraph lb -> lb
f (NSGraph NamespaceMap
ns FormulaMap lb
fml ArcSet lb
stmts) = 
    forall lb. NamespaceMap -> FormulaMap lb -> ArcSet lb -> NSGraph lb
NSGraph NamespaceMap
ns (forall a. Ord a => (a -> a) -> FormulaMap a -> FormulaMap a
fmapFormulaMap lb -> lb
f FormulaMap lb
fml) ((forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap lb -> lb
f) ArcSet lb
stmts)

{-
traverseNSGraph :: 
    (Applicative f, Ord a, Ord b) 
    => (a -> f b) -> NSGraph a -> f (NSGraph b)
-}

-- | 'Data.Traversable.traverse' for 'NSGraph' instances.
traverseNSGraph :: 
    (Applicative f, Ord a) 
    => (a -> f a) -> NSGraph a -> f (NSGraph a)
traverseNSGraph :: forall (f :: * -> *) a.
(Applicative f, Ord a) =>
(a -> f a) -> NSGraph a -> f (NSGraph a)
traverseNSGraph a -> f a
f (NSGraph NamespaceMap
ns FormulaMap a
fml ArcSet a
stmts) = 
    forall lb. NamespaceMap -> FormulaMap lb -> ArcSet lb -> NSGraph lb
NSGraph NamespaceMap
ns forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a.
(Applicative f, Ord a) =>
(a -> f a) -> FormulaMap a -> f (FormulaMap a)
traverseFormulaMap a -> f a
f FormulaMap a
fml forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) b a.
(Applicative f, Ord b) =>
(a -> f b) -> Set a -> f (Set b)
traverseSet forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Traversable.traverse a -> f a
f) ArcSet a
stmts

traverseSet ::
    (Applicative f, Ord b)
    => (a -> f b) -> S.Set a -> f (S.Set b)
traverseSet :: forall (f :: * -> *) b a.
(Applicative f, Ord b) =>
(a -> f b) -> Set a -> f (Set b)
traverseSet a -> f b
f = forall a b. (a -> b -> b) -> b -> Set a -> b
S.foldr a -> f (Set b) -> f (Set b)
cons (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Set a
S.empty)
    where
      cons :: a -> f (Set b) -> f (Set b)
cons a
x f (Set b)
s = forall a. Ord a => a -> Set a -> Set a
S.insert forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (Set b)
s

instance (Label lb) => Eq (NSGraph lb) where
    == :: NSGraph lb -> NSGraph lb -> Bool
(==) = forall lb. Label lb => NSGraph lb -> NSGraph lb -> Bool
grEq

-- The namespaces are not used in the ordering since this could
-- lead to identical graphs not being considered the same when
-- ordering.
--
instance (Label lb) => Ord (NSGraph lb) where
    (NSGraph NamespaceMap
_ FormulaMap lb
fml1 ArcSet lb
stmts1) compare :: NSGraph lb -> NSGraph lb -> Ordering
`compare` (NSGraph NamespaceMap
_ FormulaMap lb
fml2 ArcSet lb
stmts2) =
        (FormulaMap lb
fml1,ArcSet lb
stmts1) forall a. Ord a => a -> a -> Ordering
`compare` (FormulaMap lb
fml2,ArcSet lb
stmts2)

instance (Label lb) => Show (NSGraph lb) where
    show :: NSGraph lb -> [Char]
show     = forall lb. Label lb => [Char] -> NSGraph lb -> [Char]
grShow [Char]
""
    showList :: [NSGraph lb] -> ShowS
showList = forall lb. Label lb => [Char] -> [NSGraph lb] -> ShowS
grShowList [Char]
""

-- | Retrieve the namespace map in the graph.
getNamespaces :: NSGraph lb -> NamespaceMap
getNamespaces :: forall lb. NSGraph lb -> NamespaceMap
getNamespaces = forall lb. NSGraph lb -> NamespaceMap
namespaces

-- | Replace the namespace information in the graph.
setNamespaces      :: NamespaceMap -> NSGraph lb -> NSGraph lb
setNamespaces :: forall lb. NamespaceMap -> NSGraph lb -> NSGraph lb
setNamespaces NamespaceMap
ns NSGraph lb
g = NSGraph lb
g { namespaces :: NamespaceMap
namespaces=NamespaceMap
ns }

-- | Retrieve the formulae in the graph.
getFormulae :: NSGraph lb -> FormulaMap lb
getFormulae :: forall lb. NSGraph lb -> FormulaMap lb
getFormulae = forall lb. NSGraph lb -> FormulaMap lb
formulae

-- | Replace the formulae in the graph.
setFormulae      :: FormulaMap lb -> NSGraph lb -> NSGraph lb
setFormulae :: forall lb. FormulaMap lb -> NSGraph lb -> NSGraph lb
setFormulae FormulaMap lb
fs NSGraph lb
g = NSGraph lb
g { formulae :: FormulaMap lb
formulae=FormulaMap lb
fs }

-- | Find a formula in the graph, if it exists.
getFormula     :: (Label lb) => NSGraph lb -> lb -> Maybe (NSGraph lb)
-- getFormula g l = fmap formGraph $ M.lookup l (formulae g)
getFormula :: forall lb. Label lb => NSGraph lb -> lb -> Maybe (NSGraph lb)
getFormula NSGraph lb
g lb
l = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup lb
l (forall lb. NSGraph lb -> FormulaMap lb
formulae NSGraph lb
g)

-- | Add (or replace) a formula.
setFormula     :: (Label lb) => Formula lb -> NSGraph lb -> NSGraph lb
-- setFormula f g = g { formulae = M.insert (formLabel f) f (formulae g) }
setFormula :: forall lb. Label lb => Formula lb -> NSGraph lb -> NSGraph lb
setFormula (Formula lb
fn NSGraph lb
fg) NSGraph lb
g = NSGraph lb
g { formulae :: FormulaMap lb
formulae = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert lb
fn NSGraph lb
fg (forall lb. NSGraph lb -> FormulaMap lb
formulae NSGraph lb
g) }

{-|
Add an arc to the graph. It does not relabel any blank nodes in the input arc,
nor does it change the namespace map, 
but it does ensure that the arc is unknown before adding it.
-}
addArc :: (Label lb) => Arc lb -> NSGraph lb -> NSGraph lb
addArc :: forall lb. Label lb => Arc lb -> NSGraph lb -> NSGraph lb
addArc Arc lb
ar = forall (lg :: * -> *) lb.
LDGraph lg lb =>
(ArcSet lb -> ArcSet lb) -> lg lb -> lg lb
update (forall a. Ord a => a -> Set a -> Set a
S.insert Arc lb
ar)

grShowList :: (Label lb) => String -> [NSGraph lb] -> String -> String
grShowList :: forall lb. Label lb => [Char] -> [NSGraph lb] -> ShowS
grShowList [Char]
_ []     = [Char] -> ShowS
showString [Char]
"[no graphs]"
grShowList [Char]
p (NSGraph lb
g:[NSGraph lb]
gs) = Char -> ShowS
showChar Char
'[' forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString (forall lb. Label lb => [Char] -> NSGraph lb -> [Char]
grShow [Char]
pp NSGraph lb
g) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall lb. Label lb => [NSGraph lb] -> ShowS
showl [NSGraph lb]
gs
    where
        showl :: [NSGraph lb] -> ShowS
showl []     = Char -> ShowS
showChar Char
']' -- showString $ "\n" ++ p ++ "]"
        showl (NSGraph lb
h:[NSGraph lb]
hs) = [Char] -> ShowS
showString ([Char]
",\n " forall a. [a] -> [a] -> [a]
++ [Char]
p forall a. [a] -> [a] -> [a]
++ forall lb. Label lb => [Char] -> NSGraph lb -> [Char]
grShow [Char]
pp NSGraph lb
h) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NSGraph lb] -> ShowS
showl [NSGraph lb]
hs
        pp :: [Char]
pp           = Char
' 'forall a. a -> [a] -> [a]
:[Char]
p

grShow   :: (Label lb) => String -> NSGraph lb -> String
grShow :: forall lb. Label lb => [Char] -> NSGraph lb -> [Char]
grShow [Char]
p NSGraph lb
g =
    [Char]
"Graph, formulae: " forall a. [a] -> [a] -> [a]
++ [Char]
showForm forall a. [a] -> [a] -> [a]
++ [Char]
"\n" forall a. [a] -> [a] -> [a]
++
    [Char]
p forall a. [a] -> [a] -> [a]
++ [Char]
"arcs: " forall a. [a] -> [a] -> [a]
++ forall lb. Label lb => [Char] -> NSGraph lb -> [Char]
showArcs [Char]
p NSGraph lb
g
    where
        showForm :: [Char]
showForm = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (([Char]
pp forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) [LookupFormula lb (NSGraph lb)]
fml
        fml :: [LookupFormula lb (NSGraph lb)]
fml = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall lb gr. lb -> gr -> LookupFormula lb gr
Formula) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.assocs (forall lb. NSGraph lb -> FormulaMap lb
getFormulae NSGraph lb
g) -- NOTE: want to just show 'name :- graph'
        pp :: [Char]
pp = [Char]
"\n    " forall a. [a] -> [a] -> [a]
++ [Char]
p

showArcs :: (Label lb) => String -> NSGraph lb -> String
showArcs :: forall lb. Label lb => [Char] -> NSGraph lb -> [Char]
showArcs [Char]
p NSGraph lb
g = forall a b. (a -> b -> b) -> b -> Set a -> b
S.foldr (forall a. [a] -> [a] -> [a]
(++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
pp forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) [Char]
"" (forall (lg :: * -> *) lb. LDGraph lg lb => lg lb -> ArcSet lb
getArcs NSGraph lb
g)
    where
        pp :: [Char]
pp = [Char]
"\n    " forall a. [a] -> [a] -> [a]
++ [Char]
p

-- | Graph equality.
grEq :: (Label lb) => NSGraph lb -> NSGraph lb -> Bool
grEq :: forall lb. Label lb => NSGraph lb -> NSGraph lb -> Bool
grEq NSGraph lb
g1 = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall lb.
Label lb =>
NSGraph lb -> NSGraph lb -> (Bool, LabelMap (ScopedLabel lb))
grMatchMap NSGraph lb
g1

-- | Match graphs, returning `True` if they are equivalent,
-- with a map of labels to equivalence class identifiers
-- (see 'graphMatch' for further details).
grMatchMap :: (Label lb) =>
    NSGraph lb -> NSGraph lb -> (Bool, LabelMap (ScopedLabel lb))
grMatchMap :: forall lb.
Label lb =>
NSGraph lb -> NSGraph lb -> (Bool, LabelMap (ScopedLabel lb))
grMatchMap NSGraph lb
g1 NSGraph lb
g2 =
    forall lb.
Label lb =>
(lb -> lb -> Bool)
-> ArcSet lb -> ArcSet lb -> (Bool, LabelMap (ScopedLabel lb))
graphMatch lb -> lb -> Bool
matchable (forall (lg :: * -> *) lb. LDGraph lg lb => lg lb -> ArcSet lb
getArcs NSGraph lb
g1) (forall (lg :: * -> *) lb. LDGraph lg lb => lg lb -> ArcSet lb
getArcs NSGraph lb
g2)
    where
        matchable :: lb -> lb -> Bool
matchable lb
l1 lb
l2 = forall {k}. Ord k => NSGraph k -> k -> Maybe (NSGraph k)
mapFormula NSGraph lb
g1 lb
l1 forall a. Eq a => a -> a -> Bool
== forall {k}. Ord k => NSGraph k -> k -> Maybe (NSGraph k)
mapFormula NSGraph lb
g2 lb
l2
        -- hmmm, if we compare the formula, rather then graph,
        -- a lot of tests fail (when the formulae are named by blank
        -- nodes). Presumably because the quality check for Formula forces
        -- the label to be identical, which it needn't be with bnodes
        -- for the match to hold.
        -- mapFormula g l  = M.lookup l (getFormulae g)
        -- mapFormula g l  = fmap formGraph $ M.lookup l (getFormulae g)
        -- the above discussion is hopefully moot now storing graph directly
        mapFormula :: NSGraph k -> k -> Maybe (NSGraph k)
mapFormula NSGraph k
g k
l  = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
l (forall lb. NSGraph lb -> FormulaMap lb
getFormulae NSGraph k
g)

-- |Merge RDF graphs, renaming blank and query variable nodes as
--  needed to neep variable nodes from the two graphs distinct in
--  the resulting graph.
--        
--  Currently formulae are not guaranteed to be preserved across a
--  merge.
--        
merge :: (Label lb) => NSGraph lb -> NSGraph lb -> NSGraph lb
merge :: forall lb. Label lb => NSGraph lb -> NSGraph lb -> NSGraph lb
merge NSGraph lb
gr1 NSGraph lb
gr2 =
    let bn1 :: [lb]
bn1   = forall a. Set a -> [a]
S.toList forall a b. (a -> b) -> a -> b
$ forall lb. Label lb => (lb -> Bool) -> NSGraph lb -> Set lb
allLabels forall lb. Label lb => lb -> Bool
labelIsVar NSGraph lb
gr1
        bn2 :: [lb]
bn2   = forall a. Set a -> [a]
S.toList forall a b. (a -> b) -> a -> b
$ forall lb. Label lb => (lb -> Bool) -> NSGraph lb -> Set lb
allLabels forall lb. Label lb => lb -> Bool
labelIsVar NSGraph lb
gr2
        dupbn :: [lb]
dupbn = forall a. Eq a => [a] -> [a] -> [a]
intersect [lb]
bn1 [lb]
bn2
        allbn :: [lb]
allbn = forall a. Eq a => [a] -> [a] -> [a]
union [lb]
bn1 [lb]
bn2
    in forall (lg :: * -> *) lb.
(LDGraph lg lb, Ord lb) =>
lg lb -> lg lb -> lg lb
addGraphs NSGraph lb
gr1 (forall lb.
Label lb =>
[lb] -> [lb] -> (lb -> lb) -> NSGraph lb -> NSGraph lb
remapLabels [lb]
dupbn [lb]
allbn forall a. a -> a
id NSGraph lb
gr2)

-- |Return list of all labels (including properties) in the graph
--  satisfying a supplied filter predicate. This routine
--  includes the labels in any formulae.
allLabels :: (Label lb) => (lb -> Bool) -> NSGraph lb -> S.Set lb
allLabels :: forall lb. Label lb => (lb -> Bool) -> NSGraph lb -> Set lb
allLabels lb -> Bool
p NSGraph lb
gr = forall a. (a -> Bool) -> Set a -> Set a
S.filter lb -> Bool
p (forall lb. Label lb => (lb -> Bool) -> Set lb -> Set lb -> Set lb
unionNodes lb -> Bool
p (forall lb. Label lb => (lb -> Bool) -> NSGraph lb -> Set lb
formulaNodes lb -> Bool
p NSGraph lb
gr) (forall (lg :: * -> *) lb.
(LDGraph lg lb, Ord lb) =>
lg lb -> Set lb
labels NSGraph lb
gr) ) 
                 
{- TODO: is the leading 'filter p' needed in allLabels?
-}

-- |Return list of all subjects and objects in the graph
--  satisfying a supplied filter predicate.
allNodes :: (Label lb) => (lb -> Bool) -> NSGraph lb -> S.Set lb
allNodes :: forall lb. Label lb => (lb -> Bool) -> NSGraph lb -> Set lb
allNodes lb -> Bool
p = forall lb. Label lb => (lb -> Bool) -> Set lb -> Set lb -> Set lb
unionNodes lb -> Bool
p forall a. Set a
S.empty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (lg :: * -> *) lb.
(LDGraph lg lb, Ord lb) =>
lg lb -> Set lb
nodes

-- | List all nodes in graph formulae satisfying a supplied predicate
formulaNodes :: (Label lb) => (lb -> Bool) -> NSGraph lb -> S.Set lb
formulaNodes :: forall lb. Label lb => (lb -> Bool) -> NSGraph lb -> Set lb
formulaNodes lb -> Bool
p NSGraph lb
gr = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall lb. Label lb => (lb -> Bool) -> Set lb -> Set lb -> Set lb
unionNodes lb -> Bool
p) Set lb
fkeys (forall a b. (a -> b) -> [a] -> [b]
map (forall lb. Label lb => (lb -> Bool) -> NSGraph lb -> Set lb
allLabels lb -> Bool
p) [NSGraph lb]
fvals)
    where
        fm :: FormulaMap lb
fm    = forall lb. NSGraph lb -> FormulaMap lb
formulae NSGraph lb
gr
        -- fvals = map formGraph $ M.elems fm
        fvals :: [NSGraph lb]
fvals = forall k a. Map k a -> [a]
M.elems FormulaMap lb
fm
        -- TODO: can this conversion be improved?
        fkeys :: Set lb
fkeys = forall a. (a -> Bool) -> Set a -> Set a
S.filter lb -> Bool
p forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [k]
M.keys FormulaMap lb
fm

-- | Helper to filter variable nodes and merge with those found so far
unionNodes :: (Label lb) => (lb -> Bool) -> S.Set lb -> S.Set lb -> S.Set lb
unionNodes :: forall lb. Label lb => (lb -> Bool) -> Set lb -> Set lb -> Set lb
unionNodes lb -> Bool
p Set lb
ls1 Set lb
ls2 = Set lb
ls1 forall a. Ord a => Set a -> Set a -> Set a
`S.union` forall a. (a -> Bool) -> Set a -> Set a
S.filter lb -> Bool
p Set lb
ls2

-- TODO: use S.Set lb rather than [lb] in the following

-- |Remap selected nodes in graph.
--
--  This is the node renaming operation that prevents graph-scoped
--  variable nodes from being merged when two graphs are merged.
remapLabels ::
    (Label lb)
    => [lb] -- ^ variable nodes to be renamed (@dupbn@)
    -> [lb] -- ^ variable nodes used that must be avoided (@allbn@)
    -> (lb -> lb) -- ^ node conversion function that is applied to nodes
    -- from @dupbn@ in the graph that are to be replaced by
    -- new blank nodes.  If no such conversion is required,
    -- supply @id@.  The function 'makeBlank' can be used to convert
    -- RDF query nodes into RDF blank nodes.
    -> NSGraph lb -- ^ graph in which nodes are to be renamed
    -> NSGraph lb

remapLabels :: forall lb.
Label lb =>
[lb] -> [lb] -> (lb -> lb) -> NSGraph lb -> NSGraph lb
remapLabels [lb]
dupbn [lb]
allbn lb -> lb
cnvbn =
    forall lb. Ord lb => (lb -> lb) -> NSGraph lb -> NSGraph lb
fmapNSGraph (forall lb. Label lb => [lb] -> [lb] -> (lb -> lb) -> lb -> lb
mapnode [lb]
dupbn [lb]
allbn lb -> lb
cnvbn)

-- |Externally callable function to construct a list of (old,new)
--  values to be used for graph label remapping.
--
remapLabelList ::
    (Label lb)
    => [lb] -- ^ labels to be remaped
    -> [lb] -- ^ labels to be avoided by the remapping
    -> [(lb,lb)]
remapLabelList :: forall lb. Label lb => [lb] -> [lb] -> [(lb, lb)]
remapLabelList [lb]
remap [lb]
avoid = forall lb.
Label lb =>
[lb] -> [lb] -> (lb -> lb) -> [(lb, lb)] -> [(lb, lb)]
maplist [lb]
remap [lb]
avoid forall a. a -> a
id []

-- | Remap a single graph node.
--
--  If the node is not one of those to be remapped,
--  the supplied value is returned unchanged.
mapnode ::
    (Label lb) => [lb] -> [lb] -> (lb -> lb) -> lb -> lb
mapnode :: forall lb. Label lb => [lb] -> [lb] -> (lb -> lb) -> lb -> lb
mapnode [lb]
dupbn [lb]
allbn lb -> lb
cnvbn lb
nv =
    forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault lb
nv lb
nv forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall lb.
Label lb =>
[lb] -> [lb] -> (lb -> lb) -> [(lb, lb)] -> [(lb, lb)]
maplist [lb]
dupbn [lb]
allbn lb -> lb
cnvbn []

-- | Construct a list of (oldnode,newnode) values to be used for
--  graph label remapping.  The function operates recursively, adding
--  new nodes generated to the accumulator and also to the
--  list of nodes to be avoided.
maplist ::
    (Label lb) 
    => [lb]       -- ^ oldnode values
    -> [lb]       -- ^ nodes to be avoided
    -> (lb -> lb) 
    -> [(lb,lb)]  -- ^ accumulator
    -> [(lb,lb)]
maplist :: forall lb.
Label lb =>
[lb] -> [lb] -> (lb -> lb) -> [(lb, lb)] -> [(lb, lb)]
maplist []         [lb]
_     lb -> lb
_     [(lb, lb)]
mapbn = [(lb, lb)]
mapbn
maplist (lb
dn:[lb]
dupbn) [lb]
allbn lb -> lb
cnvbn [(lb, lb)]
mapbn = forall lb.
Label lb =>
[lb] -> [lb] -> (lb -> lb) -> [(lb, lb)] -> [(lb, lb)]
maplist [lb]
dupbn [lb]
allbn' lb -> lb
cnvbn [(lb, lb)]
mapbn'
    where
        dnmap :: lb
dnmap  = forall lb. Label lb => lb -> [lb] -> lb
newNode (lb -> lb
cnvbn lb
dn) [lb]
allbn
        mapbn' :: [(lb, lb)]
mapbn' = (lb
dn,lb
dnmap)forall a. a -> [a] -> [a]
:[(lb, lb)]
mapbn
        allbn' :: [lb]
allbn' = lb
dnmapforall a. a -> [a] -> [a]
:[lb]
allbn

--  TODO: optimize this for common case @nnn@ and @_nnn@:
--    always generate @_nnn@ and keep track of last allocated
--

-- |Given a node and a list of existing nodes, find a new node for
--  the supplied node that does not clash with any existing node.
--  (Generates an non-terminating list of possible replacements, and
--  picks the first one that isn't already in use.)
--
newNode :: (Label lb) => lb -> [lb] -> lb
newNode :: forall lb. Label lb => lb -> [lb] -> lb
newNode lb
dn [lb]
existnodes =
    forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall lb. Label lb => lb -> [lb] -> [lb]
newNodes lb
dn [lb]
existnodes

-- |Given a node and a list of existing nodes, generate a list of new
--  nodes for the supplied node that do not clash with any existing node.
newNodes :: (Label lb) => lb -> [lb] -> [lb]
newNodes :: forall lb. Label lb => lb -> [lb] -> [lb]
newNodes lb
dn [lb]
existnodes =
    forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [lb]
existnodes)) forall a b. (a -> b) -> a -> b
$ forall lb. Label lb => ([Char], Word32) -> [lb]
trynodes (forall lb. Label lb => lb -> ([Char], Word32)
noderootindex lb
dn)

{- 

For now go with a 32-bit integer (since Int on my machine uses 32-bit
values). We could instead use a Whole class constraint from
Numeric.Natural (in semigroups), but it is probably better to
specialize here. The idea for using Word<X> rather than Int is to
make it obvious that we are only interested in values >= 0.

-}

noderootindex :: (Label lb) => lb -> (String, Word32)
noderootindex :: forall lb. Label lb => lb -> ([Char], Word32)
noderootindex lb
dn = ([Char]
nh,Word32
nx) where
    ([Char]
nh,[Char]
nt) = [Char] -> ([Char], [Char])
splitnodeid forall a b. (a -> b) -> a -> b
$ forall lb. Label lb => lb -> [Char]
getLocal lb
dn
    nx :: Word32
nx      = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
nt then Word32
0 else forall a. Read a => [Char] -> a
read [Char]
nt

splitnodeid :: String -> (String,String)
splitnodeid :: [Char] -> ([Char], [Char])
splitnodeid = forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isDigit

trynodes :: (Label lb) => (String, Word32) -> [lb]
trynodes :: forall lb. Label lb => ([Char], Word32) -> [lb]
trynodes ([Char]
nr,Word32
nx) = [ forall lb. Label lb => [Char] -> lb
makeLabel ([Char]
nr forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Word32
n) | Word32
n <- forall a. (a -> a) -> a -> [a]
iterate (forall a. Num a => a -> a -> a
+ Word32
1) Word32
nx ]

{-
trybnodes :: (Label lb) => (String,Int) -> [lb]
trybnodes (nr,nx) = [ makeLabel (nr++show n) | n <- iterate (+1) nx ]
-}

-- | Memory-based RDF graph type

type RDFGraph = NSGraph RDFLabel

-- |Create a new RDF graph from a supplied set of arcs.
--
-- This version will attempt to fill up the namespace map
-- of the graph based on the input labels (including datatypes
-- on literals). For faster
-- creation of a graph you can use:
--
-- > emptyRDFGraph { statements = arcs }
--
-- which is how this routine was defined in version @0.3.1.1@
-- and earlier.
--
toRDFGraph :: 
    RDFArcSet
    -> RDFGraph
toRDFGraph :: RDFArcSet -> RDFGraph
toRDFGraph RDFArcSet
arcs = 
  let lbls :: Set RDFLabel
lbls = forall b a. Ord b => (a -> [b]) -> Set a -> Set b
getComponents forall lb. Arc lb -> [lb]
arcLabels RDFArcSet
arcs
      
      getNS :: RDFLabel -> Maybe ScopedName
getNS (Res ScopedName
s) = forall a. a -> Maybe a
Just ScopedName
s
      getNS (TypedLit Text
_ ScopedName
dt) = forall a. a -> Maybe a
Just ScopedName
dt
      getNS RDFLabel
_ = forall a. Maybe a
Nothing

      ns :: [Namespace]
ns = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ScopedName -> Namespace
getScopeNamespace forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDFLabel -> Maybe ScopedName
getNS) forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
S.toList Set RDFLabel
lbls
      nsmap :: NamespaceMap
nsmap = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
              (\NamespaceMap
m Namespace
ins -> let (Maybe Text
p,URI
u) = Namespace -> (Maybe Text, URI)
getNamespaceTuple Namespace
ins
                         in forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith (forall a b. a -> b -> a
const forall a. a -> a
id) Maybe Text
p URI
u NamespaceMap
m)
              NamespaceMap
emptyNamespaceMap [Namespace]
ns
  
  in forall a. Monoid a => a
mempty { namespaces :: NamespaceMap
namespaces = NamespaceMap
nsmap, statements :: RDFArcSet
statements = RDFArcSet
arcs }

-- |Create a new, empty RDF graph (it is just 'mempty').
--
emptyRDFGraph :: RDFGraph
emptyRDFGraph :: RDFGraph
emptyRDFGraph = forall a. Monoid a => a
mempty 

{-
-- |Update an RDF graph using a supplied list of arcs, keeping
--  prefix definitions and formula definitions from the original.
--
--  [[[TODO:  I think this may be redundant - the default graph
--  class has an update method which accepts a function to update
--  the arcs, not touching other parts of the graph value.]]]
updateRDFGraph :: RDFGraph -> [RDFTriple] -> RDFGraph
updateRDFGraph gr as = gr { statements=as }
-}

--------------------------------------------------------------------------------
--
--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,
--    2011, 2012, 2013, 2014, 2015, 2016, 2018, 2020, 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
--
--------------------------------------------------------------------------------