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

--------------------------------------------------------------------------------
--  See end of this file for licence information.
--------------------------------------------------------------------------------
-- |
--  Module      :  Ruleset
--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin,
--                 2011, 2012, 2014, 2016 Douglas Burke
--  License     :  GPL V2
--
--  Maintainer  :  Douglas Burke
--  Stability   :  experimental
--  Portability :  CPP, OverloadedStrings
--
--  This module defines some datatypes and functions that are
--  used to define rules and rulesets over RDF graphs.
--
--  For the routines that accept a graph in N3 format, the following
--  namespaces are pre-defined for use by the graph:
--     @rdf:@ and @rdfs:@.
--
--------------------------------------------------------------------------------

module Swish.RDF.Ruleset
    (
     -- * Data types for RDF Ruleset
     RDFFormula, RDFRule, RDFRuleMap
    , RDFClosure, RDFRuleset, RDFRulesetMap
    , nullRDFFormula
    , GraphClosure(..), makeGraphClosureRule
    , makeRDFGraphFromN3Builder
    , makeRDFFormula
    , makeRDFClosureRule
      -- * Create rules using Notation3 statements
    , makeN3ClosureRule
    , makeN3ClosureSimpleRule
    , makeN3ClosureModifyRule
    , makeN3ClosureAllocatorRule
    , makeNodeAllocTo
      -- * Debugging
    , graphClosureFwdApply, graphClosureBwdApply
    )
where

import Swish.Namespace (Namespace, ScopedName)
import Swish.Namespace (makeNSScopedName, namespaceToBuilder)
import Swish.QName (LName)
import Swish.Rule (Formula(..), Rule(..), RuleMap)
import Swish.Rule (fwdCheckInference, nullSN)
import Swish.Ruleset (Ruleset(..), RulesetMap)
import Swish.GraphClass (Label(..), ArcSet, LDGraph(..))
import Swish.VarBinding (VarBindingModify(..))
import Swish.VarBinding (makeVarBinding, applyVarBinding, joinVarBindings, vbmCompose, varBindingId)

import Swish.RDF.Query
    ( rdfQueryFind
    , rdfQueryBack, rdfQueryBackModify
    , rdfQuerySubs
    , rdfQuerySubsBlank
    )

import Swish.RDF.Graph
    ( RDFLabel(..), RDFGraph, RDFArcSet
    , makeBlank, newNodes
    , merge, allLabels
    , toRDFGraph)

import Swish.RDF.VarBinding (RDFVarBinding, RDFVarBindingModify)
import Swish.RDF.Parser.N3 (parseN3)

import Swish.RDF.Vocabulary (swishName, namespaceRDF, namespaceRDFS)

import Swish.Utils.ListHelpers (flist)

import Data.List (nub)
import Data.Maybe (fromMaybe)

#if (!defined(__GLASGOW_HASKELL__)) || (__GLASGOW_HASKELL__ < 710)
import Data.Monoid (Monoid(..))
#endif

import qualified Data.Set as S
import qualified Data.Text.Lazy.Builder as B

------------------------------------------------------------
--  Datatypes for RDF ruleset
------------------------------------------------------------

-- | A named formula expressed as a RDF Graph.
type RDFFormula     = Formula RDFGraph

-- | A named inference rule expressed in RDF.
type RDFRule        = Rule RDFGraph

-- | A map for 'RDFRule' rules.
type RDFRuleMap     = RuleMap RDFGraph

-- | A 'GraphClosure' for RDF statements.
type RDFClosure     = GraphClosure RDFLabel

-- | A 'Ruleset' for RDF.
type RDFRuleset     = Ruleset RDFGraph

-- | A map for 'RDFRuleset'.
type RDFRulesetMap  = RulesetMap RDFGraph

------------------------------------------------------------
--  Declare null RDF formula
------------------------------------------------------------

-- | The null RDF formula.
nullRDFFormula :: Formula RDFGraph
nullRDFFormula :: Formula RDFGraph
nullRDFFormula = Formula
    { formName :: ScopedName
formName = LName -> ScopedName
nullSN LName
"nullRDFGraph"
    , formExpr :: RDFGraph
formExpr = forall a. Monoid a => a
mempty
    }

------------------------------------------------------------
--  Datatype for graph closure rule
------------------------------------------------------------

-- |Datatype for constructing a graph closure rule
data GraphClosure lb = GraphClosure
    { forall lb. GraphClosure lb -> ScopedName
nameGraphRule :: ScopedName   -- ^ Name of rule for proof display
    , forall lb. GraphClosure lb -> ArcSet lb
ruleAnt       :: ArcSet lb    -- ^ Antecedent triples pattern
                                    --   (may include variable nodes)
    , forall lb. GraphClosure lb -> ArcSet lb
ruleCon       :: ArcSet lb    -- ^ Consequent triples pattern
                                    --   (may include variable nodes)
    , forall lb. GraphClosure lb -> VarBindingModify lb lb
ruleModify    :: VarBindingModify lb lb
                                    -- ^ Structure that defines additional
                                    --   constraints and/or variable
                                    --   bindings based on other matched
                                    --   query variables.  Matching the
                                    --   antecedents.  Use 'varBindingId' if
                                    --   no additional variable constraints
                                    --   or bindings are added beyond those
                                    --   arising from graph queries.
    }

-- | Equality is based on the closure rule, anrecedents and
--   consequents.
instance (Label lb) => Eq (GraphClosure lb) where
    GraphClosure lb
c1 == :: GraphClosure lb -> GraphClosure lb -> Bool
== GraphClosure lb
c2 = forall lb. GraphClosure lb -> ScopedName
nameGraphRule GraphClosure lb
c1 forall a. Eq a => a -> a -> Bool
== forall lb. GraphClosure lb -> ScopedName
nameGraphRule GraphClosure lb
c2 Bool -> Bool -> Bool
&&
               forall lb. GraphClosure lb -> ArcSet lb
ruleAnt GraphClosure lb
c1 forall a. Eq a => a -> a -> Bool
== forall lb. GraphClosure lb -> ArcSet lb
ruleAnt GraphClosure lb
c2 Bool -> Bool -> Bool
&&
               forall lb. GraphClosure lb -> ArcSet lb
ruleCon GraphClosure lb
c1 forall a. Eq a => a -> a -> Bool
== forall lb. GraphClosure lb -> ArcSet lb
ruleCon GraphClosure lb
c2

instance Show (GraphClosure lb) where
    show :: GraphClosure lb -> String
show GraphClosure lb
c = String
"GraphClosure " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall lb. GraphClosure lb -> ScopedName
nameGraphRule GraphClosure lb
c)

------------------------------------------------------------
--  Define inference rule based on RDF graph closure rule
------------------------------------------------------------

-- |Define a value of type Rule based on an RDFClosure value.
makeGraphClosureRule :: GraphClosure RDFLabel -> Rule RDFGraph
makeGraphClosureRule :: GraphClosure RDFLabel -> Rule RDFGraph
makeGraphClosureRule GraphClosure RDFLabel
grc = Rule RDFGraph
newrule
    where
        newrule :: Rule RDFGraph
newrule = Rule
            { ruleName :: ScopedName
ruleName       = forall lb. GraphClosure lb -> ScopedName
nameGraphRule GraphClosure RDFLabel
grc
            , fwdApply :: [RDFGraph] -> [RDFGraph]
fwdApply       = GraphClosure RDFLabel -> [RDFGraph] -> [RDFGraph]
graphClosureFwdApply GraphClosure RDFLabel
grc
            , bwdApply :: RDFGraph -> [[RDFGraph]]
bwdApply       = GraphClosure RDFLabel -> RDFGraph -> [[RDFGraph]]
graphClosureBwdApply GraphClosure RDFLabel
grc
            , checkInference :: [RDFGraph] -> RDFGraph -> Bool
checkInference = forall ex. Eq ex => Rule ex -> [ex] -> ex -> Bool
fwdCheckInference Rule RDFGraph
newrule
            }

-- | Forward chaining function based on RDF graph closure description
--
--  Note:  antecedents here are presumed to share bnodes.
--
graphClosureFwdApply :: 
  GraphClosure RDFLabel 
  -> [RDFGraph] 
  -> [RDFGraph]
graphClosureFwdApply :: GraphClosure RDFLabel -> [RDFGraph] -> [RDFGraph]
graphClosureFwdApply GraphClosure RDFLabel
grc [RDFGraph]
grs =
    let gr :: RDFGraph
gr   = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RDFGraph]
grs then forall a. Monoid a => a
mempty else forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 forall (lg :: * -> *) lb.
(LDGraph lg lb, Ord lb) =>
lg lb -> lg lb -> lg lb
addGraphs [RDFGraph]
grs
        vars :: [RDFVarBinding]
vars = RDFArcSet -> RDFGraph -> [RDFVarBinding]
queryFind (forall lb. GraphClosure lb -> ArcSet lb
ruleAnt GraphClosure RDFLabel
grc) RDFGraph
gr
        varm :: [RDFVarBinding]
varm = forall a b.
VarBindingModify a b -> [VarBinding a b] -> [VarBinding a b]
vbmApply (forall lb. GraphClosure lb -> VarBindingModify lb lb
ruleModify GraphClosure RDFLabel
grc) [RDFVarBinding]
vars
        cons :: [RDFGraph]
cons = [RDFVarBinding] -> RDFArcSet -> [RDFGraph]
querySubs [RDFVarBinding]
varm (forall lb. GraphClosure lb -> ArcSet lb
ruleCon GraphClosure RDFLabel
grc)
    in
        {-
        seq cons $
        seq (trace "\ngraphClosureFwdApply") $
        seq (traceShow "\nvars: " vars) $
        seq (traceShow "\nvarm: " varm) $
        seq (traceShow "\ncons: " cons) $
        seq (trace "\n") $
        -}
        --  Return null list or single result graph that is the union
        --  (not merge) of individual results:
        if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RDFGraph]
cons then [] else [forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 forall (lg :: * -> *) lb.
(LDGraph lg lb, Ord lb) =>
lg lb -> lg lb -> lg lb
addGraphs [RDFGraph]
cons]
        -- cons {- don't merge results -}

-- | Backward chaining function based on RDF graph closure description
graphClosureBwdApply :: GraphClosure RDFLabel -> RDFGraph -> [[RDFGraph]]
graphClosureBwdApply :: GraphClosure RDFLabel -> RDFGraph -> [[RDFGraph]]
graphClosureBwdApply GraphClosure RDFLabel
grc RDFGraph
gr =
    let vars :: [[RDFVarBinding]]
vars = forall a b.
VarBindingModify a b -> [[VarBinding a b]] -> [[VarBinding a b]]
rdfQueryBackModify (forall lb. GraphClosure lb -> VarBindingModify lb lb
ruleModify GraphClosure RDFLabel
grc) forall a b. (a -> b) -> a -> b
$
               RDFArcSet -> RDFGraph -> [[RDFVarBinding]]
queryBack (forall lb. GraphClosure lb -> ArcSet lb
ruleCon GraphClosure RDFLabel
grc) RDFGraph
gr
        --  This next function eliminates duplicate variable bindings.
        --  It is strictly redundant, but comparing variable
        --  bindings is much cheaper than comparing graphs.
        --  I don't know if many duplicate graphs will be result
        --  of exact duplicate variable bindings, so this may be
        --  not very effective.
        varn :: [[RDFVarBinding]]
varn = forall a b. (a -> b) -> [a] -> [b]
map forall a. Eq a => [a] -> [a]
nub [[RDFVarBinding]]
vars
    in
        --  The 'nub ante' below eliminates duplicate antecedent graphs,
        --  based on graph matching, which tests for equivalence under
        --  bnode renaming, with a view to reducing redundant arcs in
        --  the merged antecedent graph, hence less to prove in
        --  subsequent back-chaining steps.
        --
        --  Each antecedent is reduced to a single RDF graph, when
        --  bwdApply specifies a list of expressions corresponding to
        --  each antecedent.
        [ [forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 forall lb. Label lb => NSGraph lb -> NSGraph lb -> NSGraph lb
merge (forall a. Eq a => [a] -> [a]
nub [RDFGraph]
ante)]
          | [RDFVarBinding]
vs <- [[RDFVarBinding]]
varn
          , let ante :: [RDFGraph]
ante = [RDFVarBinding] -> RDFArcSet -> [RDFGraph]
querySubsBlank [RDFVarBinding]
vs (forall lb. GraphClosure lb -> ArcSet lb
ruleAnt GraphClosure RDFLabel
grc) ]

------------------------------------------------------------
--  RDF graph query and substitution support functions
------------------------------------------------------------

queryFind :: RDFArcSet -> RDFGraph -> [RDFVarBinding]
queryFind :: RDFArcSet -> RDFGraph -> [RDFVarBinding]
queryFind RDFArcSet
qas = RDFGraph -> RDFGraph -> [RDFVarBinding]
rdfQueryFind (RDFArcSet -> RDFGraph
toRDFGraph RDFArcSet
qas)

queryBack :: RDFArcSet -> RDFGraph -> [[RDFVarBinding]]
queryBack :: RDFArcSet -> RDFGraph -> [[RDFVarBinding]]
queryBack RDFArcSet
qas = RDFGraph -> RDFGraph -> [[RDFVarBinding]]
rdfQueryBack (RDFArcSet -> RDFGraph
toRDFGraph RDFArcSet
qas)

querySubs :: [RDFVarBinding] -> RDFArcSet -> [RDFGraph]
querySubs :: [RDFVarBinding] -> RDFArcSet -> [RDFGraph]
querySubs [RDFVarBinding]
vars = [RDFVarBinding] -> RDFGraph -> [RDFGraph]
rdfQuerySubs [RDFVarBinding]
vars forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDFArcSet -> RDFGraph
toRDFGraph

querySubsBlank :: [RDFVarBinding] -> RDFArcSet -> [RDFGraph]
querySubsBlank :: [RDFVarBinding] -> RDFArcSet -> [RDFGraph]
querySubsBlank [RDFVarBinding]
vars = [RDFVarBinding] -> RDFGraph -> [RDFGraph]
rdfQuerySubsBlank [RDFVarBinding]
vars forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDFArcSet -> RDFGraph
toRDFGraph

------------------------------------------------------------
--  Method for creating an RDF formula value from N3 text
------------------------------------------------------------

mkPrefix :: Namespace -> B.Builder
mkPrefix :: Namespace -> Builder
mkPrefix = Namespace -> Builder
namespaceToBuilder

prefixRDF :: B.Builder
prefixRDF :: Builder
prefixRDF = 
  forall a. Monoid a => [a] -> a
mconcat 
  [ Namespace -> Builder
mkPrefix Namespace
namespaceRDF
  , Namespace -> Builder
mkPrefix Namespace
namespaceRDFS
    ]

-- |Helper function to parse a string containing Notation3
--  and return the corresponding RDFGraph value.
--
makeRDFGraphFromN3Builder :: B.Builder -> RDFGraph
makeRDFGraphFromN3Builder :: Builder -> RDFGraph
makeRDFGraphFromN3Builder Builder
b = 
  let t :: Text
t = Builder -> Text
B.toLazyText (Builder
prefixRDF forall a. Monoid a => a -> a -> a
`mappend` Builder
b)
  in case Text -> Maybe QName -> ParseResult
parseN3 Text
t forall a. Maybe a
Nothing of
    Left  String
msg -> forall a. HasCallStack => String -> a
error String
msg
    Right RDFGraph
gr  -> RDFGraph
gr

-- |Create an RDF formula.
makeRDFFormula ::
    Namespace     -- ^ namespace to which the formula is allocated
    -> LName      -- ^ local name for the formula in the namespace
    -> B.Builder  -- ^ graph in Notation 3 format
    -> RDFFormula
makeRDFFormula :: Namespace -> LName -> Builder -> Formula RDFGraph
makeRDFFormula Namespace
scope LName
local Builder
gr = 
  Formula
    { formName :: ScopedName
formName = Namespace -> LName -> ScopedName
makeNSScopedName Namespace
scope LName
local
    , formExpr :: RDFGraph
formExpr = Builder -> RDFGraph
makeRDFGraphFromN3Builder Builder
gr
    }

------------------------------------------------------------
--  Create an RDF closure rule from supplied graphs
------------------------------------------------------------

-- |Constructs an RDF graph closure rule.  That is, a rule that
--  given some set of antecedent statements returns new statements
--  that may be added to the graph.
--
makeRDFClosureRule ::
    ScopedName -- ^ scoped name for the new rule
    -> [RDFGraph] -- ^ RDFGraphs that are the entecedent of the rule.
                  --
                  -- (Note:  bnodes and variable names are assumed to be shared
                  -- by all the entecedent graphs supplied.  /is this right?/)
    -> RDFGraph   -- ^ the consequent graph
    -> RDFVarBindingModify -- ^ is a variable binding modifier value that may impose
    --          additional conditions on the variable bindings that
    --          can be used for this inference rule, or which may
    --          cause new values to be allocated for unbound variables.
    --          These modifiers allow for certain inference patterns
    --          that are not captured by simple "closure rules", such
    --          as the allocation of bnodes corresponding to literals,
    --          and are an extension point for incorporating datatypes
    --          into an inference process.
    --
    --          If no additional constraints or variable bindings are
    --          to be applied, use value 'varBindingId'
    --
    -> RDFRule
makeRDFClosureRule :: ScopedName
-> [RDFGraph] -> RDFGraph -> RDFVarBindingModify -> Rule RDFGraph
makeRDFClosureRule ScopedName
sname [RDFGraph]
antgrs RDFGraph
congr RDFVarBindingModify
vmod = GraphClosure RDFLabel -> Rule RDFGraph
makeGraphClosureRule
    GraphClosure
        { nameGraphRule :: ScopedName
nameGraphRule = ScopedName
sname
        , ruleAnt :: RDFArcSet
ruleAnt       = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall (lg :: * -> *) lb. LDGraph lg lb => lg lb -> ArcSet lb
getArcs [RDFGraph]
antgrs
        , ruleCon :: RDFArcSet
ruleCon       = forall (lg :: * -> *) lb. LDGraph lg lb => lg lb -> ArcSet lb
getArcs RDFGraph
congr
        , ruleModify :: RDFVarBindingModify
ruleModify    = RDFVarBindingModify
vmod
        }

------------------------------------------------------------
--  Methods to create an RDF closure rule from N3 input
------------------------------------------------------------
--
--  These functions are used internally by Swish to construct
--  rules from textual descriptions.

-- |Constructs an RDF graph closure rule.  That is, a rule that
--  given some set of antecedent statements returns new statements
--  that may be added to the graph.  This is the basis for
--  implementation of most of the inference rules given in the
--  RDF formal semantics document.
--
makeN3ClosureRule ::
    Namespace -- ^ namespace to which the rule is allocated
    -> LName  -- ^ local name for the rule in the namespace
    -> B.Builder 
    -- ^ the Notation3 representation
    --   of the antecedent graph.  (Note: multiple antecedents
    --   can be handled by combining multiple graphs.)
    -> B.Builder -- ^ the Notation3 representation of the consequent graph.
    -> RDFVarBindingModify
    -- ^ a variable binding modifier value that may impose
    --   additional conditions on the variable bindings that
    --   can be used for this inference rule, or which may
    --   cause new values to be allocated for unbound variables.
    --   These modifiers allow for certain inference patterns
    --   that are not captured by simple closure rules, such
    --   as the allocation of bnodes corresponding to literals,
    --   and are an extension point for incorporating datatypes
    --   into an inference process.
    --
    --   If no additional constraints or variable bindings are
    --   to be applied, use a value of 'varBindingId', or use
    --   'makeN3ClosureSimpleRule'.
    -> RDFRule
makeN3ClosureRule :: Namespace
-> LName
-> Builder
-> Builder
-> RDFVarBindingModify
-> Rule RDFGraph
makeN3ClosureRule Namespace
scope LName
local Builder
ant Builder
con =
    ScopedName
-> [RDFGraph] -> RDFGraph -> RDFVarBindingModify -> Rule RDFGraph
makeRDFClosureRule (Namespace -> LName -> ScopedName
makeNSScopedName Namespace
scope LName
local) [RDFGraph
antgr] RDFGraph
congr
    where
        antgr :: RDFGraph
antgr = Builder -> RDFGraph
makeRDFGraphFromN3Builder Builder
ant
        congr :: RDFGraph
congr = Builder -> RDFGraph
makeRDFGraphFromN3Builder Builder
con

-- |Construct a simple RDF graph closure rule without
--  additional node allocations or variable binding constraints.
--
makeN3ClosureSimpleRule ::
    Namespace -- ^ namespace to which the rule is allocated
    -> LName  -- ^ local name for the rule in the namepace
    -> B.Builder
    -- ^ the Notation3 representation
    --   of the antecedent graph.  (Note: multiple antecedents
    --   can be handled by combining multiple graphs.)
    -> B.Builder  -- ^ the Notation3 representation of the consequent graph.
    -> RDFRule
makeN3ClosureSimpleRule :: Namespace -> LName -> Builder -> Builder -> Rule RDFGraph
makeN3ClosureSimpleRule Namespace
scope LName
local Builder
ant Builder
con =
    Namespace
-> LName
-> Builder
-> Builder
-> RDFVarBindingModify
-> Rule RDFGraph
makeN3ClosureRule Namespace
scope LName
local Builder
ant Builder
con forall a b. VarBindingModify a b
varBindingId

-- |Constructs an RDF graph closure rule that incorporates
--  a variable binding filter and a variable binding modifier.
--
makeN3ClosureModifyRule ::
    Namespace -- ^ namespace to which the rule is allocated
    -> LName  -- ^ local name for the rule in the given namespace
    -> B.Builder -- ^ the Notation3 representation
    --                of the antecedent graph.  (Note: multiple antecedents
    --                can be handled by combining multiple graphs.)
    -> B.Builder -- ^ the Notation3 representation of the consequent graph.
    -> RDFVarBindingModify
    -- ^ a variable binding modifier value that may impose
    --   additional conditions on the variable bindings that
    --   can be used for this inference rule (@vflt@).
    --
    --   These modifiers allow for certain inference patterns
    --   that are not captured by simple closure rules, such
    --   as deductions that pertain only to certain kinds of
    --   nodes in a graph.
    -> RDFVarBindingModify
    -- ^ a variable binding modifier that is applied to the
    --   variable bindings obtained, typically to create some
    --   additional variable bindings.  This is applied before
    --   the preceeding filter rule (@vflt@).
    -> RDFRule
makeN3ClosureModifyRule :: Namespace
-> LName
-> Builder
-> Builder
-> RDFVarBindingModify
-> RDFVarBindingModify
-> Rule RDFGraph
makeN3ClosureModifyRule Namespace
scope LName
local Builder
ant Builder
con RDFVarBindingModify
vflt RDFVarBindingModify
vmod =
    Namespace
-> LName
-> Builder
-> Builder
-> RDFVarBindingModify
-> Rule RDFGraph
makeN3ClosureRule Namespace
scope LName
local Builder
ant Builder
con RDFVarBindingModify
modc
    where
        modc :: RDFVarBindingModify
modc  = forall a. a -> Maybe a -> a
fromMaybe forall a b. VarBindingModify a b
varBindingId forall a b. (a -> b) -> a -> b
$ forall a b.
Eq a =>
VarBindingModify a b
-> VarBindingModify a b -> Maybe (VarBindingModify a b)
vbmCompose RDFVarBindingModify
vmod RDFVarBindingModify
vflt

{-
    makeRDFClosureRule (ScopedName scope local) [antgr] congr modc
    where
        antgr = makeRDFGraphFromN3String ant
        congr = makeRDFGraphFromN3String con
        modc  = case vbmCompose vmod vflt of
            Just x  -> x
            Nothing -> varBindingId
-}

-- |Construct an RDF graph closure rule with a bnode allocator.
--
--  This function is rather like 'makeN3ClosureModifyRule', except that
--  the variable binding modifier is a function from the variables in
--  the variables and bnodes contained in the antecedent graph.
--
makeN3ClosureAllocatorRule ::
    Namespace -- ^ namespace to which the rule is allocated
    -> LName  -- ^ local name for the rule in the given namespace
    -> B.Builder -- ^ the Notation3 representation
    --                of the antecedent graph.  (Note: multiple antecedents
    --                can be handled by combining multiple graphs.)
    -> B.Builder -- ^ the Notation3 representation of the consequent graph.
    -> RDFVarBindingModify
    -- ^ variable binding modifier value that may impose
    --   additional conditions on the variable bindings that
    --   can be used for this inference rule (@vflt@).
    -> ( [RDFLabel] -> RDFVarBindingModify )
    -- ^ function applied to a list of nodes to yield a
    --   variable binding modifier value.
    --
    --   The supplied parameter is applied to a list of all of
    --   the variable nodes (including all blank nodes) in the
    --   antecedent graph, and then composed with the @vflt@
    --   value.  This allows any node allocation
    --   function to avoid allocating any blank nodes that
    --   are already used in the antecedent graph.
    --   (See 'makeNodeAllocTo').
    -> RDFRule
makeN3ClosureAllocatorRule :: Namespace
-> LName
-> Builder
-> Builder
-> RDFVarBindingModify
-> ([RDFLabel] -> RDFVarBindingModify)
-> Rule RDFGraph
makeN3ClosureAllocatorRule Namespace
scope LName
local Builder
ant Builder
con RDFVarBindingModify
vflt [RDFLabel] -> RDFVarBindingModify
aloc =
    ScopedName
-> [RDFGraph] -> RDFGraph -> RDFVarBindingModify -> Rule RDFGraph
makeRDFClosureRule (Namespace -> LName -> ScopedName
makeNSScopedName Namespace
scope LName
local) [RDFGraph
antgr] RDFGraph
congr RDFVarBindingModify
modc
    where
        antgr :: RDFGraph
antgr = Builder -> RDFGraph
makeRDFGraphFromN3Builder Builder
ant
        congr :: RDFGraph
congr = Builder -> RDFGraph
makeRDFGraphFromN3Builder Builder
con
        vmod :: RDFVarBindingModify
vmod  = [RDFLabel] -> RDFVarBindingModify
aloc forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
S.toList (forall lb. Label lb => (lb -> Bool) -> NSGraph lb -> Set lb
allLabels forall lb. Label lb => lb -> Bool
labelIsVar RDFGraph
antgr)
        modc :: RDFVarBindingModify
modc  = forall a. a -> Maybe a -> a
fromMaybe forall a b. VarBindingModify a b
varBindingId forall a b. (a -> b) -> a -> b
$ forall a b.
Eq a =>
VarBindingModify a b
-> VarBindingModify a b -> Maybe (VarBindingModify a b)
vbmCompose RDFVarBindingModify
vmod RDFVarBindingModify
vflt

------------------------------------------------------------
--  Query binding modifier for "allocated to" logic
------------------------------------------------------------

-- |This function defines a variable binding modifier that
--  allocates a new blank node for each value bound to
--  a query variable, and binds it to another variable
--  in each query binding.
--
--  This provides a single binding for query variables that would
--  otherwise be unbound by a query.  For example, consider the
--  inference pattern:
--        
--  >  ?a hasUncle ?c => ?a hasFather ?b . ?b hasBrother ?c .
--        
--  For a given @?a@ and @?c@, there is insufficient information
--  here to instantiate a value for variable @?b@.  Using this
--  function as part of a graph instance closure rule allows
--  forward chaining to allocate a single bnode for each
--  occurrence of @?a@, so that given:
--        
--  >  Jimmy hasUncle Fred .
--  >  Jimmy hasUncle Bob .
--
--  leads to exactly one bnode inference of:
--
--  >  Jimmy hasFather _:f .
--
--  giving:
--
--  >  Jimmy hasFather _:f .
--  >  _:f   hasBrother Fred .
--  >  _:f   hasBrother Bob .
--
--  rather than:
--
--  >  Jimmy hasFather _:f1 .
--  >  _:f1  hasBrother Fred .
--  >  Jimmy hasFather _:f2 .
--  >  _:f2  hasBrother Bob .
--
--  This form of constrained allocation of bnodes is also required for
--  some of the inference patterns described by the RDF formal semantics,
--  particularly those where bnodes are substituted for URIs or literals.
--
makeNodeAllocTo ::
    RDFLabel      -- ^ variable node to which a new blank node is bound
    -> RDFLabel   -- ^ variable which is bound in each query to a graph
                  --  node to which new blank nodes are allocated.
    -> [RDFLabel]
    -> RDFVarBindingModify
makeNodeAllocTo :: RDFLabel -> RDFLabel -> [RDFLabel] -> RDFVarBindingModify
makeNodeAllocTo RDFLabel
bindvar RDFLabel
alocvar [RDFLabel]
exbnode = VarBindingModify
        { vbmName :: ScopedName
vbmName   = LName -> ScopedName
swishName LName
"makeNodeAllocTo"
        , vbmApply :: [RDFVarBinding] -> [RDFVarBinding]
vbmApply  = RDFLabel
-> RDFLabel -> [RDFLabel] -> [RDFVarBinding] -> [RDFVarBinding]
applyNodeAllocTo RDFLabel
bindvar RDFLabel
alocvar [RDFLabel]
exbnode
        , vbmVocab :: [RDFLabel]
vbmVocab  = [RDFLabel
alocvar,RDFLabel
bindvar]
        , vbmUsage :: [[RDFLabel]]
vbmUsage  = [[RDFLabel
bindvar]]
        }

--  Auxiliary function that performs the node allocation defined
--  by makeNodeAllocTo.
--
--  bindvar is a variable node to which a new blank node is bound
--  alocvar is a variable which is bound in each query to a graph
--          node to which new blank nodes are allocated.
--  exbnode is a list of existing blank nodes, to be avoided by
--          the new blank node allocator.
--  vars    is a list of variable bindings to which new bnode
--          allocations for the indicated bindvar are to be added.
--
applyNodeAllocTo ::
    RDFLabel -> RDFLabel -> [RDFLabel] -> [RDFVarBinding] -> [RDFVarBinding]
applyNodeAllocTo :: RDFLabel
-> RDFLabel -> [RDFLabel] -> [RDFVarBinding] -> [RDFVarBinding]
applyNodeAllocTo RDFLabel
bindvar RDFLabel
alocvar [RDFLabel]
exbnode [RDFVarBinding]
vars =
    let
        app :: VarBinding a a -> a -> a
app       = forall a. VarBinding a a -> a -> a
applyVarBinding
        alocnodes :: [(RDFLabel, RDFLabel)]
alocnodes = forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a b. [a -> b] -> a -> [b]
flist (forall a b. (a -> b) -> [a] -> [b]
map forall a. VarBinding a a -> a -> a
app [RDFVarBinding]
vars) RDFLabel
alocvar)
                        (forall lb. Label lb => lb -> [lb] -> [lb]
newNodes (RDFLabel -> RDFLabel
makeBlank RDFLabel
bindvar) [RDFLabel]
exbnode)
        newvb :: RDFVarBinding -> RDFVarBinding
newvb RDFVarBinding
var = forall a b.
(Ord a, Ord b) =>
VarBinding a b -> VarBinding a b -> VarBinding a b
joinVarBindings
            ( forall a b. (Ord a, Ord b) => [(a, b)] -> VarBinding a b
makeVarBinding forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head
              [ [(RDFLabel
bindvar,RDFLabel
b)] | (RDFLabel
v,RDFLabel
b) <- [(RDFLabel, RDFLabel)]
alocnodes, forall a. VarBinding a a -> a -> a
app RDFVarBinding
var RDFLabel
alocvar forall a. Eq a => a -> a -> Bool
== RDFLabel
v ] )
            RDFVarBinding
var
    in
        forall a b. (a -> b) -> [a] -> [b]
map RDFVarBinding -> RDFVarBinding
newvb [RDFVarBinding]
vars


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