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

--------------------------------------------------------------------------------
--  See end of this file for licence information.
--------------------------------------------------------------------------------
{- |
Module      :  Script
Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012, 2014, 2018, 2020, 2024 Douglas Burke
License     :  GPL V2

Maintainer  :  Douglas Burke
Stability   :  experimental
Portability :  CPP, OverloadedStrings

This module implements the Swish script processor:  it parses a script
from a supplied string, and returns a list of Swish state transformer
functions whose effect, when applied to a state value, is to implement
the supplied script.

-}

module Swish.Script
    ( 
      -- * Syntax
      -- $syntax
      
      -- ** Defining a prefix
      -- $prefixLine
      
      -- ** Naming a graph
      -- $nameItem
      
      -- ** Reading and writing graphs
      
      -- $readGraph
      
      -- $writeGraph
      
      -- ** Merging graphs
      -- $mergeGraphs
      
      -- ** Comparing graphs
      
      -- $compareGraphs
      
      -- $assertEquiv
      
      -- $assertMember
      
      -- ** Defining rules
      
      -- $defineRule
      
      -- $defineRuleset
      
      -- $defineConstraints
      
      -- ** Apply a rule
      -- $fwdChain
      
      -- $bwdChain
      
      -- ** Define a proof
      -- $proof
      
      -- * An example script
      -- $exampleScript
      
      -- * Parsing
      
      parseScriptFromText 
    )
where

import Swish.Datatype (typeMkRules)
import Swish.Monad ( SwishStateIO, SwishStatus(..))
import Swish.Monad (modGraphs, findGraph, findFormula
                   , modRules, findRule
                   , modRulesets, findRuleset
                   , findOpenVarModify, findDatatype
                   , setInfo, setError, setStatus)
import Swish.Proof (explainProof, showsProof)
import Swish.Rule (Formula(..), Rule(..)) 
import Swish.Ruleset (makeRuleset, getRulesetRule, getRulesetNamespace, getMaybeContextRule)
import Swish.VarBinding (composeSequence)

import Swish.RDF.Datatype (RDFDatatype)

import Swish.RDF.Ruleset (RDFFormula, RDFRule, RDFRuleset)
import Swish.RDF.Ruleset (makeRDFClosureRule)
import Swish.RDF.Proof (RDFProofStep)
import Swish.RDF.Proof (makeRDFProof, makeRDFProofStep)
import Swish.RDF.VarBinding (RDFVarBindingModify)

import Swish.RDF.GraphShowLines ()

import Swish.RDF.Graph
    ( RDFGraph, RDFLabel(..)
    , NamespaceMap
    , setNamespaces
    , merge, addGraphs
    )

import Swish.RDF.Parser.Utils (whiteSpace, lexeme, symbol, eoln, manyTill)

import Swish.RDF.Parser.N3
    ( parseAnyfromText
    , parseN3      
    , N3Parser, N3State(..)
    , getPrefix
    , subgraph
    , n3symbol -- was uriRef2,
    , quickVariable -- was varid
    , lexUriRef
    , newBlankNode
    )

import Swish.Namespace (ScopedName, getScopeNamespace)
import Swish.QName (QName, qnameFromURI)

import Swish.RDF.Formatter.N3 (formatGraphAsBuilder)

import Swish.Utils.ListHelpers (flist)

import Text.ParserCombinators.Poly.StateText

import Control.Monad (unless, when, void)
import Control.Monad.State (modify, gets, lift)

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

#if MIN_VERSION_base(4, 7, 0)
import Data.Functor (($>))
#endif

import Network.URI (URI(..))

import qualified Control.Exception as CE
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Text.Lazy as L
import qualified Data.Text.Lazy.Builder as B
import qualified Data.Text.Lazy.IO as LIO
import qualified System.IO.Error as IO

#if !MIN_VERSION_base(4, 7, 0)
($>) :: Functor f => f a -> b -> f b
($>) = flip (<$)
#endif

------------------------------------------------------------
--
--  The parser used to be based on the Notation3 parser, and used many
--  of the same syntax productions, but the top-level productions used
--  are quite different. With the parser re-write it's less clear
--  what is going on.
--
-- NOTE: during the parser re-write we strip out some of this functionality
-- 

-- | Parser for Swish script processor
parseScriptFromText :: 
  Maybe QName -- ^ Default base for the script
  -> L.Text   -- ^ Swish script
  -> Either String [SwishStateIO ()]
parseScriptFromText :: Maybe QName -> Text -> Either [Char] [SwishStateIO ()]
parseScriptFromText = N3Parser [SwishStateIO ()]
-> Maybe QName -> Text -> Either [Char] [SwishStateIO ()]
forall a. N3Parser a -> Maybe QName -> Text -> Either [Char] a
parseAnyfromText N3Parser [SwishStateIO ()]
script 

----------------------------------------------------------------------
--  Syntax productions
----------------------------------------------------------------------

between :: Parser s lbr -> Parser s rbr -> Parser s a -> Parser s a
between :: forall s lbr rbr a.
Parser s lbr -> Parser s rbr -> Parser s a -> Parser s a
between = Parser s lbr -> Parser s rbr -> Parser s a -> Parser s a
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket

n3SymLex :: N3Parser ScopedName
n3SymLex :: N3Parser ScopedName
n3SymLex = N3Parser ScopedName -> N3Parser ScopedName
forall s a. Parser s a -> Parser s a
lexeme N3Parser ScopedName
n3symbol

setTo :: N3Parser ()
setTo :: N3Parser ()
setTo = [Char] -> N3Parser ()
isymbol [Char]
":-"

semicolon :: N3Parser ()
semicolon :: N3Parser ()
semicolon = [Char] -> N3Parser ()
isymbol [Char]
";"

comma :: N3Parser ()
comma :: N3Parser ()
comma = [Char] -> N3Parser ()
isymbol [Char]
","

commentText :: N3Parser String
commentText :: N3Parser [Char]
commentText = N3Parser ()
semicolon N3Parser () -> N3Parser [Char] -> N3Parser [Char]
forall a b.
Parser N3State a -> Parser N3State b -> Parser N3State b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> N3Parser [Char]
restOfLine

script :: N3Parser [SwishStateIO ()]
script :: N3Parser [SwishStateIO ()]
script = do
  N3Parser ()
forall s. Parser s ()
whiteSpace
  [SwishStateIO ()]
scs <- Parser N3State (SwishStateIO ()) -> N3Parser [SwishStateIO ()]
forall a. Parser N3State a -> Parser N3State [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser N3State (SwishStateIO ())
command
  N3Parser ()
forall s. Parser s ()
eof
  [SwishStateIO ()] -> N3Parser [SwishStateIO ()]
forall a. a -> Parser N3State a
forall (m :: * -> *) a. Monad m => a -> m a
return [SwishStateIO ()]
scs

isymbol :: String -> N3Parser ()
isymbol :: [Char] -> N3Parser ()
isymbol = N3Parser [Char] -> N3Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (N3Parser [Char] -> N3Parser ())
-> ([Char] -> N3Parser [Char]) -> [Char] -> N3Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> N3Parser [Char]
forall s. [Char] -> Parser s [Char]
symbol

command :: N3Parser (SwishStateIO ())
command :: Parser N3State (SwishStateIO ())
command =
  Parser N3State (SwishStateIO ())
prefixLine
  Parser N3State (SwishStateIO ())
-> Parser N3State (SwishStateIO ())
-> Parser N3State (SwishStateIO ())
forall a. Parser N3State a -> Parser N3State a -> Parser N3State a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser N3State (SwishStateIO ())
nameItem
  Parser N3State (SwishStateIO ())
-> Parser N3State (SwishStateIO ())
-> Parser N3State (SwishStateIO ())
forall a. Parser N3State a -> Parser N3State a -> Parser N3State a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser N3State (SwishStateIO ())
readGraph
  Parser N3State (SwishStateIO ())
-> Parser N3State (SwishStateIO ())
-> Parser N3State (SwishStateIO ())
forall a. Parser N3State a -> Parser N3State a -> Parser N3State a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser N3State (SwishStateIO ())
writeGraph
  Parser N3State (SwishStateIO ())
-> Parser N3State (SwishStateIO ())
-> Parser N3State (SwishStateIO ())
forall a. Parser N3State a -> Parser N3State a -> Parser N3State a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser N3State (SwishStateIO ())
mergeGraphs
  Parser N3State (SwishStateIO ())
-> Parser N3State (SwishStateIO ())
-> Parser N3State (SwishStateIO ())
forall a. Parser N3State a -> Parser N3State a -> Parser N3State a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser N3State (SwishStateIO ())
compareGraphs
  Parser N3State (SwishStateIO ())
-> Parser N3State (SwishStateIO ())
-> Parser N3State (SwishStateIO ())
forall a. Parser N3State a -> Parser N3State a -> Parser N3State a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser N3State (SwishStateIO ())
assertEquiv
  Parser N3State (SwishStateIO ())
-> Parser N3State (SwishStateIO ())
-> Parser N3State (SwishStateIO ())
forall a. Parser N3State a -> Parser N3State a -> Parser N3State a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser N3State (SwishStateIO ())
assertMember
  Parser N3State (SwishStateIO ())
-> Parser N3State (SwishStateIO ())
-> Parser N3State (SwishStateIO ())
forall a. Parser N3State a -> Parser N3State a -> Parser N3State a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser N3State (SwishStateIO ())
defineRule
  Parser N3State (SwishStateIO ())
-> Parser N3State (SwishStateIO ())
-> Parser N3State (SwishStateIO ())
forall a. Parser N3State a -> Parser N3State a -> Parser N3State a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser N3State (SwishStateIO ())
defineRuleset
  Parser N3State (SwishStateIO ())
-> Parser N3State (SwishStateIO ())
-> Parser N3State (SwishStateIO ())
forall a. Parser N3State a -> Parser N3State a -> Parser N3State a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser N3State (SwishStateIO ())
defineConstraints
  Parser N3State (SwishStateIO ())
-> Parser N3State (SwishStateIO ())
-> Parser N3State (SwishStateIO ())
forall a. Parser N3State a -> Parser N3State a -> Parser N3State a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser N3State (SwishStateIO ())
checkProofCmd
  Parser N3State (SwishStateIO ())
-> Parser N3State (SwishStateIO ())
-> Parser N3State (SwishStateIO ())
forall a. Parser N3State a -> Parser N3State a -> Parser N3State a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser N3State (SwishStateIO ())
fwdChain
  Parser N3State (SwishStateIO ())
-> Parser N3State (SwishStateIO ())
-> Parser N3State (SwishStateIO ())
forall a. Parser N3State a -> Parser N3State a -> Parser N3State a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser N3State (SwishStateIO ())
bwdChain

prefixLine :: N3Parser (SwishStateIO ())
prefixLine :: Parser N3State (SwishStateIO ())
prefixLine = do
  -- try $ isymbol "@prefix"
  [Char] -> N3Parser ()
isymbol [Char]
"@prefix"
  N3Parser ()
getPrefix
  N3Parser ()
forall s. Parser s ()
whiteSpace
  [Char] -> N3Parser ()
isymbol [Char]
"."
  SwishStateIO () -> Parser N3State (SwishStateIO ())
forall a. a -> Parser N3State a
forall (m :: * -> *) a. Monad m => a -> m a
return (SwishStateIO () -> Parser N3State (SwishStateIO ()))
-> SwishStateIO () -> Parser N3State (SwishStateIO ())
forall a b. (a -> b) -> a -> b
$ () -> SwishStateIO ()
forall a. a -> StateT SwishState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

--  name :- graph
--  name :- ( graph* )
nameItem :: N3Parser (SwishStateIO ())
nameItem :: Parser N3State (SwishStateIO ())
nameItem = 
  ScopedName
-> [SwishStateIO (Either [Char] RDFGraph)] -> SwishStateIO ()
ssAddGraph (ScopedName
 -> [SwishStateIO (Either [Char] RDFGraph)] -> SwishStateIO ())
-> N3Parser ScopedName
-> Parser
     N3State
     ([SwishStateIO (Either [Char] RDFGraph)] -> SwishStateIO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> N3Parser ScopedName
n3SymLex Parser
  N3State
  ([SwishStateIO (Either [Char] RDFGraph)] -> SwishStateIO ())
-> Parser N3State [SwishStateIO (Either [Char] RDFGraph)]
-> Parser N3State (SwishStateIO ())
forall a b.
Parser N3State (a -> b) -> Parser N3State a -> Parser N3State b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Char] -> N3Parser [Char]
forall s. [Char] -> Parser s [Char]
symbol [Char]
":-" N3Parser [Char]
-> Parser N3State [SwishStateIO (Either [Char] RDFGraph)]
-> Parser N3State [SwishStateIO (Either [Char] RDFGraph)]
forall a b.
Parser N3State a -> Parser N3State b -> Parser N3State b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser N3State [SwishStateIO (Either [Char] RDFGraph)]
graphOrList)
  
maybeURI :: N3Parser (Maybe URI)
maybeURI :: N3Parser (Maybe URI)
maybeURI = (URI -> Maybe URI
forall a. a -> Maybe a
Just (URI -> Maybe URI) -> Parser N3State URI -> N3Parser (Maybe URI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser N3State URI
lexUriRef) N3Parser (Maybe URI)
-> N3Parser (Maybe URI) -> N3Parser (Maybe URI)
forall a. Parser N3State a -> Parser N3State a -> Parser N3State a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe URI -> N3Parser (Maybe URI)
forall a. a -> Parser N3State a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe URI
forall a. Maybe a
Nothing

--  @read name  [ <uri> ]
readGraph :: N3Parser (SwishStateIO ())
readGraph :: Parser N3State (SwishStateIO ())
readGraph = [Char] -> N3Parser ()
commandName [Char]
"@read" N3Parser ()
-> Parser N3State (SwishStateIO ())
-> Parser N3State (SwishStateIO ())
forall a b.
Parser N3State a -> Parser N3State b -> Parser N3State b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ScopedName -> Maybe URI -> SwishStateIO ()
ssRead (ScopedName -> Maybe URI -> SwishStateIO ())
-> N3Parser ScopedName
-> Parser N3State (Maybe URI -> SwishStateIO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> N3Parser ScopedName
n3SymLex Parser N3State (Maybe URI -> SwishStateIO ())
-> N3Parser (Maybe URI) -> Parser N3State (SwishStateIO ())
forall a b.
Parser N3State (a -> b) -> Parser N3State a -> Parser N3State b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> N3Parser (Maybe URI)
maybeURI)

--  @write name [ <uri> ] ; Comment
writeGraph :: N3Parser (SwishStateIO ())
writeGraph :: Parser N3State (SwishStateIO ())
writeGraph =
        do  { [Char] -> N3Parser ()
commandName [Char]
"@write"
            ; ScopedName
n <- N3Parser ScopedName
n3SymLex
            ; let gs :: SwishStateIO (Either [Char] [RDFGraph])
gs = ScopedName -> SwishStateIO (Either [Char] [RDFGraph])
ssGetList ScopedName
n :: SwishStateIO (Either String [RDFGraph])
            ; Maybe URI
muri <- N3Parser (Maybe URI)
maybeURI
            ; Maybe URI
-> SwishStateIO (Either [Char] [RDFGraph])
-> [Char]
-> SwishStateIO ()
ssWriteList Maybe URI
muri SwishStateIO (Either [Char] [RDFGraph])
gs ([Char] -> SwishStateIO ())
-> N3Parser [Char] -> Parser N3State (SwishStateIO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> N3Parser [Char]
commentText
            }

--  @merge ( name* ) => name
mergeGraphs :: N3Parser (SwishStateIO ())
mergeGraphs :: Parser N3State (SwishStateIO ())
mergeGraphs = do
  [Char] -> N3Parser ()
commandName [Char]
"@merge"
  [SwishStateIO (Either [Char] RDFGraph)]
gs <- Parser N3State [SwishStateIO (Either [Char] RDFGraph)]
graphList
  [Char] -> N3Parser ()
isymbol [Char]
"=>"
  ScopedName
n <- N3Parser ScopedName
n3SymLex
  SwishStateIO () -> Parser N3State (SwishStateIO ())
forall a. a -> Parser N3State a
forall (m :: * -> *) a. Monad m => a -> m a
return (SwishStateIO () -> Parser N3State (SwishStateIO ()))
-> SwishStateIO () -> Parser N3State (SwishStateIO ())
forall a b. (a -> b) -> a -> b
$ ScopedName
-> [SwishStateIO (Either [Char] RDFGraph)] -> SwishStateIO ()
ssMerge ScopedName
n [SwishStateIO (Either [Char] RDFGraph)]
gs

-- @compare  name name
compareGraphs :: N3Parser (SwishStateIO ())
compareGraphs :: Parser N3State (SwishStateIO ())
compareGraphs =
  [Char] -> N3Parser ()
commandName [Char]
"@compare" N3Parser ()
-> Parser N3State (SwishStateIO ())
-> Parser N3State (SwishStateIO ())
forall a b.
Parser N3State a -> Parser N3State b -> Parser N3State b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ScopedName -> ScopedName -> SwishStateIO ()
ssCompare (ScopedName -> ScopedName -> SwishStateIO ())
-> N3Parser ScopedName
-> Parser N3State (ScopedName -> SwishStateIO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> N3Parser ScopedName
n3SymLex Parser N3State (ScopedName -> SwishStateIO ())
-> N3Parser ScopedName -> Parser N3State (SwishStateIO ())
forall a b.
Parser N3State (a -> b) -> Parser N3State a -> Parser N3State b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> N3Parser ScopedName
n3SymLex)
  
-- @<command> name name ; Comment
assertArgs :: (ScopedName -> ScopedName -> String -> SwishStateIO ())
              -> String -> N3Parser (SwishStateIO ())
assertArgs :: (ScopedName -> ScopedName -> [Char] -> SwishStateIO ())
-> [Char] -> Parser N3State (SwishStateIO ())
assertArgs ScopedName -> ScopedName -> [Char] -> SwishStateIO ()
assertFunc [Char]
cName = do
  [Char] -> N3Parser ()
commandName ([Char] -> N3Parser ()) -> [Char] -> N3Parser ()
forall a b. (a -> b) -> a -> b
$ Char
'@'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
cName
  ScopedName -> ScopedName -> [Char] -> SwishStateIO ()
assertFunc (ScopedName -> ScopedName -> [Char] -> SwishStateIO ())
-> N3Parser ScopedName
-> Parser N3State (ScopedName -> [Char] -> SwishStateIO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> N3Parser ScopedName
n3SymLex Parser N3State (ScopedName -> [Char] -> SwishStateIO ())
-> N3Parser ScopedName
-> Parser N3State ([Char] -> SwishStateIO ())
forall a b.
Parser N3State (a -> b) -> Parser N3State a -> Parser N3State b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> N3Parser ScopedName
n3SymLex Parser N3State ([Char] -> SwishStateIO ())
-> N3Parser [Char] -> Parser N3State (SwishStateIO ())
forall a b.
Parser N3State (a -> b) -> Parser N3State a -> Parser N3State b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> N3Parser [Char]
commentText
      
--  @asserteq name name ; Comment
assertEquiv :: N3Parser (SwishStateIO ())
assertEquiv :: Parser N3State (SwishStateIO ())
assertEquiv = (ScopedName -> ScopedName -> [Char] -> SwishStateIO ())
-> [Char] -> Parser N3State (SwishStateIO ())
assertArgs ScopedName -> ScopedName -> [Char] -> SwishStateIO ()
ssAssertEq [Char]
"asserteq" 
        
--  @assertin name name ; Comment              
assertMember :: N3Parser (SwishStateIO ())
assertMember :: Parser N3State (SwishStateIO ())
assertMember = (ScopedName -> ScopedName -> [Char] -> SwishStateIO ())
-> [Char] -> Parser N3State (SwishStateIO ())
assertArgs ScopedName -> ScopedName -> [Char] -> SwishStateIO ()
ssAssertIn [Char]
"assertin"
  
--  @rule name :- ( name* ) => name [ | ( (name var*)* ) ]               
defineRule :: N3Parser (SwishStateIO ())
defineRule :: Parser N3State (SwishStateIO ())
defineRule =
        do  { [Char] -> N3Parser ()
commandName [Char]
"@rule"
            ; ScopedName
rn <- N3Parser ScopedName
n3SymLex
            ; N3Parser ()
setTo
            ; [SwishStateIO (Either [Char] RDFGraph)]
ags <- Parser N3State [SwishStateIO (Either [Char] RDFGraph)]
graphOrList
            ; [Char] -> N3Parser ()
isymbol [Char]
"=>"
            ; SwishStateIO (Either [Char] RDFGraph)
cg  <- N3Parser (SwishStateIO (Either [Char] RDFGraph))
graphExpr
            ; [(ScopedName, [RDFLabel])]
vms <- N3Parser [(ScopedName, [RDFLabel])]
varModifiers N3Parser [(ScopedName, [RDFLabel])]
-> N3Parser [(ScopedName, [RDFLabel])]
-> N3Parser [(ScopedName, [RDFLabel])]
forall a. Parser N3State a -> Parser N3State a -> Parser N3State a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [(ScopedName, [RDFLabel])] -> N3Parser [(ScopedName, [RDFLabel])]
forall a. a -> Parser N3State a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
            ; SwishStateIO () -> Parser N3State (SwishStateIO ())
forall a. a -> Parser N3State a
forall (m :: * -> *) a. Monad m => a -> m a
return (SwishStateIO () -> Parser N3State (SwishStateIO ()))
-> SwishStateIO () -> Parser N3State (SwishStateIO ())
forall a b. (a -> b) -> a -> b
$ ScopedName
-> [SwishStateIO (Either [Char] RDFGraph)]
-> SwishStateIO (Either [Char] RDFGraph)
-> [(ScopedName, [RDFLabel])]
-> SwishStateIO ()
ssDefineRule ScopedName
rn [SwishStateIO (Either [Char] RDFGraph)]
ags SwishStateIO (Either [Char] RDFGraph)
cg [(ScopedName, [RDFLabel])]
vms
            }

--  @ruleset name :- ( name* ) ; ( name* )
defineRuleset :: N3Parser (SwishStateIO ())
defineRuleset :: Parser N3State (SwishStateIO ())
defineRuleset =
  [Char] -> N3Parser ()
commandName [Char]
"@ruleset" N3Parser ()
-> Parser N3State (SwishStateIO ())
-> Parser N3State (SwishStateIO ())
forall a b.
Parser N3State a -> Parser N3State b -> Parser N3State b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>      
  (ScopedName -> [ScopedName] -> [ScopedName] -> SwishStateIO ()
ssDefineRuleset (ScopedName -> [ScopedName] -> [ScopedName] -> SwishStateIO ())
-> N3Parser ScopedName
-> Parser N3State ([ScopedName] -> [ScopedName] -> SwishStateIO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> N3Parser ScopedName
n3SymLex Parser N3State ([ScopedName] -> [ScopedName] -> SwishStateIO ())
-> Parser N3State [ScopedName]
-> Parser N3State ([ScopedName] -> SwishStateIO ())
forall a b.
Parser N3State (a -> b) -> Parser N3State a -> Parser N3State b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (N3Parser ()
setTo N3Parser ()
-> Parser N3State [ScopedName] -> Parser N3State [ScopedName]
forall a b.
Parser N3State a -> Parser N3State b -> Parser N3State b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser N3State [ScopedName]
nameList) Parser N3State ([ScopedName] -> SwishStateIO ())
-> Parser N3State [ScopedName] -> Parser N3State (SwishStateIO ())
forall a b.
Parser N3State (a -> b) -> Parser N3State a -> Parser N3State b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (N3Parser ()
semicolon N3Parser ()
-> Parser N3State [ScopedName] -> Parser N3State [ScopedName]
forall a b.
Parser N3State a -> Parser N3State b -> Parser N3State b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser N3State [ScopedName]
nameList))
  
--  @constraints pref :- ( name* ) | ( name* )
defineConstraints :: N3Parser (SwishStateIO ())
defineConstraints :: Parser N3State (SwishStateIO ())
defineConstraints =
  [Char] -> N3Parser ()
commandName [Char]
"@constraints" N3Parser ()
-> Parser N3State (SwishStateIO ())
-> Parser N3State (SwishStateIO ())
forall a b.
Parser N3State a -> Parser N3State b -> Parser N3State b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>      
  (ScopedName
-> [SwishStateIO (Either [Char] RDFGraph)]
-> [ScopedName]
-> SwishStateIO ()
ssDefineConstraints (ScopedName
 -> [SwishStateIO (Either [Char] RDFGraph)]
 -> [ScopedName]
 -> SwishStateIO ())
-> N3Parser ScopedName
-> Parser
     N3State
     ([SwishStateIO (Either [Char] RDFGraph)]
      -> [ScopedName] -> SwishStateIO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> N3Parser ScopedName
n3SymLex Parser
  N3State
  ([SwishStateIO (Either [Char] RDFGraph)]
   -> [ScopedName] -> SwishStateIO ())
-> Parser N3State [SwishStateIO (Either [Char] RDFGraph)]
-> Parser N3State ([ScopedName] -> SwishStateIO ())
forall a b.
Parser N3State (a -> b) -> Parser N3State a -> Parser N3State b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (N3Parser ()
setTo N3Parser ()
-> Parser N3State [SwishStateIO (Either [Char] RDFGraph)]
-> Parser N3State [SwishStateIO (Either [Char] RDFGraph)]
forall a b.
Parser N3State a -> Parser N3State b -> Parser N3State b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser N3State [SwishStateIO (Either [Char] RDFGraph)]
graphOrList) Parser N3State ([ScopedName] -> SwishStateIO ())
-> Parser N3State [ScopedName] -> Parser N3State (SwishStateIO ())
forall a b.
Parser N3State (a -> b) -> Parser N3State a -> Parser N3State b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Char] -> N3Parser [Char]
forall s. [Char] -> Parser s [Char]
symbol [Char]
"|" N3Parser [Char]
-> Parser N3State [ScopedName] -> Parser N3State [ScopedName]
forall a b.
Parser N3State a -> Parser N3State b -> Parser N3State b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser N3State [ScopedName]
nameOrList))
  
--  @proof name ( name* )
--    @input name
--    @step name ( name* ) => name  # rule-name, antecedents, consequent
--    @result name
checkProofCmd :: N3Parser (SwishStateIO ())
checkProofCmd :: Parser N3State (SwishStateIO ())
checkProofCmd =
        do  { [Char] -> N3Parser ()
commandName [Char]
"@proof"
            ; ScopedName
pn  <- N3Parser ScopedName
n3SymLex
            ; [ScopedName]
sns <- Parser N3State [ScopedName]
nameList
            ; [Char] -> N3Parser ()
commandName [Char]
"@input"
            ; SwishStateIO (Either [Char] RDFFormula)
igf <- N3Parser (SwishStateIO (Either [Char] RDFFormula))
formulaExpr
            ; [Either [Char] [RDFRuleset]
 -> SwishStateIO (Either [Char] RDFProofStep)]
sts <- Parser
  N3State
  (Either [Char] [RDFRuleset]
   -> SwishStateIO (Either [Char] RDFProofStep))
-> Parser
     N3State
     [Either [Char] [RDFRuleset]
      -> SwishStateIO (Either [Char] RDFProofStep)]
forall a. Parser N3State a -> Parser N3State [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser
  N3State
  (Either [Char] [RDFRuleset]
   -> SwishStateIO (Either [Char] RDFProofStep))
checkStep
            ; [Char] -> N3Parser ()
commandName [Char]
"@result"
            ; ScopedName
-> [ScopedName]
-> SwishStateIO (Either [Char] RDFFormula)
-> [Either [Char] [RDFRuleset]
    -> SwishStateIO (Either [Char] RDFProofStep)]
-> SwishStateIO (Either [Char] RDFFormula)
-> SwishStateIO ()
ssCheckProof ScopedName
pn [ScopedName]
sns SwishStateIO (Either [Char] RDFFormula)
igf [Either [Char] [RDFRuleset]
 -> SwishStateIO (Either [Char] RDFProofStep)]
sts (SwishStateIO (Either [Char] RDFFormula) -> SwishStateIO ())
-> N3Parser (SwishStateIO (Either [Char] RDFFormula))
-> Parser N3State (SwishStateIO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> N3Parser (SwishStateIO (Either [Char] RDFFormula))
formulaExpr
            }

checkStep ::
    N3Parser (Either String [RDFRuleset]
                -> SwishStateIO (Either String RDFProofStep))
checkStep :: Parser
  N3State
  (Either [Char] [RDFRuleset]
   -> SwishStateIO (Either [Char] RDFProofStep))
checkStep =
  [Char] -> N3Parser ()
commandName [Char]
"@step" N3Parser ()
-> Parser
     N3State
     (Either [Char] [RDFRuleset]
      -> SwishStateIO (Either [Char] RDFProofStep))
-> Parser
     N3State
     (Either [Char] [RDFRuleset]
      -> SwishStateIO (Either [Char] RDFProofStep))
forall a b.
Parser N3State a -> Parser N3State b -> Parser N3State b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>      
  (ScopedName
-> [SwishStateIO (Either [Char] RDFFormula)]
-> SwishStateIO (Either [Char] RDFFormula)
-> Either [Char] [RDFRuleset]
-> SwishStateIO (Either [Char] RDFProofStep)
ssCheckStep (ScopedName
 -> [SwishStateIO (Either [Char] RDFFormula)]
 -> SwishStateIO (Either [Char] RDFFormula)
 -> Either [Char] [RDFRuleset]
 -> SwishStateIO (Either [Char] RDFProofStep))
-> N3Parser ScopedName
-> Parser
     N3State
     ([SwishStateIO (Either [Char] RDFFormula)]
      -> SwishStateIO (Either [Char] RDFFormula)
      -> Either [Char] [RDFRuleset]
      -> SwishStateIO (Either [Char] RDFProofStep))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> N3Parser ScopedName
n3SymLex Parser
  N3State
  ([SwishStateIO (Either [Char] RDFFormula)]
   -> SwishStateIO (Either [Char] RDFFormula)
   -> Either [Char] [RDFRuleset]
   -> SwishStateIO (Either [Char] RDFProofStep))
-> Parser N3State [SwishStateIO (Either [Char] RDFFormula)]
-> Parser
     N3State
     (SwishStateIO (Either [Char] RDFFormula)
      -> Either [Char] [RDFRuleset]
      -> SwishStateIO (Either [Char] RDFProofStep))
forall a b.
Parser N3State (a -> b) -> Parser N3State a -> Parser N3State b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser N3State [SwishStateIO (Either [Char] RDFFormula)]
formulaList Parser
  N3State
  (SwishStateIO (Either [Char] RDFFormula)
   -> Either [Char] [RDFRuleset]
   -> SwishStateIO (Either [Char] RDFProofStep))
-> N3Parser (SwishStateIO (Either [Char] RDFFormula))
-> Parser
     N3State
     (Either [Char] [RDFRuleset]
      -> SwishStateIO (Either [Char] RDFProofStep))
forall a b.
Parser N3State (a -> b) -> Parser N3State a -> Parser N3State b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Char] -> N3Parser [Char]
forall s. [Char] -> Parser s [Char]
symbol [Char]
"=>" N3Parser [Char]
-> N3Parser (SwishStateIO (Either [Char] RDFFormula))
-> N3Parser (SwishStateIO (Either [Char] RDFFormula))
forall a b.
Parser N3State a -> Parser N3State b -> Parser N3State b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> N3Parser (SwishStateIO (Either [Char] RDFFormula))
formulaExpr))

--  #   ruleset rule (antecedents) => result
--  @fwdchain pref name ( name* ) => name
fwdChain :: N3Parser (SwishStateIO ())
fwdChain :: Parser N3State (SwishStateIO ())
fwdChain =
        do  { [Char] -> N3Parser ()
commandName [Char]
"@fwdchain"
            ; ScopedName
sn  <- N3Parser ScopedName
n3SymLex
            ; ScopedName
rn  <- N3Parser ScopedName
n3SymLex
            ; [SwishStateIO (Either [Char] RDFGraph)]
ags <- Parser N3State [SwishStateIO (Either [Char] RDFGraph)]
graphOrList
            ; [Char] -> N3Parser ()
isymbol [Char]
"=>"
            ; ScopedName
cn  <- N3Parser ScopedName
n3SymLex
            ; N3State
s <- Parser N3State N3State
forall s. Parser s s
stGet
            ; let prefs :: NamespaceMap
prefs = N3State -> NamespaceMap
prefixUris N3State
s
            ; SwishStateIO () -> Parser N3State (SwishStateIO ())
forall a. a -> Parser N3State a
forall (m :: * -> *) a. Monad m => a -> m a
return (SwishStateIO () -> Parser N3State (SwishStateIO ()))
-> SwishStateIO () -> Parser N3State (SwishStateIO ())
forall a b. (a -> b) -> a -> b
$ ScopedName
-> ScopedName
-> [SwishStateIO (Either [Char] RDFGraph)]
-> ScopedName
-> NamespaceMap
-> SwishStateIO ()
ssFwdChain ScopedName
sn ScopedName
rn [SwishStateIO (Either [Char] RDFGraph)]
ags ScopedName
cn NamespaceMap
prefs
            }

--  #   ruleset rule consequent <= (antecedent-alts)
--  @bwdchain pref name graph <= name
bwdChain :: N3Parser (SwishStateIO ())
bwdChain :: Parser N3State (SwishStateIO ())
bwdChain =
        do  { [Char] -> N3Parser ()
commandName [Char]
"@bwdchain"
            ; ScopedName
sn  <- N3Parser ScopedName
n3SymLex
            ; ScopedName
rn  <- N3Parser ScopedName
n3SymLex
            ; SwishStateIO (Either [Char] RDFGraph)
cg  <- N3Parser (SwishStateIO (Either [Char] RDFGraph))
graphExpr
            ; [Char] -> N3Parser ()
isymbol [Char]
"<="
            ; ScopedName
an  <- N3Parser ScopedName
n3SymLex
            ; N3State
s <- Parser N3State N3State
forall s. Parser s s
stGet
            ; let prefs :: NamespaceMap
prefs = N3State -> NamespaceMap
prefixUris N3State
s
            ; SwishStateIO () -> Parser N3State (SwishStateIO ())
forall a. a -> Parser N3State a
forall (m :: * -> *) a. Monad m => a -> m a
return (SwishStateIO () -> Parser N3State (SwishStateIO ()))
-> SwishStateIO () -> Parser N3State (SwishStateIO ())
forall a b. (a -> b) -> a -> b
$ ScopedName
-> ScopedName
-> SwishStateIO (Either [Char] RDFGraph)
-> ScopedName
-> NamespaceMap
-> SwishStateIO ()
ssBwdChain ScopedName
sn ScopedName
rn SwishStateIO (Either [Char] RDFGraph)
cg ScopedName
an NamespaceMap
prefs
            }

----------------------------------------------------------------------
--  Syntax clause helpers
----------------------------------------------------------------------

-- TODO: is the loss of identLetter a problem?
commandName :: String -> N3Parser ()
-- commandName cmd = try (string cmd *> notFollowedBy identLetter *> whiteSpace)
commandName :: [Char] -> N3Parser ()
commandName [Char]
cmd = [Char] -> N3Parser [Char]
forall s. [Char] -> Parser s [Char]
symbol [Char]
cmd N3Parser [Char] -> () -> N3Parser ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()

restOfLine :: N3Parser String
restOfLine :: N3Parser [Char]
restOfLine = Parser N3State Char -> N3Parser () -> N3Parser [Char]
forall s a b. Parser s a -> Parser s b -> Parser s [a]
manyTill ((Char -> Bool) -> Parser N3State Char
forall s. (Char -> Bool) -> Parser s Char
satisfy (Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True)) N3Parser ()
forall s. Parser s ()
eoln N3Parser [Char] -> N3Parser () -> N3Parser [Char]
forall a b.
Parser N3State a -> Parser N3State b -> Parser N3State a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* N3Parser ()
forall s. Parser s ()
whiteSpace
  
br :: N3Parser a -> N3Parser a
br :: forall a. N3Parser a -> N3Parser a
br = N3Parser [Char]
-> N3Parser [Char] -> Parser N3State a -> Parser N3State a
forall s lbr rbr a.
Parser s lbr -> Parser s rbr -> Parser s a -> Parser s a
between ([Char] -> N3Parser [Char]
forall s. [Char] -> Parser s [Char]
symbol [Char]
"(") ([Char] -> N3Parser [Char]
forall s. [Char] -> Parser s [Char]
symbol [Char]
")")

nameList :: N3Parser [ScopedName]
nameList :: Parser N3State [ScopedName]
nameList = Parser N3State [ScopedName] -> Parser N3State [ScopedName]
forall a. N3Parser a -> N3Parser a
br (Parser N3State [ScopedName] -> Parser N3State [ScopedName])
-> Parser N3State [ScopedName] -> Parser N3State [ScopedName]
forall a b. (a -> b) -> a -> b
$ N3Parser ScopedName -> Parser N3State [ScopedName]
forall a. Parser N3State a -> Parser N3State [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many N3Parser ScopedName
n3SymLex
  
toList :: a -> [a]
toList :: forall a. a -> [a]
toList = (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[])
           
nameOrList :: N3Parser [ScopedName]
nameOrList :: Parser N3State [ScopedName]
nameOrList =
  (ScopedName -> [ScopedName]
forall a. a -> [a]
toList (ScopedName -> [ScopedName])
-> N3Parser ScopedName -> Parser N3State [ScopedName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> N3Parser ScopedName
n3SymLex)      
  Parser N3State [ScopedName]
-> Parser N3State [ScopedName] -> Parser N3State [ScopedName]
forall a. Parser N3State a -> Parser N3State a -> Parser N3State a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser N3State [ScopedName]
nameList
  
graphExpr :: N3Parser (SwishStateIO (Either String RDFGraph))
graphExpr :: N3Parser (SwishStateIO (Either [Char] RDFGraph))
graphExpr =
        N3Parser (SwishStateIO (Either [Char] RDFGraph))
graphOnly
    N3Parser (SwishStateIO (Either [Char] RDFGraph))
-> N3Parser (SwishStateIO (Either [Char] RDFGraph))
-> N3Parser (SwishStateIO (Either [Char] RDFGraph))
forall a. Parser N3State a -> Parser N3State a -> Parser N3State a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        (Either [Char] RDFFormula -> Either [Char] RDFGraph)
-> SwishStateIO (Either [Char] RDFFormula)
-> SwishStateIO (Either [Char] RDFGraph)
forall a b.
(a -> b) -> StateT SwishState IO a -> StateT SwishState IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((RDFFormula -> RDFGraph)
-> Either [Char] RDFFormula -> Either [Char] RDFGraph
forall a b. (a -> b) -> Either [Char] a -> Either [Char] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RDFFormula -> RDFGraph
forall ex. Formula ex -> ex
formExpr) (SwishStateIO (Either [Char] RDFFormula)
 -> SwishStateIO (Either [Char] RDFGraph))
-> N3Parser (SwishStateIO (Either [Char] RDFFormula))
-> N3Parser (SwishStateIO (Either [Char] RDFGraph))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> N3Parser (SwishStateIO (Either [Char] RDFFormula))
formulaExpr

graphOnly :: N3Parser (SwishStateIO (Either String RDFGraph))
graphOnly :: N3Parser (SwishStateIO (Either [Char] RDFGraph))
graphOnly =
        do  { [Char] -> N3Parser ()
isymbol [Char]
"{"
            ; RDFLabel
b <- N3Parser RDFLabel
newBlankNode
            ; RDFGraph
g <- RDFLabel -> N3Parser RDFGraph
subgraph RDFLabel
b
            ; [Char] -> N3Parser ()
isymbol [Char]
"}"
            ; N3State
s <- Parser N3State N3State
forall s. Parser s s
stGet
            ; let gp :: RDFGraph
gp = NamespaceMap -> RDFGraph -> RDFGraph
forall lb. NamespaceMap -> NSGraph lb -> NSGraph lb
setNamespaces (N3State -> NamespaceMap
prefixUris N3State
s) RDFGraph
g
            ; SwishStateIO (Either [Char] RDFGraph)
-> N3Parser (SwishStateIO (Either [Char] RDFGraph))
forall a. a -> Parser N3State a
forall (m :: * -> *) a. Monad m => a -> m a
return (SwishStateIO (Either [Char] RDFGraph)
 -> N3Parser (SwishStateIO (Either [Char] RDFGraph)))
-> SwishStateIO (Either [Char] RDFGraph)
-> N3Parser (SwishStateIO (Either [Char] RDFGraph))
forall a b. (a -> b) -> a -> b
$ Either [Char] RDFGraph -> SwishStateIO (Either [Char] RDFGraph)
forall a. a -> StateT SwishState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RDFGraph -> Either [Char] RDFGraph
forall a b. b -> Either a b
Right RDFGraph
gp)
            }

graphList :: N3Parser [SwishStateIO (Either String RDFGraph)]
graphList :: Parser N3State [SwishStateIO (Either [Char] RDFGraph)]
graphList = Parser N3State [SwishStateIO (Either [Char] RDFGraph)]
-> Parser N3State [SwishStateIO (Either [Char] RDFGraph)]
forall a. N3Parser a -> N3Parser a
br (N3Parser (SwishStateIO (Either [Char] RDFGraph))
-> Parser N3State [SwishStateIO (Either [Char] RDFGraph)]
forall a. Parser N3State a -> Parser N3State [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many N3Parser (SwishStateIO (Either [Char] RDFGraph))
graphExpr)

graphOrList :: N3Parser [SwishStateIO (Either String RDFGraph)]
graphOrList :: Parser N3State [SwishStateIO (Either [Char] RDFGraph)]
graphOrList =
  (SwishStateIO (Either [Char] RDFGraph)
-> [SwishStateIO (Either [Char] RDFGraph)]
forall a. a -> [a]
toList (SwishStateIO (Either [Char] RDFGraph)
 -> [SwishStateIO (Either [Char] RDFGraph)])
-> N3Parser (SwishStateIO (Either [Char] RDFGraph))
-> Parser N3State [SwishStateIO (Either [Char] RDFGraph)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> N3Parser (SwishStateIO (Either [Char] RDFGraph))
graphExpr)
  Parser N3State [SwishStateIO (Either [Char] RDFGraph)]
-> Parser N3State [SwishStateIO (Either [Char] RDFGraph)]
-> Parser N3State [SwishStateIO (Either [Char] RDFGraph)]
forall a. Parser N3State a -> Parser N3State a -> Parser N3State a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser N3State [SwishStateIO (Either [Char] RDFGraph)]
graphList

formulaExpr :: N3Parser (SwishStateIO (Either String RDFFormula))
formulaExpr :: N3Parser (SwishStateIO (Either [Char] RDFFormula))
formulaExpr = N3Parser ScopedName
n3SymLex N3Parser ScopedName
-> (ScopedName
    -> N3Parser (SwishStateIO (Either [Char] RDFFormula)))
-> N3Parser (SwishStateIO (Either [Char] RDFFormula))
forall a b.
Parser N3State a -> (a -> Parser N3State b) -> Parser N3State b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ScopedName -> N3Parser (SwishStateIO (Either [Char] RDFFormula))
namedGraph

namedGraph :: ScopedName -> N3Parser (SwishStateIO (Either String RDFFormula))
namedGraph :: ScopedName -> N3Parser (SwishStateIO (Either [Char] RDFFormula))
namedGraph ScopedName
n =
  (ScopedName
-> SwishStateIO (Either [Char] RDFGraph)
-> SwishStateIO (Either [Char] RDFFormula)
ssAddReturnFormula ScopedName
n (SwishStateIO (Either [Char] RDFGraph)
 -> SwishStateIO (Either [Char] RDFFormula))
-> N3Parser (SwishStateIO (Either [Char] RDFGraph))
-> N3Parser (SwishStateIO (Either [Char] RDFFormula))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (N3Parser ()
setTo N3Parser ()
-> N3Parser (SwishStateIO (Either [Char] RDFGraph))
-> N3Parser (SwishStateIO (Either [Char] RDFGraph))
forall a b.
Parser N3State a -> Parser N3State b -> Parser N3State b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> N3Parser (SwishStateIO (Either [Char] RDFGraph))
graphOnly))
  N3Parser (SwishStateIO (Either [Char] RDFFormula))
-> N3Parser (SwishStateIO (Either [Char] RDFFormula))
-> N3Parser (SwishStateIO (Either [Char] RDFFormula))
forall a. Parser N3State a -> Parser N3State a -> Parser N3State a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SwishStateIO (Either [Char] RDFFormula)
-> N3Parser (SwishStateIO (Either [Char] RDFFormula))
forall a. a -> Parser N3State a
forall (m :: * -> *) a. Monad m => a -> m a
return (ScopedName -> SwishStateIO (Either [Char] RDFFormula)
ssGetFormula ScopedName
n)

formulaList :: N3Parser [SwishStateIO (Either String RDFFormula)]
formulaList :: Parser N3State [SwishStateIO (Either [Char] RDFFormula)]
formulaList = N3Parser [Char]
-> N3Parser [Char]
-> Parser N3State [SwishStateIO (Either [Char] RDFFormula)]
-> Parser N3State [SwishStateIO (Either [Char] RDFFormula)]
forall s lbr rbr a.
Parser s lbr -> Parser s rbr -> Parser s a -> Parser s a
between ([Char] -> N3Parser [Char]
forall s. [Char] -> Parser s [Char]
symbol [Char]
"(") ([Char] -> N3Parser [Char]
forall s. [Char] -> Parser s [Char]
symbol [Char]
")") (N3Parser (SwishStateIO (Either [Char] RDFFormula))
-> Parser N3State [SwishStateIO (Either [Char] RDFFormula)]
forall a. Parser N3State a -> Parser N3State [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many N3Parser (SwishStateIO (Either [Char] RDFFormula))
formulaExpr)

varModifiers :: N3Parser [(ScopedName,[RDFLabel])]
varModifiers :: N3Parser [(ScopedName, [RDFLabel])]
varModifiers = [Char] -> N3Parser [Char]
forall s. [Char] -> Parser s [Char]
symbol [Char]
"|" N3Parser [Char]
-> N3Parser [(ScopedName, [RDFLabel])]
-> N3Parser [(ScopedName, [RDFLabel])]
forall a b.
Parser N3State a -> Parser N3State b -> Parser N3State b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> N3Parser [(ScopedName, [RDFLabel])]
varModList

varModList :: N3Parser [(ScopedName,[RDFLabel])]
varModList :: N3Parser [(ScopedName, [RDFLabel])]
varModList = 
  N3Parser [(ScopedName, [RDFLabel])]
-> N3Parser [(ScopedName, [RDFLabel])]
forall a. N3Parser a -> N3Parser a
br (Parser N3State (ScopedName, [RDFLabel])
-> N3Parser () -> N3Parser [(ScopedName, [RDFLabel])]
forall (p :: * -> *) a sep. PolyParse p => p a -> p sep -> p [a]
sepBy Parser N3State (ScopedName, [RDFLabel])
varMod N3Parser ()
comma)
  N3Parser [(ScopedName, [RDFLabel])]
-> N3Parser [(ScopedName, [RDFLabel])]
-> N3Parser [(ScopedName, [RDFLabel])]
forall a. Parser N3State a -> Parser N3State a -> Parser N3State a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ScopedName, [RDFLabel]) -> [(ScopedName, [RDFLabel])]
forall a. a -> [a]
toList ((ScopedName, [RDFLabel]) -> [(ScopedName, [RDFLabel])])
-> Parser N3State (ScopedName, [RDFLabel])
-> N3Parser [(ScopedName, [RDFLabel])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser N3State (ScopedName, [RDFLabel])
-> Parser N3State (ScopedName, [RDFLabel])
forall s a. Parser s a -> Parser s a
lexeme Parser N3State (ScopedName, [RDFLabel])
varMod

varMod :: N3Parser (ScopedName,[RDFLabel])
varMod :: Parser N3State (ScopedName, [RDFLabel])
varMod = (,) (ScopedName -> [RDFLabel] -> (ScopedName, [RDFLabel]))
-> N3Parser ScopedName
-> Parser N3State ([RDFLabel] -> (ScopedName, [RDFLabel]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> N3Parser ScopedName
n3SymLex Parser N3State ([RDFLabel] -> (ScopedName, [RDFLabel]))
-> Parser N3State [RDFLabel]
-> Parser N3State (ScopedName, [RDFLabel])
forall a b.
Parser N3State (a -> b) -> Parser N3State a -> Parser N3State b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> N3Parser RDFLabel -> Parser N3State [RDFLabel]
forall a. Parser N3State a -> Parser N3State [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (N3Parser RDFLabel -> N3Parser RDFLabel
forall s a. Parser s a -> Parser s a
lexeme N3Parser RDFLabel
quickVariable)

----------------------------------------------------------------------
--  SwishState helper functions
----------------------------------------------------------------------
--
--  The functions below operate in the SwishStateIO monad, and are used
--  to assemble an executable version of the parsed script.

-- | Return a message to the user. At present the message begins with '# '
-- but this may be removed.
--
ssReport :: 
  String  -- ^ message contents
  -> SwishStateIO ()
-- ssReport msg = lift $ putStrLn $ "# " ++ msg
ssReport :: [Char] -> SwishStateIO ()
ssReport [Char]
msg = (SwishState -> SwishState) -> SwishStateIO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SwishState -> SwishState) -> SwishStateIO ())
-> (SwishState -> SwishState) -> SwishStateIO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> SwishState -> SwishState
setInfo ([Char] -> SwishState -> SwishState)
-> [Char] -> SwishState -> SwishState
forall a b. (a -> b) -> a -> b
$ [Char]
"# " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
msg

ssReportLabel :: 
  String     -- ^ label for the message
  -> String  -- ^ message contents
  -> SwishStateIO ()
ssReportLabel :: [Char] -> [Char] -> SwishStateIO ()
ssReportLabel [Char]
lbl [Char]
msg = [Char] -> SwishStateIO ()
ssReport ([Char] -> SwishStateIO ()) -> [Char] -> SwishStateIO ()
forall a b. (a -> b) -> a -> b
$ [Char]
lbl [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
msg

ssAddReturnFormula ::
    ScopedName -> SwishStateIO (Either String RDFGraph)
    -> SwishStateIO (Either String RDFFormula)
ssAddReturnFormula :: ScopedName
-> SwishStateIO (Either [Char] RDFGraph)
-> SwishStateIO (Either [Char] RDFFormula)
ssAddReturnFormula ScopedName
nam SwishStateIO (Either [Char] RDFGraph)
gf =
        do  { Either [Char] RDFGraph
egr <- SwishStateIO (Either [Char] RDFGraph)
gf
            ; ScopedName
-> [SwishStateIO (Either [Char] RDFGraph)] -> SwishStateIO ()
ssAddGraph ScopedName
nam [Either [Char] RDFGraph -> SwishStateIO (Either [Char] RDFGraph)
forall a. a -> StateT SwishState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Either [Char] RDFGraph
egr]
            ; Either [Char] RDFFormula -> SwishStateIO (Either [Char] RDFFormula)
forall a. a -> StateT SwishState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] RDFFormula
 -> SwishStateIO (Either [Char] RDFFormula))
-> Either [Char] RDFFormula
-> SwishStateIO (Either [Char] RDFFormula)
forall a b. (a -> b) -> a -> b
$ (RDFGraph -> RDFFormula)
-> Either [Char] RDFGraph -> Either [Char] RDFFormula
forall a b. (a -> b) -> Either [Char] a -> Either [Char] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ScopedName -> RDFGraph -> RDFFormula
forall ex. ScopedName -> ex -> Formula ex
Formula ScopedName
nam) Either [Char] RDFGraph
egr
            }

ssAddGraph ::
    ScopedName -> [SwishStateIO (Either String RDFGraph)]
    -> SwishStateIO ()
ssAddGraph :: ScopedName
-> [SwishStateIO (Either [Char] RDFGraph)] -> SwishStateIO ()
ssAddGraph ScopedName
nam [SwishStateIO (Either [Char] RDFGraph)]
gf =
    let errmsg :: [Char]
errmsg = [Char]
"Graph/list not added: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ScopedName -> [Char]
forall a. Show a => a -> [Char]
show ScopedName
nam [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"; "
    in
        do  { [Either [Char] RDFGraph]
esg <- [SwishStateIO (Either [Char] RDFGraph)]
-> StateT SwishState IO [Either [Char] RDFGraph]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [SwishStateIO (Either [Char] RDFGraph)]
gf        -- [Either String RDFGraph]
            ; let egs :: Either [Char] [RDFGraph]
egs = [Either [Char] RDFGraph] -> Either [Char] [RDFGraph]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Either [Char] RDFGraph]
esg    -- Either String [RDFGraph]
            ; let fgs :: SwishState -> SwishState
fgs = case Either [Char] [RDFGraph]
egs of
                    Left  [Char]
er -> [Char] -> SwishState -> SwishState
setError  ([Char]
errmsg [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
er)
                    Right [RDFGraph]
gs -> (NamedGraphMap -> NamedGraphMap) -> SwishState -> SwishState
modGraphs (ScopedName -> [RDFGraph] -> NamedGraphMap -> NamedGraphMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ScopedName
nam [RDFGraph]
gs)
            ; (SwishState -> SwishState) -> SwishStateIO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify SwishState -> SwishState
fgs
            }

ssGetGraph :: ScopedName -> SwishStateIO (Either String RDFGraph)
ssGetGraph :: ScopedName -> SwishStateIO (Either [Char] RDFGraph)
ssGetGraph ScopedName
nam = do
  Either [Char] [RDFGraph]
grs <- ScopedName -> SwishStateIO (Either [Char] [RDFGraph])
ssGetList ScopedName
nam
  Either [Char] RDFGraph -> SwishStateIO (Either [Char] RDFGraph)
forall a. a -> StateT SwishState IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [Char] RDFGraph -> SwishStateIO (Either [Char] RDFGraph))
-> Either [Char] RDFGraph -> SwishStateIO (Either [Char] RDFGraph)
forall a b. (a -> b) -> a -> b
$ case Either [Char] [RDFGraph]
grs of
           Left [Char]
emsg -> [Char] -> Either [Char] RDFGraph
forall a b. a -> Either a b
Left [Char]
emsg
           -- Does it make sense to allow the empty graph?
           Right [] -> [Char] -> Either [Char] RDFGraph
forall a b. a -> Either a b
Left ([Char]
"Graph or list is empty: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ScopedName -> [Char]
forall a. Show a => a -> [Char]
show ScopedName
nam)
           Right (RDFGraph
gr:[RDFGraph]
_) -> RDFGraph -> Either [Char] RDFGraph
forall a b. b -> Either a b
Right RDFGraph
gr
  
ssGetFormula :: ScopedName -> SwishStateIO (Either String RDFFormula)
ssGetFormula :: ScopedName -> SwishStateIO (Either [Char] RDFFormula)
ssGetFormula ScopedName
nam = (SwishState -> Either [Char] RDFFormula)
-> SwishStateIO (Either [Char] RDFFormula)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SwishState -> Either [Char] RDFFormula
find
    where
        find :: SwishState -> Either [Char] RDFFormula
find SwishState
st = case ScopedName -> SwishState -> Maybe RDFFormula
findFormula ScopedName
nam SwishState
st of
            Maybe RDFFormula
Nothing -> [Char] -> Either [Char] RDFFormula
forall a b. a -> Either a b
Left ([Char]
"Formula not present: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ScopedName -> [Char]
forall a. Show a => a -> [Char]
show ScopedName
nam)
            Just RDFFormula
gr -> RDFFormula -> Either [Char] RDFFormula
forall a b. b -> Either a b
Right RDFFormula
gr

ssGetList :: ScopedName -> SwishStateIO (Either String [RDFGraph])
ssGetList :: ScopedName -> SwishStateIO (Either [Char] [RDFGraph])
ssGetList ScopedName
nam = (SwishState -> Either [Char] [RDFGraph])
-> SwishStateIO (Either [Char] [RDFGraph])
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SwishState -> Either [Char] [RDFGraph]
find
    where
        find :: SwishState -> Either [Char] [RDFGraph]
find SwishState
st = case ScopedName -> SwishState -> Maybe [RDFGraph]
findGraph ScopedName
nam SwishState
st of
            Maybe [RDFGraph]
Nothing  -> [Char] -> Either [Char] [RDFGraph]
forall a b. a -> Either a b
Left ([Char]
"Graph or list not present: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ScopedName -> [Char]
forall a. Show a => a -> [Char]
show ScopedName
nam)
            Just [RDFGraph]
grs -> [RDFGraph] -> Either [Char] [RDFGraph]
forall a b. b -> Either a b
Right [RDFGraph]
grs

ssRead :: ScopedName -> Maybe URI -> SwishStateIO ()
ssRead :: ScopedName -> Maybe URI -> SwishStateIO ()
ssRead ScopedName
nam Maybe URI
muri = ScopedName
-> [SwishStateIO (Either [Char] RDFGraph)] -> SwishStateIO ()
ssAddGraph ScopedName
nam [Maybe URI -> SwishStateIO (Either [Char] RDFGraph)
ssReadGraph Maybe URI
muri]

ssReadGraph :: Maybe URI -> SwishStateIO (Either String RDFGraph)
ssReadGraph :: Maybe URI -> SwishStateIO (Either [Char] RDFGraph)
ssReadGraph Maybe URI
muri = 
  let gf :: Either [Char] Text -> Either [Char] RDFGraph
gf Either [Char] Text
inp = case Either [Char] Text
inp of
        Left  [Char]
es -> [Char] -> Either [Char] RDFGraph
forall a b. a -> Either a b
Left [Char]
es
        Right Text
is -> Text -> Maybe QName -> Either [Char] RDFGraph
parseN3 Text
is (Maybe URI
muri Maybe URI -> (URI -> Maybe QName) -> Maybe QName
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= URI -> Maybe QName
qnameFromURI)
        
  in Either [Char] Text -> Either [Char] RDFGraph
gf (Either [Char] Text -> Either [Char] RDFGraph)
-> StateT SwishState IO (Either [Char] Text)
-> SwishStateIO (Either [Char] RDFGraph)
forall a b.
(a -> b) -> StateT SwishState IO a -> StateT SwishState IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe URI -> StateT SwishState IO (Either [Char] Text)
getResourceData Maybe URI
muri

ssWriteList ::
    Maybe URI -> SwishStateIO (Either String [RDFGraph]) -> String
    -> SwishStateIO ()
ssWriteList :: Maybe URI
-> SwishStateIO (Either [Char] [RDFGraph])
-> [Char]
-> SwishStateIO ()
ssWriteList Maybe URI
muri SwishStateIO (Either [Char] [RDFGraph])
gf [Char]
comment = do
  Either [Char] [RDFGraph]
esgs <- SwishStateIO (Either [Char] [RDFGraph])
gf
  case Either [Char] [RDFGraph]
esgs of
    Left  [Char]
er   -> (SwishState -> SwishState) -> SwishStateIO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SwishState -> SwishState) -> SwishStateIO ())
-> (SwishState -> SwishState) -> SwishStateIO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> SwishState -> SwishState
setError ([Char]
"Cannot write list: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
er)
    Right []   -> Maybe URI -> Builder -> SwishStateIO ()
putResourceData Maybe URI
forall a. Maybe a
Nothing (Text -> Builder
B.fromLazyText ([Text] -> Text
L.concat [Text
"# ", [Char] -> Text
L.pack [Char]
comment, Text
"\n+ Swish: Writing empty list"]))
    Right [RDFGraph
gr] -> Maybe URI -> RDFGraph -> [Char] -> SwishStateIO ()
ssWriteGraph Maybe URI
muri RDFGraph
gr [Char]
comment
    Right [RDFGraph]
grs  -> ((Int, RDFGraph) -> SwishStateIO ())
-> [(Int, RDFGraph)] -> SwishStateIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Int, RDFGraph) -> SwishStateIO ()
forall {a}. Show a => (a, RDFGraph) -> SwishStateIO ()
writegr ([Int] -> [RDFGraph] -> [(Int, RDFGraph)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Int
0::Int)..] [RDFGraph]
grs)
      where
        writegr :: (a, RDFGraph) -> SwishStateIO ()
writegr (a
n,RDFGraph
gr) = Maybe URI -> RDFGraph -> [Char] -> SwishStateIO ()
ssWriteGraph (Maybe URI -> a -> Maybe URI
forall {p}. Show p => Maybe URI -> p -> Maybe URI
murin Maybe URI
muri a
n) RDFGraph
gr
                         ([Char]
"[" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"] " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
comment)
        murin :: Maybe URI -> p -> Maybe URI
murin Maybe URI
Nothing    p
_ = Maybe URI
forall a. Maybe a
Nothing
        murin (Just URI
uri) p
n = 
          let rp :: [Char]
rp = [Char] -> [Char]
forall a. [a] -> [a]
reverse ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ URI -> [Char]
uriPath URI
uri
              ([Char]
rLastSet, [Char]
rRest) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') [Char]
rp
              ([Char]
before, [Char]
after) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') ([Char] -> ([Char], [Char])) -> [Char] -> ([Char], [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
rLastSet
              newPath :: [Char]
newPath = [Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
rRest [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
before [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ p -> [Char]
forall a. Show a => a -> [Char]
show p
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
after
          in case [Char]
rLastSet of
            [Char]
"" -> [Char] -> Maybe URI
forall a. HasCallStack => [Char] -> a
error ([Char] -> Maybe URI) -> [Char] -> Maybe URI
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid URI (path ends in /): " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ URI -> [Char]
forall a. Show a => a -> [Char]
show URI
uri
            [Char]
_ -> URI -> Maybe URI
forall a. a -> Maybe a
Just (URI -> Maybe URI) -> URI -> Maybe URI
forall a b. (a -> b) -> a -> b
$ URI
uri { uriPath = newPath }
         
  

{-
ssWrite ::
    Maybe String -> SwishStateIO (Either String RDFGraph) -> String
    -> SwishStateIO ()
ssWrite muri gf comment =
        do  { esg <- gf
            ; case esg of
                Left  er -> modify $ setError ("Cannot write graph: "++er)
                Right gr -> ssWriteGraph muri gr comment
            }
-}

ssWriteGraph :: Maybe URI -> RDFGraph -> String -> SwishStateIO ()
ssWriteGraph :: Maybe URI -> RDFGraph -> [Char] -> SwishStateIO ()
ssWriteGraph Maybe URI
muri RDFGraph
gr [Char]
comment =
    Maybe URI -> Builder -> SwishStateIO ()
putResourceData Maybe URI
muri (Builder
c Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` RDFGraph -> Builder
formatGraphAsBuilder RDFGraph
gr)
    where
        c :: Builder
c = Text -> Builder
B.fromLazyText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
L.concat [Text
"# ", [Char] -> Text
L.pack [Char]
comment, Text
"\n"]

ssMerge ::
    ScopedName -> [SwishStateIO (Either String RDFGraph)]
    -> SwishStateIO ()
ssMerge :: ScopedName
-> [SwishStateIO (Either [Char] RDFGraph)] -> SwishStateIO ()
ssMerge ScopedName
nam [SwishStateIO (Either [Char] RDFGraph)]
gfs =
    let errmsg :: [Char]
errmsg = [Char]
"Graph merge not defined: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ScopedName -> [Char]
forall a. Show a => a -> [Char]
show ScopedName
nam [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"; "
    in
        do  { [Char] -> [Char] -> SwishStateIO ()
ssReportLabel [Char]
"Merge" (ScopedName -> [Char]
forall a. Show a => a -> [Char]
show ScopedName
nam)
            ; [Either [Char] RDFGraph]
esg <- [SwishStateIO (Either [Char] RDFGraph)]
-> StateT SwishState IO [Either [Char] RDFGraph]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [SwishStateIO (Either [Char] RDFGraph)]
gfs       -- [Either String RDFGraph]
            ; let egs :: Either [Char] [RDFGraph]
egs = [Either [Char] RDFGraph] -> Either [Char] [RDFGraph]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Either [Char] RDFGraph]
esg    -- Either String [RDFGraph]
            ; let fgs :: SwishState -> SwishState
fgs = case Either [Char] [RDFGraph]
egs of
                    Left  [Char]
er -> [Char] -> SwishState -> SwishState
setError  ([Char]
errmsg [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
er)
                    Right [] -> [Char] -> SwishState -> SwishState
setError  ([Char]
errmsg [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"No graphs to merge")
                    Right [RDFGraph]
gs -> (NamedGraphMap -> NamedGraphMap) -> SwishState -> SwishState
modGraphs (ScopedName -> [RDFGraph] -> NamedGraphMap -> NamedGraphMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ScopedName
nam [RDFGraph
g])
                            where g :: RDFGraph
g = (RDFGraph -> RDFGraph -> RDFGraph) -> [RDFGraph] -> RDFGraph
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 RDFGraph -> RDFGraph -> RDFGraph
forall lb. Label lb => NSGraph lb -> NSGraph lb -> NSGraph lb
merge [RDFGraph]
gs
            ; (SwishState -> SwishState) -> SwishStateIO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify SwishState -> SwishState
fgs
            }

ssCompare :: ScopedName -> ScopedName -> SwishStateIO ()
ssCompare :: ScopedName -> ScopedName -> SwishStateIO ()
ssCompare ScopedName
n1 ScopedName
n2 =
        do  { [Char] -> [Char] -> SwishStateIO ()
ssReportLabel [Char]
"Compare" (ScopedName -> [Char]
forall a. Show a => a -> [Char]
show ScopedName
n1 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ScopedName -> [Char]
forall a. Show a => a -> [Char]
show ScopedName
n2)
            ; Either [Char] RDFGraph
g1 <- ScopedName -> SwishStateIO (Either [Char] RDFGraph)
ssGetGraph ScopedName
n1
            ; Either [Char] RDFGraph
g2 <- ScopedName -> SwishStateIO (Either [Char] RDFGraph)
ssGetGraph ScopedName
n2
            ; Bool -> SwishStateIO () -> SwishStateIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Either [Char] RDFGraph
g1 Either [Char] RDFGraph -> Either [Char] RDFGraph -> Bool
forall a. Eq a => a -> a -> Bool
/= Either [Char] RDFGraph
g2) ((SwishState -> SwishState) -> SwishStateIO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SwishState -> SwishState) -> SwishStateIO ())
-> (SwishState -> SwishState) -> SwishStateIO ()
forall a b. (a -> b) -> a -> b
$ SwishStatus -> SwishState -> SwishState
setStatus SwishStatus
SwishGraphCompareError)
            }

ssAssertEq :: ScopedName -> ScopedName -> String -> SwishStateIO ()
ssAssertEq :: ScopedName -> ScopedName -> [Char] -> SwishStateIO ()
ssAssertEq ScopedName
n1 ScopedName
n2 [Char]
comment =
    let er1 :: [Char]
er1 = [Char]
":\n  Graph or list compare not performed:  invalid graph/list."
    in
        do  { [Char] -> [Char] -> SwishStateIO ()
ssReportLabel [Char]
"AssertEq" [Char]
comment
            ; Either [Char] [RDFGraph]
g1 <- ScopedName -> SwishStateIO (Either [Char] [RDFGraph])
ssGetList ScopedName
n1
            ; Either [Char] [RDFGraph]
g2 <- ScopedName -> SwishStateIO (Either [Char] [RDFGraph])
ssGetList ScopedName
n2
            ; case (Either [Char] [RDFGraph]
g1,Either [Char] [RDFGraph]
g2) of
                (Left [Char]
er,Either [Char] [RDFGraph]
_) -> (SwishState -> SwishState) -> SwishStateIO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SwishState -> SwishState) -> SwishStateIO ())
-> (SwishState -> SwishState) -> SwishStateIO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> SwishState -> SwishState
setError ([Char]
comment [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
er1 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n  " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
er)
                (Either [Char] [RDFGraph]
_,Left [Char]
er) -> (SwishState -> SwishState) -> SwishStateIO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SwishState -> SwishState) -> SwishStateIO ())
-> (SwishState -> SwishState) -> SwishStateIO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> SwishState -> SwishState
setError ([Char]
comment [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
er1 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n  " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
er)
                (Right [RDFGraph]
gr1,Right [RDFGraph]
gr2) -> 
                    Bool -> SwishStateIO () -> SwishStateIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([RDFGraph] -> Set RDFGraph
forall a. Ord a => [a] -> Set a
S.fromList [RDFGraph]
gr1 Set RDFGraph -> Set RDFGraph -> Bool
forall a. Eq a => a -> a -> Bool
/= [RDFGraph] -> Set RDFGraph
forall a. Ord a => [a] -> Set a
S.fromList [RDFGraph]
gr2) (SwishStateIO () -> SwishStateIO ())
-> SwishStateIO () -> SwishStateIO ()
forall a b. (a -> b) -> a -> b
$ (SwishState -> SwishState) -> SwishStateIO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SwishState -> SwishState) -> SwishStateIO ())
-> (SwishState -> SwishState) -> SwishStateIO ()
forall a b. (a -> b) -> a -> b
$
                      [Char] -> SwishState -> SwishState
setError ([Char]
comment [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":\n  Graph " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ScopedName -> [Char]
forall a. Show a => a -> [Char]
show ScopedName
n1
                                [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" differs from " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ScopedName -> [Char]
forall a. Show a => a -> [Char]
show ScopedName
n2 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".")
            }

ssAssertIn :: ScopedName -> ScopedName -> String -> SwishStateIO ()
ssAssertIn :: ScopedName -> ScopedName -> [Char] -> SwishStateIO ()
ssAssertIn ScopedName
n1 ScopedName
n2 [Char]
comment =
    let er1 :: [Char]
er1 = [Char]
":\n  Membership test not performed:  invalid graph."
        er2 :: [Char]
er2 = [Char]
":\n  Membership test not performed:  invalid list."
    in
        do  { [Char] -> [Char] -> SwishStateIO ()
ssReportLabel [Char]
"AssertIn" [Char]
comment
            ; Either [Char] RDFGraph
g1 <- ScopedName -> SwishStateIO (Either [Char] RDFGraph)
ssGetGraph ScopedName
n1
            ; Either [Char] [RDFGraph]
g2 <- ScopedName -> SwishStateIO (Either [Char] [RDFGraph])
ssGetList  ScopedName
n2
            ; case (Either [Char] RDFGraph
g1,Either [Char] [RDFGraph]
g2) of
                (Left [Char]
er,Either [Char] [RDFGraph]
_) -> (SwishState -> SwishState) -> SwishStateIO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SwishState -> SwishState) -> SwishStateIO ())
-> (SwishState -> SwishState) -> SwishStateIO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> SwishState -> SwishState
setError ([Char]
comment [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
er1 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n  " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
er)
                (Either [Char] RDFGraph
_,Left [Char]
er) -> (SwishState -> SwishState) -> SwishStateIO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SwishState -> SwishState) -> SwishStateIO ())
-> (SwishState -> SwishState) -> SwishStateIO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> SwishState -> SwishState
setError ([Char]
comment [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
er2 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n  " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
er)
                (Right RDFGraph
gr,Right [RDFGraph]
gs) ->
                    Bool -> SwishStateIO () -> SwishStateIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (RDFGraph
gr RDFGraph -> [RDFGraph] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [RDFGraph]
gs) (SwishStateIO () -> SwishStateIO ())
-> SwishStateIO () -> SwishStateIO ()
forall a b. (a -> b) -> a -> b
$ (SwishState -> SwishState) -> SwishStateIO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SwishState -> SwishState) -> SwishStateIO ())
-> (SwishState -> SwishState) -> SwishStateIO ()
forall a b. (a -> b) -> a -> b
$
                    [Char] -> SwishState -> SwishState
setError ([Char]
comment [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":\n  Graph " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ScopedName -> [Char]
forall a. Show a => a -> [Char]
show ScopedName
n1
                              [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not a member of " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ScopedName -> [Char]
forall a. Show a => a -> [Char]
show ScopedName
n2)
            }

--  Note:  this is probably incomplete, though it should work in simple cases.
--  A complete solution would have the binding modifiers subject to
--  re-arrangement to suit the actual bound variables encountered.
--  See VarBinding.findCompositions and VarBinding.findComposition
--
--  This code should be adequate if variable bindings are always used
--  in combinations consisting of a single modifier followed by any number
--  of filters.
--
ssDefineRule ::
    ScopedName
    -> [SwishStateIO (Either String RDFGraph)]
    -> SwishStateIO (Either String RDFGraph)
    -> [(ScopedName,[RDFLabel])]
    -> SwishStateIO ()
ssDefineRule :: ScopedName
-> [SwishStateIO (Either [Char] RDFGraph)]
-> SwishStateIO (Either [Char] RDFGraph)
-> [(ScopedName, [RDFLabel])]
-> SwishStateIO ()
ssDefineRule ScopedName
rn [SwishStateIO (Either [Char] RDFGraph)]
agfs SwishStateIO (Either [Char] RDFGraph)
cgf [(ScopedName, [RDFLabel])]
vmds =
    let errmsg1 :: [Char]
errmsg1 = [Char]
"Rule definition error in antecedent graph(s): "
        errmsg2 :: [Char]
errmsg2 = [Char]
"Rule definition error in consequent graph: "
        errmsg3 :: [Char]
errmsg3 = [Char]
"Rule definition error in variable modifier(s): "
        errmsg4 :: [Char]
errmsg4 = [Char]
"Incompatible variable binding modifier sequence"
    in
        do  { [Either [Char] RDFGraph]
aesg <- [SwishStateIO (Either [Char] RDFGraph)]
-> StateT SwishState IO [Either [Char] RDFGraph]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [SwishStateIO (Either [Char] RDFGraph)]
agfs     -- [Either String RDFGraph]
            ; let ags :: Either [Char] [RDFGraph]
ags = [Either [Char] RDFGraph] -> Either [Char] [RDFGraph]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Either [Char] RDFGraph]
aesg   :: Either String [RDFGraph]
            ; Either [Char] RDFGraph
cg <- SwishStateIO (Either [Char] RDFGraph)
cgf                 -- Either String RDFGraph
            ; let vmfs :: [SwishStateIO (Either [Char] RDFVarBindingModify)]
vmfs = ((ScopedName, [RDFLabel])
 -> SwishStateIO (Either [Char] RDFVarBindingModify))
-> [(ScopedName, [RDFLabel])]
-> [SwishStateIO (Either [Char] RDFVarBindingModify)]
forall a b. (a -> b) -> [a] -> [b]
map (ScopedName, [RDFLabel])
-> SwishStateIO (Either [Char] RDFVarBindingModify)
ssFindVarModify [(ScopedName, [RDFLabel])]
vmds
            ; [Either [Char] RDFVarBindingModify]
evms <- [SwishStateIO (Either [Char] RDFVarBindingModify)]
-> StateT SwishState IO [Either [Char] RDFVarBindingModify]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [SwishStateIO (Either [Char] RDFVarBindingModify)]
vmfs     -- [Either String RDFVarBindingModify]
            ; let vms :: Either [Char] [RDFVarBindingModify]
vms = [Either [Char] RDFVarBindingModify]
-> Either [Char] [RDFVarBindingModify]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Either [Char] RDFVarBindingModify]
evms   :: Either String [RDFVarBindingModify]
            ; let frl :: SwishState -> SwishState
frl = case (Either [Char] [RDFGraph]
ags,Either [Char] RDFGraph
cg,Either [Char] [RDFVarBindingModify]
vms) of
                    (Left [Char]
er,Either [Char] RDFGraph
_,Either [Char] [RDFVarBindingModify]
_) -> [Char] -> SwishState -> SwishState
setError ([Char]
errmsg1 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
er)
                    (Either [Char] [RDFGraph]
_,Left [Char]
er,Either [Char] [RDFVarBindingModify]
_) -> [Char] -> SwishState -> SwishState
setError ([Char]
errmsg2 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
er)
                    (Either [Char] [RDFGraph]
_,Either [Char] RDFGraph
_,Left [Char]
er) -> [Char] -> SwishState -> SwishState
setError ([Char]
errmsg3 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
er)
                    (Right [RDFGraph]
agrs,Right RDFGraph
cgr,Right [RDFVarBindingModify]
vbms) ->
                        let
                            newRule :: RDFVarBindingModify -> RDFRule
newRule = ScopedName
-> [RDFGraph] -> RDFGraph -> RDFVarBindingModify -> RDFRule
makeRDFClosureRule ScopedName
rn [RDFGraph]
agrs RDFGraph
cgr
                        in
                        case [RDFVarBindingModify] -> Maybe RDFVarBindingModify
forall a b.
Eq a =>
[VarBindingModify a b] -> Maybe (VarBindingModify a b)
composeSequence [RDFVarBindingModify]
vbms of
                            Just RDFVarBindingModify
vm -> let nr :: RDFRule
nr = RDFVarBindingModify -> RDFRule
newRule RDFVarBindingModify
vm in (RDFRuleMap -> RDFRuleMap) -> SwishState -> SwishState
modRules (ScopedName -> RDFRule -> RDFRuleMap -> RDFRuleMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (RDFRule -> ScopedName
forall ex. Rule ex -> ScopedName
ruleName RDFRule
nr) RDFRule
nr)
                            Maybe RDFVarBindingModify
Nothing -> [Char] -> SwishState -> SwishState
setError [Char]
errmsg4
            ; (SwishState -> SwishState) -> SwishStateIO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify SwishState -> SwishState
frl
            }

ssFindVarModify ::
    (ScopedName,[RDFLabel]) -> SwishStateIO (Either String RDFVarBindingModify)
ssFindVarModify :: (ScopedName, [RDFLabel])
-> SwishStateIO (Either [Char] RDFVarBindingModify)
ssFindVarModify (ScopedName
nam,[RDFLabel]
lbs) = (SwishState -> Either [Char] RDFVarBindingModify)
-> SwishStateIO (Either [Char] RDFVarBindingModify)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((SwishState -> Either [Char] RDFVarBindingModify)
 -> SwishStateIO (Either [Char] RDFVarBindingModify))
-> (SwishState -> Either [Char] RDFVarBindingModify)
-> SwishStateIO (Either [Char] RDFVarBindingModify)
forall a b. (a -> b) -> a -> b
$ \SwishState
st ->
  case ScopedName -> SwishState -> Maybe RDFOpenVarBindingModify
findOpenVarModify ScopedName
nam SwishState
st of
    Just RDFOpenVarBindingModify
ovbm -> RDFVarBindingModify -> Either [Char] RDFVarBindingModify
forall a b. b -> Either a b
Right (RDFOpenVarBindingModify
ovbm [RDFLabel]
lbs)
    Maybe RDFOpenVarBindingModify
Nothing   -> [Char] -> Either [Char] RDFVarBindingModify
forall a b. a -> Either a b
Left  ([Char]
"Undefined modifier: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ScopedName -> [Char]
forall a. Show a => a -> [Char]
show ScopedName
nam)

ssDefineRuleset ::
    ScopedName
    -> [ScopedName]
    -> [ScopedName]
    -> SwishStateIO ()
ssDefineRuleset :: ScopedName -> [ScopedName] -> [ScopedName] -> SwishStateIO ()
ssDefineRuleset ScopedName
sn [ScopedName]
ans [ScopedName]
rns =
    let errmsg1 :: [Char]
errmsg1 = [Char]
"Error in ruleset axiom(s): "
        errmsg2 :: [Char]
errmsg2 = [Char]
"Error in ruleset rule(s): "
    in
        do  { let agfs :: SwishStateIO [Either [Char] RDFFormula]
agfs = (ScopedName -> SwishStateIO (Either [Char] RDFFormula))
-> [ScopedName] -> SwishStateIO [Either [Char] RDFFormula]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ScopedName -> SwishStateIO (Either [Char] RDFFormula)
ssGetFormula [ScopedName]
ans
                                        :: SwishStateIO [Either String RDFFormula]
            ; [Either [Char] RDFFormula]
aesg <- SwishStateIO [Either [Char] RDFFormula]
agfs              -- [Either String RDFFormula]
            ; let eags :: Either [Char] [RDFFormula]
eags = [Either [Char] RDFFormula] -> Either [Char] [RDFFormula]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Either [Char] RDFFormula]
aesg  :: Either String [RDFFormula]
            ; let erlf :: SwishStateIO [Either [Char] RDFRule]
erlf = (ScopedName -> StateT SwishState IO (Either [Char] RDFRule))
-> [ScopedName] -> SwishStateIO [Either [Char] RDFRule]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ScopedName -> StateT SwishState IO (Either [Char] RDFRule)
ssFindRule [ScopedName]
rns
                                        :: SwishStateIO [Either String RDFRule]
            ; [Either [Char] RDFRule]
rles <- SwishStateIO [Either [Char] RDFRule]
erlf              -- [Either String RDFRule]
            ; let erls :: Either [Char] [RDFRule]
erls = [Either [Char] RDFRule] -> Either [Char] [RDFRule]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Either [Char] RDFRule]
rles  :: Either String [RDFRule]
            ; let frs :: SwishState -> SwishState
frs = case (Either [Char] [RDFFormula]
eags,Either [Char] [RDFRule]
erls) of
                    (Left [Char]
er,Either [Char] [RDFRule]
_) -> [Char] -> SwishState -> SwishState
setError ([Char]
errmsg1 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
er)
                    (Either [Char] [RDFFormula]
_,Left [Char]
er) -> [Char] -> SwishState -> SwishState
setError ([Char]
errmsg2 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
er)
                    (Right [RDFFormula]
ags,Right [RDFRule]
rls) ->
                        (RDFRulesetMap -> RDFRulesetMap) -> SwishState -> SwishState
modRulesets (Namespace -> RDFRuleset -> RDFRulesetMap -> RDFRulesetMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (RDFRuleset -> Namespace
forall ex. Ruleset ex -> Namespace
getRulesetNamespace RDFRuleset
rs) RDFRuleset
rs)
                        where
                            rs :: RDFRuleset
rs = Namespace -> [RDFFormula] -> [RDFRule] -> RDFRuleset
forall ex. Namespace -> [Formula ex] -> [Rule ex] -> Ruleset ex
makeRuleset (ScopedName -> Namespace
getScopeNamespace ScopedName
sn) [RDFFormula]
ags [RDFRule]
rls
            ; (SwishState -> SwishState) -> SwishStateIO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify SwishState -> SwishState
frs
            }

ssFindRule :: ScopedName -> SwishStateIO (Either String RDFRule)
ssFindRule :: ScopedName -> StateT SwishState IO (Either [Char] RDFRule)
ssFindRule ScopedName
nam = (SwishState -> Either [Char] RDFRule)
-> StateT SwishState IO (Either [Char] RDFRule)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SwishState -> Either [Char] RDFRule
find
    where
        find :: SwishState -> Either [Char] RDFRule
find SwishState
st = case ScopedName -> SwishState -> Maybe RDFRule
findRule ScopedName
nam SwishState
st of
            Maybe RDFRule
Nothing -> [Char] -> Either [Char] RDFRule
forall a b. a -> Either a b
Left ([Char]
"Rule not found: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ScopedName -> [Char]
forall a. Show a => a -> [Char]
show ScopedName
nam)
            Just RDFRule
rl -> RDFRule -> Either [Char] RDFRule
forall a b. b -> Either a b
Right RDFRule
rl

ssDefineConstraints  ::
    ScopedName
    -> [SwishStateIO (Either String RDFGraph)]
    -> [ScopedName]
    -> SwishStateIO ()
ssDefineConstraints :: ScopedName
-> [SwishStateIO (Either [Char] RDFGraph)]
-> [ScopedName]
-> SwishStateIO ()
ssDefineConstraints  ScopedName
sn [SwishStateIO (Either [Char] RDFGraph)]
cgfs [ScopedName]
dtns =
    let errmsg1 :: [Char]
errmsg1 = [Char]
"Error in constraint graph(s): "
        errmsg2 :: [Char]
errmsg2 = [Char]
"Error in datatype(s): "
    in
        do  { [Either [Char] RDFGraph]
cges <- [SwishStateIO (Either [Char] RDFGraph)]
-> StateT SwishState IO [Either [Char] RDFGraph]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [SwishStateIO (Either [Char] RDFGraph)]
cgfs     -- [Either String RDFGraph]
            ; let ecgs :: Either [Char] [RDFGraph]
ecgs = [Either [Char] RDFGraph] -> Either [Char] [RDFGraph]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Either [Char] RDFGraph]
cges  :: Either String [RDFGraph]
            ; let ecgr :: Either [Char] RDFGraph
ecgr = case Either [Char] [RDFGraph]
ecgs of
                    Left [Char]
er   -> [Char] -> Either [Char] RDFGraph
forall a b. a -> Either a b
Left [Char]
er
                    Right []  -> RDFGraph -> Either [Char] RDFGraph
forall a b. b -> Either a b
Right RDFGraph
forall a. Monoid a => a
mempty
                    Right [RDFGraph]
grs -> RDFGraph -> Either [Char] RDFGraph
forall a b. b -> Either a b
Right (RDFGraph -> Either [Char] RDFGraph)
-> RDFGraph -> Either [Char] RDFGraph
forall a b. (a -> b) -> a -> b
$ (RDFGraph -> RDFGraph -> RDFGraph) -> [RDFGraph] -> RDFGraph
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 RDFGraph -> RDFGraph -> RDFGraph
forall lb. Label lb => NSGraph lb -> NSGraph lb -> NSGraph lb
merge [RDFGraph]
grs
            ; [Either [Char] RDFDatatype]
edtf <- (ScopedName -> StateT SwishState IO (Either [Char] RDFDatatype))
-> [ScopedName] -> StateT SwishState IO [Either [Char] RDFDatatype]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ScopedName -> StateT SwishState IO (Either [Char] RDFDatatype)
ssFindDatatype [ScopedName]
dtns
                                        -- [Either String RDFDatatype]
            ; let edts :: Either [Char] [RDFDatatype]
edts = [Either [Char] RDFDatatype] -> Either [Char] [RDFDatatype]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Either [Char] RDFDatatype]
edtf   :: Either String [RDFDatatype]
            ; let frs :: SwishState -> SwishState
frs = case (Either [Char] RDFGraph
ecgr,Either [Char] [RDFDatatype]
edts) of
                    (Left [Char]
er,Either [Char] [RDFDatatype]
_) -> [Char] -> SwishState -> SwishState
setError ([Char]
errmsg1 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
er)
                    (Either [Char] RDFGraph
_,Left [Char]
er) -> [Char] -> SwishState -> SwishState
setError ([Char]
errmsg2 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
er)
                    (Right RDFGraph
cgr,Right [RDFDatatype]
dts) ->
                        (RDFRulesetMap -> RDFRulesetMap) -> SwishState -> SwishState
modRulesets (Namespace -> RDFRuleset -> RDFRulesetMap -> RDFRulesetMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (RDFRuleset -> Namespace
forall ex. Ruleset ex -> Namespace
getRulesetNamespace RDFRuleset
rs) RDFRuleset
rs)
                        where
                            rs :: RDFRuleset
rs  = Namespace -> [RDFFormula] -> [RDFRule] -> RDFRuleset
forall ex. Namespace -> [Formula ex] -> [Rule ex] -> Ruleset ex
makeRuleset (ScopedName -> Namespace
getScopeNamespace ScopedName
sn) [] [RDFRule]
rls
                            rls :: [RDFRule]
rls = (RDFDatatype -> [RDFRule]) -> [RDFDatatype] -> [RDFRule]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (RDFDatatype -> RDFGraph -> [RDFRule]
forall ex lb vn. Datatype ex lb vn -> ex -> [Rule ex]
`typeMkRules` RDFGraph
cgr) [RDFDatatype]
dts
            ; (SwishState -> SwishState) -> SwishStateIO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify SwishState -> SwishState
frs
            }

ssFindDatatype :: ScopedName -> SwishStateIO (Either String RDFDatatype)
ssFindDatatype :: ScopedName -> StateT SwishState IO (Either [Char] RDFDatatype)
ssFindDatatype ScopedName
nam = (SwishState -> Either [Char] RDFDatatype)
-> StateT SwishState IO (Either [Char] RDFDatatype)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SwishState -> Either [Char] RDFDatatype
find
    where
        find :: SwishState -> Either [Char] RDFDatatype
find SwishState
st = case ScopedName -> SwishState -> Maybe RDFDatatype
findDatatype ScopedName
nam SwishState
st of
            Maybe RDFDatatype
Nothing -> [Char] -> Either [Char] RDFDatatype
forall a b. a -> Either a b
Left ([Char]
"Datatype not found: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ScopedName -> [Char]
forall a. Show a => a -> [Char]
show ScopedName
nam)
            Just RDFDatatype
dt -> RDFDatatype -> Either [Char] RDFDatatype
forall a b. b -> Either a b
Right RDFDatatype
dt


ssCheckProof ::
    ScopedName                                      -- proof name
    -> [ScopedName]                                 -- ruleset names
    -> SwishStateIO (Either String RDFFormula)      -- input formula
    -> [Either String [RDFRuleset]                  -- proof step from rulesets
        -> SwishStateIO (Either String RDFProofStep)]
    -> SwishStateIO (Either String RDFFormula)      -- result formula
    -> SwishStateIO ()
ssCheckProof :: ScopedName
-> [ScopedName]
-> SwishStateIO (Either [Char] RDFFormula)
-> [Either [Char] [RDFRuleset]
    -> SwishStateIO (Either [Char] RDFProofStep)]
-> SwishStateIO (Either [Char] RDFFormula)
-> SwishStateIO ()
ssCheckProof ScopedName
pn [ScopedName]
sns SwishStateIO (Either [Char] RDFFormula)
igf [Either [Char] [RDFRuleset]
 -> SwishStateIO (Either [Char] RDFProofStep)]
stfs SwishStateIO (Either [Char] RDFFormula)
rgf =
    let
        infmsg1 :: [Char]
infmsg1 = [Char]
"Proof satisfied: "
        errmsg1 :: [Char]
errmsg1 = [Char]
"Error in proof ruleset(s): "
        errmsg2 :: [Char]
errmsg2 = [Char]
"Error in proof input: "
        errmsg3 :: [Char]
errmsg3 = [Char]
"Error in proof step(s): "
        errmsg4 :: [Char]
errmsg4 = [Char]
"Error in proof goal: "
        errmsg5 :: [Char]
errmsg5 = [Char]
"Proof not satisfied: "
        proofname :: [Char]
proofname = [Char]
" (Proof " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ScopedName -> [Char]
forall a. Show a => a -> [Char]
show ScopedName
pn [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"
    in
        do  { let rs1 :: [SwishStateIO (Either [Char] RDFRuleset)]
rs1 = (ScopedName -> SwishStateIO (Either [Char] RDFRuleset))
-> [ScopedName] -> [SwishStateIO (Either [Char] RDFRuleset)]
forall a b. (a -> b) -> [a] -> [b]
map ScopedName -> SwishStateIO (Either [Char] RDFRuleset)
ssFindRuleset [ScopedName]
sns       :: [SwishStateIO (Either String RDFRuleset)]
            ; [Either [Char] RDFRuleset]
rs2 <- [SwishStateIO (Either [Char] RDFRuleset)]
-> StateT SwishState IO [Either [Char] RDFRuleset]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [SwishStateIO (Either [Char] RDFRuleset)]
rs1                   -- [Either String RDFRuleset]
            ; let erss :: Either [Char] [RDFRuleset]
erss = [Either [Char] RDFRuleset] -> Either [Char] [RDFRuleset]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Either [Char] RDFRuleset]
rs2               :: Either String [RDFRuleset]
            ; Either [Char] RDFFormula
eig <- SwishStateIO (Either [Char] RDFFormula)
igf                            -- Either String RDFFormula
            ; let st1 :: SwishStateIO [Either [Char] RDFProofStep]
st1  = [SwishStateIO (Either [Char] RDFProofStep)]
-> SwishStateIO [Either [Char] RDFProofStep]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([SwishStateIO (Either [Char] RDFProofStep)]
 -> SwishStateIO [Either [Char] RDFProofStep])
-> [SwishStateIO (Either [Char] RDFProofStep)]
-> SwishStateIO [Either [Char] RDFProofStep]
forall a b. (a -> b) -> a -> b
$ [Either [Char] [RDFRuleset]
 -> SwishStateIO (Either [Char] RDFProofStep)]
-> Either [Char] [RDFRuleset]
-> [SwishStateIO (Either [Char] RDFProofStep)]
forall a b. [a -> b] -> a -> [b]
flist [Either [Char] [RDFRuleset]
 -> SwishStateIO (Either [Char] RDFProofStep)]
stfs Either [Char] [RDFRuleset]
erss :: SwishStateIO [Either String RDFProofStep]
            ; [Either [Char] RDFProofStep]
st2 <- SwishStateIO [Either [Char] RDFProofStep]
st1                            -- [Either String RDFProofStep]
            ; let ests :: Either [Char] [RDFProofStep]
ests = [Either [Char] RDFProofStep] -> Either [Char] [RDFProofStep]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Either [Char] RDFProofStep]
st2               :: Either String [RDFProofStep]
            ; Either [Char] RDFFormula
erg  <- SwishStateIO (Either [Char] RDFFormula)
rgf                           -- Either String RDFFormula
            ; let proof :: Either [Char] RDFProof
proof = case (Either [Char] [RDFRuleset]
erss,Either [Char] RDFFormula
eig,Either [Char] [RDFProofStep]
ests,Either [Char] RDFFormula
erg) of
                    (Left [Char]
er,Either [Char] RDFFormula
_,Either [Char] [RDFProofStep]
_,Either [Char] RDFFormula
_) -> [Char] -> Either [Char] RDFProof
forall a b. a -> Either a b
Left ([Char]
errmsg1 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
er [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
proofname)
                    (Either [Char] [RDFRuleset]
_,Left [Char]
er,Either [Char] [RDFProofStep]
_,Either [Char] RDFFormula
_) -> [Char] -> Either [Char] RDFProof
forall a b. a -> Either a b
Left ([Char]
errmsg2 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
er [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
proofname)
                    (Either [Char] [RDFRuleset]
_,Either [Char] RDFFormula
_,Left [Char]
er,Either [Char] RDFFormula
_) -> [Char] -> Either [Char] RDFProof
forall a b. a -> Either a b
Left ([Char]
errmsg3 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
er [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
proofname)
                    (Either [Char] [RDFRuleset]
_,Either [Char] RDFFormula
_,Either [Char] [RDFProofStep]
_,Left [Char]
er) -> [Char] -> Either [Char] RDFProof
forall a b. a -> Either a b
Left ([Char]
errmsg4 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
er [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
proofname)
                    (Right [RDFRuleset]
rss, Right RDFFormula
ig, Right [RDFProofStep]
sts, Right RDFFormula
rg) ->
                        RDFProof -> Either [Char] RDFProof
forall a b. b -> Either a b
Right ([RDFRuleset]
-> RDFFormula -> RDFFormula -> [RDFProofStep] -> RDFProof
makeRDFProof [RDFRuleset]
rss RDFFormula
ig RDFFormula
rg [RDFProofStep]
sts)
            ; Bool -> SwishStateIO () -> SwishStateIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
False (SwishStateIO () -> SwishStateIO ())
-> SwishStateIO () -> SwishStateIO ()
forall a b. (a -> b) -> a -> b
$ case Either [Char] RDFProof
proof of
                    (Left  [Char]
_)  -> () -> SwishStateIO ()
forall a. a -> StateT SwishState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    (Right RDFProof
pr) -> Maybe URI -> Builder -> SwishStateIO ()
putResourceData Maybe URI
forall a. Maybe a
Nothing (Builder -> SwishStateIO ()) -> Builder -> SwishStateIO ()
forall a b. (a -> b) -> a -> b
$
                                    Text -> Builder
B.fromLazyText ([Text] -> Text
L.concat [Text
"Proof ", [Char] -> Text
L.pack (ScopedName -> [Char]
forall a. Show a => a -> [Char]
show ScopedName
pn), Text
"\n"])
                                    Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
                                    [Char] -> Builder
B.fromString ([Char] -> RDFProof -> [Char] -> [Char]
forall ex. ShowLines ex => [Char] -> Proof ex -> [Char] -> [Char]
showsProof [Char]
"\n" RDFProof
pr [Char]
"\n")
                                    -- TODO: clean up
            ; let checkproof :: SwishState -> SwishState
checkproof = case Either [Char] RDFProof
proof of
                    (Left  [Char]
er) -> [Char] -> SwishState -> SwishState
setError [Char]
er
                    (Right RDFProof
pr) ->
                        case RDFProof -> Maybe [Char]
forall ex. (Expression ex, Ord ex) => Proof ex -> Maybe [Char]
explainProof RDFProof
pr of
                            Maybe [Char]
Nothing -> [Char] -> SwishState -> SwishState
setInfo ([Char]
infmsg1 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ScopedName -> [Char]
forall a. Show a => a -> [Char]
show ScopedName
pn)
                            Just [Char]
ex -> [Char] -> SwishState -> SwishState
setError ([Char]
errmsg5 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ScopedName -> [Char]
forall a. Show a => a -> [Char]
show ScopedName
pn [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
ex)
                        {-
                        if not $ checkProof pr then
                            setError (errmsg5++show pn)
                        else
                            setInfo (infmsg1++show pn)
                        -}
            ; (SwishState -> SwishState) -> SwishStateIO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify SwishState -> SwishState
checkproof
            }

ssCheckStep ::
    ScopedName                                      -- rule name
    -> [SwishStateIO (Either String RDFFormula)]    -- antecedent graph formulae
    -> SwishStateIO (Either String RDFFormula)      -- consequent graph formula
    -> Either String [RDFRuleset]                   -- rulesets
    -> SwishStateIO (Either String RDFProofStep)    -- resulting proof step
ssCheckStep :: ScopedName
-> [SwishStateIO (Either [Char] RDFFormula)]
-> SwishStateIO (Either [Char] RDFFormula)
-> Either [Char] [RDFRuleset]
-> SwishStateIO (Either [Char] RDFProofStep)
ssCheckStep ScopedName
_  [SwishStateIO (Either [Char] RDFFormula)]
_    SwishStateIO (Either [Char] RDFFormula)
_    (Left  [Char]
er)  = Either [Char] RDFProofStep
-> SwishStateIO (Either [Char] RDFProofStep)
forall a. a -> StateT SwishState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] RDFProofStep
 -> SwishStateIO (Either [Char] RDFProofStep))
-> Either [Char] RDFProofStep
-> SwishStateIO (Either [Char] RDFProofStep)
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] RDFProofStep
forall a b. a -> Either a b
Left [Char]
er
ssCheckStep ScopedName
rn [SwishStateIO (Either [Char] RDFFormula)]
eagf SwishStateIO (Either [Char] RDFFormula)
ecgf (Right [RDFRuleset]
rss) =
    let
        errmsg1 :: [Char]
errmsg1 = [Char]
"Rule not in proof step ruleset(s): "
        errmsg2 :: [Char]
errmsg2 = [Char]
"Error in proof step antecedent graph(s): "
        errmsg3 :: [Char]
errmsg3 = [Char]
"Error in proof step consequent graph: "
    in
        do  { let mrul :: Maybe RDFRule
mrul = ScopedName -> [RDFRuleset] -> Maybe RDFRule
forall ex. ScopedName -> [Ruleset ex] -> Maybe (Rule ex)
getMaybeContextRule ScopedName
rn [RDFRuleset]
rss :: Maybe RDFRule
            ; [Either [Char] RDFFormula]
esag <- [SwishStateIO (Either [Char] RDFFormula)]
-> SwishStateIO [Either [Char] RDFFormula]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [SwishStateIO (Either [Char] RDFFormula)]
eagf                 -- [Either String RDFFormula]]
            ; let eags :: Either [Char] [RDFFormula]
eags = [Either [Char] RDFFormula] -> Either [Char] [RDFFormula]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Either [Char] RDFFormula]
esag              :: Either String [RDFFormula]
            ; Either [Char] RDFFormula
ecg  <- SwishStateIO (Either [Char] RDFFormula)
ecgf                          -- Either String RDFFormula
            ; let est :: Either [Char] RDFProofStep
est = case (Maybe RDFRule
mrul,Either [Char] [RDFFormula]
eags,Either [Char] RDFFormula
ecg) of
                    (Maybe RDFRule
Nothing,Either [Char] [RDFFormula]
_,Either [Char] RDFFormula
_) -> [Char] -> Either [Char] RDFProofStep
forall a b. a -> Either a b
Left ([Char]
errmsg1 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ScopedName -> [Char]
forall a. Show a => a -> [Char]
show ScopedName
rn)
                    (Maybe RDFRule
_,Left [Char]
er,Either [Char] RDFFormula
_) -> [Char] -> Either [Char] RDFProofStep
forall a b. a -> Either a b
Left ([Char]
errmsg2 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
er)
                    (Maybe RDFRule
_,Either [Char] [RDFFormula]
_,Left [Char]
er) -> [Char] -> Either [Char] RDFProofStep
forall a b. a -> Either a b
Left ([Char]
errmsg3 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
er)
                    (Just RDFRule
rul,Right [RDFFormula]
ags,Right RDFFormula
cg) ->
                        RDFProofStep -> Either [Char] RDFProofStep
forall a b. b -> Either a b
Right (RDFProofStep -> Either [Char] RDFProofStep)
-> RDFProofStep -> Either [Char] RDFProofStep
forall a b. (a -> b) -> a -> b
$ RDFRule -> [RDFFormula] -> RDFFormula -> RDFProofStep
makeRDFProofStep RDFRule
rul [RDFFormula]
ags RDFFormula
cg
            ; Either [Char] RDFProofStep
-> SwishStateIO (Either [Char] RDFProofStep)
forall a. a -> StateT SwishState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Either [Char] RDFProofStep
est
            }

ssFwdChain ::
    ScopedName                                      -- ruleset name
    -> ScopedName                                   -- rule name
    -> [SwishStateIO (Either String RDFGraph)]      -- antecedent graphs
    -> ScopedName                                   -- consequent graph name
    -> NamespaceMap                                 -- prefixes for new graph
    -> SwishStateIO ()
ssFwdChain :: ScopedName
-> ScopedName
-> [SwishStateIO (Either [Char] RDFGraph)]
-> ScopedName
-> NamespaceMap
-> SwishStateIO ()
ssFwdChain ScopedName
sn ScopedName
rn [SwishStateIO (Either [Char] RDFGraph)]
agfs ScopedName
cn NamespaceMap
prefs =
    let
        errmsg1 :: [Char]
errmsg1 = [Char]
"FwdChain rule error: "
        errmsg2 :: [Char]
errmsg2 = [Char]
"FwdChain antecedent error: "
    in
        do  { Either [Char] RDFRule
erl  <- ScopedName
-> ScopedName -> StateT SwishState IO (Either [Char] RDFRule)
ssFindRulesetRule ScopedName
sn ScopedName
rn
            ; [Either [Char] RDFGraph]
aesg <- [SwishStateIO (Either [Char] RDFGraph)]
-> StateT SwishState IO [Either [Char] RDFGraph]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [SwishStateIO (Either [Char] RDFGraph)]
agfs     -- [Either String RDFGraph]
            ; let eags :: Either [Char] [RDFGraph]
eags = [Either [Char] RDFGraph] -> Either [Char] [RDFGraph]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Either [Char] RDFGraph]
aesg   :: Either String [RDFGraph]
            ; let fcr :: SwishState -> SwishState
fcr = case (Either [Char] RDFRule
erl,Either [Char] [RDFGraph]
eags) of
                    (Left [Char]
er,Either [Char] [RDFGraph]
_) -> [Char] -> SwishState -> SwishState
setError ([Char]
errmsg1 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
er)
                    (Either [Char] RDFRule
_,Left [Char]
er) -> [Char] -> SwishState -> SwishState
setError ([Char]
errmsg2 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
er)
                    (Right RDFRule
rl,Right [RDFGraph]
ags) ->
                        (NamedGraphMap -> NamedGraphMap) -> SwishState -> SwishState
modGraphs (ScopedName -> [RDFGraph] -> NamedGraphMap -> NamedGraphMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ScopedName
cn [RDFGraph
cg])
                        where
                            cg :: RDFGraph
cg = case RDFRule -> [RDFGraph] -> [RDFGraph]
forall ex. Rule ex -> [ex] -> [ex]
fwdApply RDFRule
rl [RDFGraph]
ags of
                                []  -> RDFGraph
forall a. Monoid a => a
mempty
                                [RDFGraph]
grs -> NamespaceMap -> RDFGraph -> RDFGraph
forall lb. NamespaceMap -> NSGraph lb -> NSGraph lb
setNamespaces NamespaceMap
prefs (RDFGraph -> RDFGraph) -> RDFGraph -> RDFGraph
forall a b. (a -> b) -> a -> b
$ (RDFGraph -> RDFGraph -> RDFGraph) -> [RDFGraph] -> RDFGraph
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 RDFGraph -> RDFGraph -> RDFGraph
forall (lg :: * -> *) lb.
(LDGraph lg lb, Ord lb) =>
lg lb -> lg lb -> lg lb
addGraphs [RDFGraph]
grs
            ; (SwishState -> SwishState) -> SwishStateIO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify SwishState -> SwishState
fcr
            }

ssFindRulesetRule ::
    ScopedName -> ScopedName -> SwishStateIO (Either String RDFRule)
ssFindRulesetRule :: ScopedName
-> ScopedName -> StateT SwishState IO (Either [Char] RDFRule)
ssFindRulesetRule ScopedName
sn ScopedName
rn = (SwishState -> Either [Char] RDFRule)
-> StateT SwishState IO (Either [Char] RDFRule)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SwishState -> Either [Char] RDFRule
find
    where
        find :: SwishState -> Either [Char] RDFRule
find SwishState
st = case ScopedName -> SwishState -> Maybe RDFRuleset
findRuleset ScopedName
sn SwishState
st of
            Maybe RDFRuleset
Nothing -> [Char] -> Either [Char] RDFRule
forall a b. a -> Either a b
Left ([Char]
"Ruleset not found: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ScopedName -> [Char]
forall a. Show a => a -> [Char]
show ScopedName
sn)
            Just RDFRuleset
rs -> RDFRuleset -> Either [Char] RDFRule
forall {ex}. Ruleset ex -> Either [Char] (Rule ex)
find1 RDFRuleset
rs
        find1 :: Ruleset ex -> Either [Char] (Rule ex)
find1 Ruleset ex
rs = case ScopedName -> Ruleset ex -> Maybe (Rule ex)
forall ex. ScopedName -> Ruleset ex -> Maybe (Rule ex)
getRulesetRule ScopedName
rn Ruleset ex
rs of
            Maybe (Rule ex)
Nothing -> [Char] -> Either [Char] (Rule ex)
forall a b. a -> Either a b
Left ([Char]
"Rule not in ruleset: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ScopedName -> [Char]
forall a. Show a => a -> [Char]
show ScopedName
sn [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ScopedName -> [Char]
forall a. Show a => a -> [Char]
show ScopedName
rn)
            Just Rule ex
rl -> Rule ex -> Either [Char] (Rule ex)
forall a b. b -> Either a b
Right Rule ex
rl

ssFindRuleset ::
    ScopedName -> SwishStateIO (Either String RDFRuleset)
ssFindRuleset :: ScopedName -> SwishStateIO (Either [Char] RDFRuleset)
ssFindRuleset ScopedName
sn = (SwishState -> Either [Char] RDFRuleset)
-> SwishStateIO (Either [Char] RDFRuleset)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SwishState -> Either [Char] RDFRuleset
find
    where
        find :: SwishState -> Either [Char] RDFRuleset
find SwishState
st = case ScopedName -> SwishState -> Maybe RDFRuleset
findRuleset ScopedName
sn SwishState
st of
            Maybe RDFRuleset
Nothing -> [Char] -> Either [Char] RDFRuleset
forall a b. a -> Either a b
Left ([Char]
"Ruleset not found: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ScopedName -> [Char]
forall a. Show a => a -> [Char]
show ScopedName
sn)
            Just RDFRuleset
rs -> RDFRuleset -> Either [Char] RDFRuleset
forall a b. b -> Either a b
Right RDFRuleset
rs

ssBwdChain ::
    ScopedName                                      -- ruleset name
    -> ScopedName                                   -- rule name
    -> SwishStateIO (Either String RDFGraph)        -- consequent graphs
    -> ScopedName                                   -- antecedent alts name
    -> NamespaceMap                                 -- prefixes for new graphs
    -> SwishStateIO ()
ssBwdChain :: ScopedName
-> ScopedName
-> SwishStateIO (Either [Char] RDFGraph)
-> ScopedName
-> NamespaceMap
-> SwishStateIO ()
ssBwdChain ScopedName
sn ScopedName
rn SwishStateIO (Either [Char] RDFGraph)
cgf ScopedName
an NamespaceMap
prefs =
    let
        errmsg1 :: [Char]
errmsg1 = [Char]
"BwdChain rule error: "
        errmsg2 :: [Char]
errmsg2 = [Char]
"BwdChain goal error: "
    in
        do  { Either [Char] RDFRule
erl <- ScopedName
-> ScopedName -> StateT SwishState IO (Either [Char] RDFRule)
ssFindRulesetRule ScopedName
sn ScopedName
rn
            ; Either [Char] RDFGraph
ecg <- SwishStateIO (Either [Char] RDFGraph)
cgf                -- Either String RDFGraph
            ; let fcr :: SwishState -> SwishState
fcr = case (Either [Char] RDFRule
erl,Either [Char] RDFGraph
ecg) of
                    (Left [Char]
er,Either [Char] RDFGraph
_) -> [Char] -> SwishState -> SwishState
setError ([Char]
errmsg1 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
er)
                    (Either [Char] RDFRule
_,Left [Char]
er) -> [Char] -> SwishState -> SwishState
setError ([Char]
errmsg2 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
er)
                    (Right RDFRule
rl,Right RDFGraph
cg) ->
                        (NamedGraphMap -> NamedGraphMap) -> SwishState -> SwishState
modGraphs (ScopedName -> [RDFGraph] -> NamedGraphMap -> NamedGraphMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ScopedName
an [RDFGraph]
ags)
                        where
                            ags :: [RDFGraph]
ags  = ([RDFGraph] -> RDFGraph) -> [[RDFGraph]] -> [RDFGraph]
forall a b. (a -> b) -> [a] -> [b]
map [RDFGraph] -> RDFGraph
forall {lb}. Label lb => [NSGraph lb] -> NSGraph lb
mergegr (RDFRule -> RDFGraph -> [[RDFGraph]]
forall ex. Rule ex -> ex -> [[ex]]
bwdApply RDFRule
rl RDFGraph
cg)
                            mergegr :: [NSGraph lb] -> NSGraph lb
mergegr [NSGraph lb]
grs = case [NSGraph lb]
grs of
                                [] -> NSGraph lb
forall a. Monoid a => a
mempty
                                [NSGraph lb]
_  -> NamespaceMap -> NSGraph lb -> NSGraph lb
forall lb. NamespaceMap -> NSGraph lb -> NSGraph lb
setNamespaces NamespaceMap
prefs (NSGraph lb -> NSGraph lb) -> NSGraph lb -> NSGraph lb
forall a b. (a -> b) -> a -> b
$ (NSGraph lb -> NSGraph lb -> NSGraph lb)
-> [NSGraph lb] -> NSGraph lb
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 NSGraph lb -> NSGraph lb -> NSGraph lb
forall (lg :: * -> *) lb.
(LDGraph lg lb, Ord lb) =>
lg lb -> lg lb -> lg lb
addGraphs [NSGraph lb]
grs
            ; (SwishState -> SwishState) -> SwishStateIO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify SwishState -> SwishState
fcr
            }

--  Temporary implementation:  just read local file WNH     
--  (Add logic to separate filenames from URIs, and
--  attempt HTTP GET, or similar.)
getResourceData :: Maybe URI -> SwishStateIO (Either String L.Text)
getResourceData :: Maybe URI -> StateT SwishState IO (Either [Char] Text)
getResourceData = StateT SwishState IO (Either [Char] Text)
-> (URI -> StateT SwishState IO (Either [Char] Text))
-> Maybe URI
-> StateT SwishState IO (Either [Char] Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StateT SwishState IO (Either [Char] Text)
forall {a}. StateT SwishState IO (Either a Text)
fromStdin URI -> StateT SwishState IO (Either [Char] Text)
forall {a}. URI -> StateT SwishState IO (Either a Text)
fromUri 
  where
    fromStdin :: StateT SwishState IO (Either a Text)
fromStdin = Text -> Either a Text
forall a b. b -> Either a b
Right (Text -> Either a Text)
-> StateT SwishState IO Text
-> StateT SwishState IO (Either a Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text -> StateT SwishState IO Text
forall (m :: * -> *) a. Monad m => m a -> StateT SwishState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift IO Text
LIO.getContents
    fromUri :: URI -> StateT SwishState IO (Either a Text)
fromUri = URI -> StateT SwishState IO (Either a Text)
forall {t :: (* -> *) -> * -> *} {a}.
(Functor (t IO), MonadTrans t) =>
URI -> t IO (Either a Text)
fromFile
    fromFile :: URI -> t IO (Either a Text)
fromFile URI
uri | URI -> [Char]
uriScheme URI
uri [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"file:" = Text -> Either a Text
forall a b. b -> Either a b
Right (Text -> Either a Text) -> t IO Text -> t IO (Either a Text)
forall a b. (a -> b) -> t IO a -> t IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO Text -> t IO Text
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ([Char] -> IO Text
LIO.readFile ([Char] -> IO Text) -> [Char] -> IO Text
forall a b. (a -> b) -> a -> b
$ URI -> [Char]
uriPath URI
uri)
                 | Bool
otherwise = [Char] -> t IO (Either a Text)
forall a. HasCallStack => [Char] -> a
error ([Char] -> t IO (Either a Text)) -> [Char] -> t IO (Either a Text)
forall a b. (a -> b) -> a -> b
$ [Char]
"Unsupported file name for read: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ URI -> [Char]
forall a. Show a => a -> [Char]
show URI
uri
                               
--  Temporary implementation:  just write local file
--  (Need to add logic to separate filenames from URIs, and
--  attempt HTTP PUT, or similar.)
putResourceData :: Maybe URI -> B.Builder -> SwishStateIO ()
putResourceData :: Maybe URI -> Builder -> SwishStateIO ()
putResourceData Maybe URI
muri Builder
gsh = do
    Either IOError ()
ios <- IO (Either IOError ()) -> StateT SwishState IO (Either IOError ())
forall (m :: * -> *) a. Monad m => m a -> StateT SwishState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Either IOError ())
 -> StateT SwishState IO (Either IOError ()))
-> (IO () -> IO (Either IOError ()))
-> IO ()
-> StateT SwishState IO (Either IOError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO (Either IOError ())
forall e a. Exception e => IO a -> IO (Either e a)
CE.try (IO () -> StateT SwishState IO (Either IOError ()))
-> IO () -> StateT SwishState IO (Either IOError ())
forall a b. (a -> b) -> a -> b
$ IO () -> (URI -> IO ()) -> Maybe URI -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO ()
toStdout URI -> IO ()
toUri Maybe URI
muri
    case Either IOError ()
ios of
      Left IOError
ioe -> (SwishState -> SwishState) -> SwishStateIO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SwishState -> SwishState) -> SwishStateIO ())
-> (SwishState -> SwishState) -> SwishStateIO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> SwishState -> SwishState
setError
                    ([Char]
"Error writing graph: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                    IOError -> [Char]
IO.ioeGetErrorString IOError
ioe)
      Right ()
_   -> () -> SwishStateIO ()
forall a. a -> StateT SwishState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    where
        toStdout :: IO ()
toStdout  = Text -> IO ()
LIO.putStrLn Text
gstr
        toUri :: URI -> IO ()
toUri URI
uri | URI -> [Char]
uriScheme URI
uri [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"file:" = [Char] -> Text -> IO ()
LIO.writeFile (URI -> [Char]
uriPath URI
uri) Text
gstr
                  | Bool
otherwise                = [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Unsupported scheme for write: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ URI -> [Char]
forall a. Show a => a -> [Char]
show URI
uri
        gstr :: Text
gstr = Builder -> Text
B.toLazyText Builder
gsh

{- $syntax

The script syntax is based loosely on Notation3, and the script parser is an
extension of the Notation3 parser in the module "Swish.RDF.Parser.N3".
The comment character is @#@ and white space is ignored.

> script            := command *
> command           := prefixLine        |
>                      nameItem          |
>                      readGraph         |
>                      writeGraph        |
>                      mergeGraphs       |
>                      compareGraphs     |
>                      assertEquiv       |
>                      assertMember      |
>                      defineRule        |
>                      defineRuleset     |
>                      defineConstraints |
>                      checkProofCmd     |
>                      fwdChain          |
>                      bwdChain 

-}

{- $prefixLine

> prefixLine        := @prefix [<prefix>]: <uri> .

Define a namespace prefix and URI. 

The prefix thus defined is available for use in any subsequent script
command, and also in any graphs contained within the script file. (So,
prefix declarations do not need to be repeated for each graph
contained within the script.)

Graphs read from external files must contain their own prefix
declarations.

Example:

  > @prefix gex: <http://example1.com/graphs/>.
  > @prefix :    <http://example2.com/id/>.

-}

{- $nameItem

> nameItem          := name :- graph     |
>                      name :- ( graph* )

Graphs or lists of graphs can be given a name for use in other
statements.  A name is a qname (prefix:local) or a URI enclosed in
angle

Example:

> @prefix ex1: <http://example.com/graphs/> .
> @prefix ex2: <http://example.com/statements/> .
>
> ex1:gr1 :- { 
>     ex2:foo a ex2:Foo .
>     ex2:bar a ex2:Bar .
>     ex2:Bar rdfs:subClassOf ex2:Foo .
> }

-}

{- $readGraph

> readGraph         := @read name [<uri>]

The @\@read@ command reads in the contents of the given URI
- which at present only supports reading local files, so
no HTTP access - and stores it under the given name.

If no URI is given then the file is read from standard input.

Example:

  > @prefix ex: <http://example.com/> .
  > @read ex:foo <foo.n3>

-}

{- $writeGraph

> writeGraph        := @write name [<uri>] ; comment

The @\@write@ command writes out the contents of the given graph
- which at present only supports writing local files, so
no HTTP access. The comment text is written as a comment line
preceeding the graph contents.

If no URI is given then the file is written to the standard output.

Example:

  > @prefix ex: <http://example.com/> .
  > @read ex:gr1 <graph1.n3>
  > @read ex:gr2 <graph2.n3>
  > @merge (ex:gr1 ex:gr2) => ex:gr3
  > @write ex:gr3 ; the merged data
  > @write ex:gr3 <merged.n3> ; merge of graph1.n3 and graph2.n3

-}

{- $mergeGraphs

> mergeGraphs       := @merge ( name* ) => name

Create a new named graph that is the merge two or more graphs,
renaming bnodes as required to avoid node-merging.

When the merge command is run, the message

  > # Merge: <output graph name>

will be created on the standard output channel.

Example:

  > @prefix gex: <http://example.com/graph/>.
  > @prefix ex: <http://example.com/statements/>.
  > gex:gr1 :- { ex:foo ex:bar _:b1 . }
  > gex:gr2 :- { _:b1 ex:foobar 23. }
  > @merge (gex:gr1 gex:gr2) => gex:gr3
  > @write gex:gr3 ; merged graphs

When run in Swish, this creates the following output (along with
several other namespace declarations):

 > # merged graphs
 > @prefix ex: <http://example.com/statements/> .
 > ex:foo ex:bar [] .
 > [
 >  ex:foobar "23"^^xsd:integer
 > ] .

-}

{- $compareGraphs

> compareGraphs     := @compare name name

Compare two graphs for isomorphism, setting the Swish exit status to
reflect the result.

When the compare command is run, the message

  > # Compare: <graph1> <graph2>

will be created on the standard output channel.

Example:

  > @prefix gex: <http://example.com/graphs/>.
  > @read gex:gr1 <graph1.n3>
  > @read gex:gr2 <graph2.n3>
  > @compare gex:gr1 gex:gr2

-}

{- $assertEquiv

> assertEquiv       := @asserteq name name ; comment

Test two graphs or lists of graphs for isomorphism, reporting if they
differ. The comment text is included with any report generated.

When the command is run, the message

  > # AssertEq: <comment>

will be created on the standard output channel.

Example:

  > @prefix ex:  <http://id.ninebynine.org/wip/2003/swishtest/> .
  >
  > # Set up the graphs for the rules
  > ex:Rule01Ant :- { ?p ex:son ?o . }
  > ex:Rule01Con :- { ?o a ex:Male ; ex:parent ?p . }
  >
  > # Create a rule and a ruleset
  > @rule ex:Rule01 :- ( ex:Rule01Ant ) => ex:Rule01Con
  > @ruleset ex:rules :- (ex:TomSonDick ex:TomSonHarry) ; (ex:Rule01)
  >
  > # Apply the rule
  > @fwdchain ex:rules ex:Rule01 { :Tom ex:son :Charles . } => ex:Rule01fwd
  >
  > # Compare the results to the expected value
  > ex:ExpectedRule01fwd :- { :Charles a ex:Male ; ex:parent :Tom . }  
  > @asserteq ex:Rule01fwd ex:ExpectedRule01fwd
  >    ; Infer that Charles is male and has parent Tom

-}

{- $assertMember

> assertMember      := @assertin name name ; comment

Test if a graph is isomorphic to a member of a list of graphs,
reporting if no match is found. The comment text is included with any
report generated.

Example:

> @bwdchain pv:rules :PassengerVehicle ex:Test01Inp <= :t1b
> 
> @assertin ex:Test01Bwd0 :t1b ; Backward chain component test (0)
> @assertin ex:Test01Bwd1 :t1b ; Backward chain component test (1)

-}

{- $defineRule

> defineRule        := @rule name :- ( name* ) => name
> defineRule        := @rule name :- ( name* ) => name
>                       | ( (name var*)* )

Define a named Horn-style rule. 

The list of names preceding and following @=>@ are the antecedent and consequent
graphs, respectivelu. Both sets may contain variable nodes of the form 
@?var@.

The optional part, after the @|@ separator, is a list of variable
binding modifiers, each of which consists of a name and a list of
variables (@?var@) to which the modifier is applied. Variable binding
modifiers are built in to Swish, and are used to incorporate datatype
value inferences into a rule.  

-}

{- $defineRuleset

> defineRuleset     := @ruleset name :- ( name* ) ; ( name* ) 

Define a named ruleset (a collection of axioms and rules). The first
list of names are the axioms that are part of the ruleset, and the
second list are the rules.

-}

{- $defineConstraints

> defineConstraints := @constraints pref :- ( name* ) | [ name | ( name* ) ]

Define a named ruleset containing class-restriction rules based on a
datatype value constraint. The first list of
names is a list of graphs that together comprise the class-restriction
definitions (rule names are the names of the corresponding restriction
classes). The second list of names is a list of datatypes whose
datatype relations are referenced by the class restriction
definitions.

-}

{- $fwdChain

> fwdChain          := @fwdchain pref name ( name* ) => name

Define a new graph obtained by forward-chaining a rule. The first name
is the ruleset to be used. The second name is the rule name. The list
of names are the antecedent graphs to which the rule is applied. The
name following the @=>@ names a new graph that is the result of formward
chaining from the given antecedents using the indicated rule.

-}

{- $bwdChain

> bwdChain          := @bwdchain pref name graph <= name

Define a new list of alternative graphs obtained by backward-chaining
a rule. The first name is the ruleset to be used. The second name is
the rule name. The third name (before the @<=@) is the name of a goal graph
from which to backward chain. The final name (after the @<=@) names a new
list of graphs, each of which is an alternative antecedent from which
the given goal can be deduced using the indicated rule.


-}

{- $proof

> checkProofCmd     := proofLine nl
>                      inputLine nl
>                      (stepLine nl)*
>                      resultLine
> proofLine         := @proof name ( name* )

Check a proof, reporting the step that fails, if any.

The @\@proof@ line names the proof and specifies a list rulesets
(proof context) used.  The remaining lines specify the input
expression (@\@input@), proof steps (@\@step@) and the final result
(@\@result@) that is demonstrated by the proof.

> inputLine         := @input name

In a proof, indicates an input expression upon which the proof is
based. Exactly one of these immediately follows the @\@proof@ command.

> stepLine          := @step name ( name* ) => name

This defines a step of the proof; any number of these immediately
follow the @\@input@ command.

It indicates the name of the rule applied for this step, a list of
antecedent graphs, and a named graph that is deduced by this step.
For convenience, the deduced graph may introduce a new named graph
using an expression of the form:

  > name :- { statements }

> resultLine        := @result name

This defines the goal of the proof, and completes a proof
definition. Exactly one of these immediately follows the @\@step@
commands.  For convenience, the result statement may introduce a new
named graph using an expression of the form:

  > name :- { statements }

-}

{- $exampleScript

This is the example script taken from
<http://www.ninebynine.org/Software/swish-0.2.1.html#sec-script-example>
with the proof step adjusted so that it passes.

> # -- Example Swish script --
> #
> # Comment lines start with a '#'
> #
> # The script syntax is loosely based on Notation3, but it is a quite 
> # different language, except that embedded graphs (enclosed in {...})
> # are encoded using Notation3 syntax.
> #
> # -- Prefix declarations --
> #
> # As well as being used for all labels defined and used by the script
> # itself, these are applied to all graph expressions within the script 
> # file, and to graphs created by scripted inferences, 
> # but are not applied to any graphs read in from an external source.
> 
> @prefix ex:  <http://id.ninebynine.org/wip/2003/swishtest/> .
> @prefix pv:  <http://id.ninebynine.org/wip/2003/swishtest/pv/> .
> @prefix xsd: <http://www.w3.org/2001/XMLSchema#> .
> @prefix xsd_integer: <http://id.ninebynine.org/2003/XMLSchema/integer#> .
> @prefix rs_rdf:  <http://id.ninebynine.org/2003/Ruleset/rdf#> .
> @prefix rs_rdfs: <http://id.ninebynine.org/2003/Ruleset/rdfs#> .
> @prefix :   <http://id.ninebynine.org/default/> .
> 
> # Additionally, prefix declarations are provided automatically for:
> #    @prefix rdf:   <http://www.w3.org/1999/02/22-rdf-syntax-ns#> .
> #    @prefix rdfs:  <file://www.w3.org/2000/01/rdf-schema#> .
> #    @prefix rdfd:  <http://id.ninebynine.org/2003/rdfext/rdfd#> .
> #    @prefix rdfo:  <http://id.ninebynine.org/2003/rdfext/rdfo#> .
> #    @prefix owl:   <http://www.w3.org/2002/07/owl#> .
> 
> # -- Simple named graph declarations --
> 
> ex:Rule01Ant :- { ?p ex:son ?o . }
> 
> ex:Rule01Con :- { ?o a ex:Male ; ex:parent ?p . }
> 
> ex:TomSonDick :- { :Tom ex:son :Dick . }
> ex:TomSonHarry :- { :Tom ex:son :Harry . }
> 
> # -- Named rule definition --
> 
> @rule ex:Rule01 :- ( ex:Rule01Ant ) => ex:Rule01Con
> 
> # -- Named ruleset definition --
> #
> # A 'ruleset' is a collection of axioms and rules.
> #
> # Currently, the ruleset is identified using the namespace alone;
> # i.e. the 'rules' in 'ex:rules' below is not used.  
> # This is under review.
> 
> @ruleset ex:rules :- (ex:TomSonDick ex:TomSonHarry) ; (ex:Rule01)
> 
> # -- Forward application of rule --
> #
> # The rule is identified here by ruleset and a name within the ruleset.
> 
> @fwdchain ex:rules ex:Rule01 { :Tom ex:son :Charles . } => ex:Rule01fwd
> 
> # -- Compare graphs --
> #
> # Compare result of inference with expected result.
> # This is a graph isomorphism test rather than strict equality, 
> # to allow for bnode renaming.
> # If the graphs are not equal, a message is generated, which
> # includes the comment (';' to end of line)
> 
> ex:ExpectedRule01fwd :- { :Charles a ex:Male ; ex:parent :Tom . }  
> 
> @asserteq ex:Rule01fwd ex:ExpectedRule01fwd
>    ; Infer that Charles is male and has parent Tom
> 
> # -- Display graph (to screen and a file) --
> #
> # The comment is included in the output.
> 
> @write ex:Rule01fwd ; Charles is male and has parent Tom
> @write ex:Rule01fwd <Example1.n3> ; Charles is male and has parent Tom
> 
> # -- Read graph from file --
> #
> # Creates a new named graph in the Swish environment.
> 
> @read ex:Rule01inp <Example1.n3>
> 
> # -- Proof check --
> #
> # This proof uses the built-in RDF and RDFS rulesets, 
> # which are the RDF- and RDFS- entailment rules described in the RDF
> # formal semantics document.
> #
> # To prove:
> #     ex:foo ex:prop "a" .
> # RDFS-entails
> #     ex:foo ex:prop _:x .
> #     _:x rdf:type rdfs:Resource .
> #
> # If the proof is not valid according to the axioms and rules of the 
> # ruleset(s) used and antecedents given, then an error is reported 
> # indicating the failed proof step.
> 
> ex:Input  :- { ex:foo ex:prop "a" . }
> ex:Result :- { ex:foo ex:prop _:a . _:a rdf:type rdfs:Resource . }
> 
> @proof ex:Proof ( rs_rdf:rules rs_rdfs:rules )
>   @input  ex:Input
>   @step   rs_rdfs:r3 ( rs_rdfs:a10 rs_rdfs:a39 )
>           => ex:Stepa :- { rdfs:Literal rdf:type rdfs:Class . }
>   @step   rs_rdfs:r8 ( ex:Stepa )
>           => ex:Stepb :- { rdfs:Literal rdfs:subClassOf rdfs:Resource . }
>   @step   rs_rdf:lg ( ex:Input )
>           => ex:Stepc :- { ex:foo ex:prop _:a . _:a rdf:_allocatedTo "a" . }
>   @step   rs_rdfs:r1 ( ex:Stepc )
>           => ex:Stepd :- { _:a rdf:type rdfs:Literal . }
>   @step   rs_rdfs:r9 ( ex:Stepb ex:Stepd )
>           => ex:Stepe :- { _:a rdf:type rdfs:Resource . }
>   @step   rs_rdf:se  ( ex:Stepc ex:Stepd ex:Stepe )
>           => ex:Result
>   @result ex:Result
> 
> # -- Restriction based datatype inferencing --
> #
> # Datatype inferencing based on a general class restriction and
> # a predefined relation (per idea noted by Pan and Horrocks).
> 
> ex:VehicleRule :-
>   { :PassengerVehicle a rdfd:GeneralRestriction ;
>       rdfd:onProperties (:totalCapacity :seatedCapacity :standingCapacity) ;
>       rdfd:constraint xsd_integer:sum ;
>       rdfd:maxCardinality "1"^^xsd:nonNegativeInteger . }
> 
> # Define a new ruleset based on a declaration of a constraint class
> # and reference to built-in datatype.
> # The datatype constraint xsd_integer:sum is part of the definition 
> # of datatype xsd:integer that is cited in the constraint ruleset
> # declaration.  It relates named properties of a class instance.
> 
> @constraints pv:rules :- ( ex:VehicleRule ) | xsd:integer
> 
> # Input data for test cases:
> 
> ex:Test01Inp :-
>   { _:a1 a :PassengerVehicle ;
>       :seatedCapacity "30"^^xsd:integer ;
>       :standingCapacity "20"^^xsd:integer . }
> 
> # Forward chaining test case:
> 
> ex:Test01Fwd :- { _:a1 :totalCapacity "50"^^xsd:integer . }
> 
> @fwdchain pv:rules :PassengerVehicle ex:Test01Inp => :t1f
> @asserteq :t1f ex:Test01Fwd  ; Forward chain test
> 
> # Backward chaining test case:
> #
> # Note that the result of backward chaining is a list of alternatives,
> # any one of which is sufficient to derive the given conclusion.
> 
> ex:Test01Bwd0 :-
>   { _:a1 a :PassengerVehicle .
>     _:a1 :totalCapacity "50"^^xsd:integer .
>     _:a1 :seatedCapacity "30"^^xsd:integer . }
> 
> ex:Test01Bwd1 :-
>   { _:a1 a :PassengerVehicle .
>     _:a1 :totalCapacity "50"^^xsd:integer .
>     _:a1 :standingCapacity "20"^^xsd:integer . }
> 
> # Declare list of graphs:
> 
> ex:Test01Bwd :- ( ex:Test01Bwd0 ex:Test01Bwd1 )
> 
> @bwdchain pv:rules :PassengerVehicle ex:Test01Inp <= :t1b
> @asserteq :t1b ex:Test01Bwd  ; Backward chain test
> 
> # Can test for graph membership in a list
> 
> @assertin ex:Test01Bwd0 :t1b ; Backward chain component test (0)
> @assertin ex:Test01Bwd1 :t1b ; Backward chain component test (1)
> 
> # -- Merge graphs --
> #
> # Merging renames bnodes to avoid collisions.
> 
> @merge ( ex:Test01Bwd0 ex:Test01Bwd1 ) => ex:Merged
> 
> # This form of comparison sets the Swish exit status based on the result.
> 
> ex:ExpectedMerged :-
>   { _:a1 a :PassengerVehicle .
>     _:a1 :totalCapacity "50"^^xsd:integer .
>     _:a1 :seatedCapacity "30"^^xsd:integer .
>     _:a2 a :PassengerVehicle .
>     _:a2 :totalCapacity "50"^^xsd:integer .
>     _:a2 :standingCapacity "20"^^xsd:integer . }
> 
> @compare ex:Merged ex:ExpectedMerged
> 
> # End of example script

If saved in the file example.ss, then it can be evaluated by saying
either of:

> % Swish -s=example.ss

or, from @ghci@:

> Prelude> :set prompt "Swish> "
> Swish> :m + Swish
> Swish> runSwish "-s=example.ss"

and the output is

> # AssertEq: Infer that Charles is male and has parent Tom
> # Charles is male and has parent Tom
> @prefix rdf: <http://www.w3.org/1999/02/22-rdf-syntax-ns#> .
> @prefix rdfs: <http://www.w3.org/2000/01/rdf-schema#> .
> @prefix rdfd: <http://id.ninebynine.org/2003/rdfext/rdfd#> .
> @prefix owl: <http://www.w3.org/2002/07/owl#> .
> @prefix log: <http://www.w3.org/2000/10/swap/log#> .
> @prefix : <http://id.ninebynine.org/default/> .
> @prefix ex: <http://id.ninebynine.org/wip/2003/swishtest/> .
> @prefix pv: <http://id.ninebynine.org/wip/2003/swishtest/pv/> .
> @prefix xsd: <http://www.w3.org/2001/XMLSchema#> .
> @prefix xsd_integer: <http://id.ninebynine.org/2003/XMLSchema/integer#> .
> @prefix rs_rdf: <http://id.ninebynine.org/2003/Ruleset/rdf#> .
> @prefix rs_rdfs: <http://id.ninebynine.org/2003/Ruleset/rdfs#> .
> :Charles ex:parent :Tom ;
>          a ex:Male .
> 
> Proof satisfied: ex:Proof
> # AssertEq: Forward chain test
> # AssertEq: Backward chain test
> # AssertIn: Backward chain component test (0)
> # AssertIn: Backward chain component test (1)
> # Merge: ex:Merged
> # Compare: ex:Merged ex:ExpectedMerged

-}

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